diff options
Diffstat (limited to 'lib')
40 files changed, 1175 insertions, 769 deletions
diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index b0c37d79e7..9a6201455d 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -51,7 +51,8 @@ %% Suite definition %%------------------------------------------------------------------------------ -suite() -> [{ct_hooks, [ts_install_cth]}]. +suite() -> [{ct_hooks, [ts_install_cth]}, + {timetrap,{minutes,60}}]. all() -> [{group, parallel}, @@ -241,15 +242,10 @@ init_per_testcase(Func, Config) -> ok = filelib:ensure_dir(filename:join([CaseDir, dummy_file])), true = code:add_patha(CaseDir), - Dog = case Func of - testX420 -> test_server:timetrap({minutes, 90}); - _ -> test_server:timetrap({minutes, 60}) - end, - [{case_dir, CaseDir}, {watchdog, Dog}|Config]. + [{case_dir, CaseDir}|Config]. end_per_testcase(_Func, Config) -> - code:del_path(?config(case_dir, Config)), - test_server:timetrap_cancel(?config(watchdog, Config)). + code:del_path(?config(case_dir, Config)). %%------------------------------------------------------------------------------ %% Test runners @@ -1064,6 +1060,9 @@ test_modified_x420(Config) -> asn1_test_lib:compile_all(Files, Config, [der]), test_modified_x420:test_io(Config). + +testX420() -> + [{timetrap,{minutes,90}}]. testX420(Config) -> test(Config, fun testX420/3, [ber, ber_bin, ber_bin_v2]). testX420(Config, Rule, Opts) -> diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index 64eeb4af92..abe8cb2041 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -32,6 +32,22 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.6.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The interactive mode (ct_run -shell) would not start + properly. This error has been fixed.</p> + <p> + Own Id: OTP-10414</p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.6.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index 49b51c9207..5014309c0f 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -274,7 +274,8 @@ step(TestDir,Suite,Case,Opts) -> %%% <c>> ct_telnet:cmd(unix_telnet, "ls .").</c><br/> %%% <c>{ok,["ls","file1 ...",...]}</c></p> start_interactive() -> - ct_util:start(interactive). + ct_util:start(interactive), + ok. %%%----------------------------------------------------------------- %%% @spec stop_interactive() -> ok @@ -282,7 +283,8 @@ start_interactive() -> %%% @doc Exit the interactive mode. %%% @see start_interactive/0 stop_interactive() -> - ct_util:stop(normal). + ct_util:stop(normal), + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% MISC INTERFACE diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index d80d216f9e..3383244bf4 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -211,6 +211,8 @@ analyze_test_result([Result|Rs], Args) -> end; analyze_test_result([], _) -> ?EXIT_STATUS_TEST_SUCCESSFUL; +analyze_test_result(interactive_mode, _) -> + interactive_mode; analyze_test_result(Unknown, _) -> io:format("\nTest run failed! Reason:\n~p\n\n\n",[Unknown]), ?EXIT_STATUS_TEST_RUN_FAILED. @@ -218,17 +220,22 @@ analyze_test_result(Unknown, _) -> finish(Tracing, ExitStatus, Args) -> stop_trace(Tracing), timer:sleep(1000), - %% 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]) + 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]) + end end. script_start1(Parent, Args) -> @@ -635,6 +642,7 @@ script_start4(#opts{label = Label, profile = Profile, verbosity = Verbosity, enable_builtin_hooks = EnableBuiltinHooks, logdir = LogDir, testspecs = Specs}, _Args) -> + %% label - used by ct_logs application:set_env(common_test, test_label, Label), @@ -655,7 +663,7 @@ script_start4(#opts{label = Label, profile = Profile, ct_util:set_testdata({logopts, LogOpts}), log_ts_names(Specs), io:nl(), - ok; + interactive_mode; Error -> Error end; @@ -2776,6 +2784,8 @@ opts2args(EnvStartOpts) -> [{exit_status,[atom_to_list(ExitStatusOpt)]}]; ({halt_with,{HaltM,HaltF}}) -> [{halt_with,[atom_to_list(HaltM),atom_to_list(HaltF)]}]; + ({interactive_mode,true}) -> + [{shell,[]}]; ({config,CfgFiles}) -> [{ct_config,[CfgFiles]}]; ({userconfig,{CBM,CfgStr=[X|_]}}) when is_integer(X) -> diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index 7628ada61a..686ee43aa3 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -50,7 +50,8 @@ MODULES= \ ct_netconfc_SUITE \ ct_basic_html_SUITE \ ct_auto_compile_SUITE \ - ct_verbosity_SUITE + ct_verbosity_SUITE \ + ct_shell_SUITE ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/common_test/test/ct_netconfc_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE.erl index e6e8d5b09c..30084a6228 100644 --- a/lib/common_test/test/ct_netconfc_SUITE.erl +++ b/lib/common_test/test/ct_netconfc_SUITE.erl @@ -44,7 +44,12 @@ %%-------------------------------------------------------------------- init_per_suite(Config) -> Config1 = ct_test_support:init_per_suite(Config), - Config1. + case application:load(crypto) of + {error,Reason} -> + {skip, Reason}; + _ -> + Config1 + end. end_per_suite(Config) -> ct_test_support:end_per_suite(Config). diff --git a/lib/common_test/test/ct_shell_SUITE.erl b/lib/common_test/test/ct_shell_SUITE.erl new file mode 100644 index 0000000000..4b8c43d800 --- /dev/null +++ b/lib/common_test/test/ct_shell_SUITE.erl @@ -0,0 +1,133 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2012. 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% +%% + +%%%------------------------------------------------------------------- +%%% File: ct_shell_SUITE +%%% +%%% Description: +%%% Test that the interactive mode starts properly +%%% +%%% The suites used for the test are located in the data directory. +%%%------------------------------------------------------------------- +-module(ct_shell_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + +-define(eh, ct_test_support_eh). + +%%-------------------------------------------------------------------- +%% TEST SERVER CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- + +init_per_suite(Config) -> + Config1 = ct_test_support:init_per_suite(Config), + Config1. + +end_per_suite(Config) -> + ct_test_support:end_per_suite(Config). + +init_per_testcase(TestCase, Config) -> + ct_test_support:init_per_testcase(TestCase, Config). + +end_per_testcase(TestCase, Config) -> + ct_test_support:end_per_testcase(TestCase, Config). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [start_interactive]. + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- + +%%%----------------------------------------------------------------- +%%% +start_interactive(Config) -> + DataDir = ?config(data_dir, Config), + CfgFile = filename:join(DataDir, "cfgdata"), + + {Opts,ERPid} = setup([{interactive_mode,true},{config,CfgFile}], + Config), + CTNode = proplists:get_value(ct_node, Config), + Level = proplists:get_value(trace_level, Config), + test_server:format(Level, "Saving start opts on ~p: ~p~n", + [CTNode, Opts]), + rpc:call(CTNode, application, set_env, + [common_test, run_test_start_opts, Opts]), + test_server:format(Level, "Calling ct_run:script_start() on ~p~n", + [CTNode]), + + interactive_mode = rpc:call(CTNode, ct_run, script_start, []), + + ok = rpc:call(CTNode, ct, require, [key1]), + value1 = rpc:call(CTNode, ct, get_config, [key1]), + ok = rpc:call(CTNode, ct, require, [x,key2]), + value2 = rpc:call(CTNode, ct, get_config, [x]), + + ok = rpc:call(CTNode, ct, stop_interactive, []), + + case rpc:call(CTNode, erlang, whereis, [ct_util_server]) of + undefined -> + ok; + _ -> + test_server:format(Level, + "ct_util_server not stopped on ~p yet, waiting 5 s...~n", + [CTNode]), + timer:sleep(5000), + undefined = rpc:call(CTNode, erlang, whereis, [ct_util_server]) + end, + Events = ct_test_support:get_events(ERPid, Config), + + ct_test_support:log_events(start_interactive, + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), + TestEvents = test_events(start_interactive), + ok = ct_test_support:verify_events(TestEvents, Events, Config). + +%%%----------------------------------------------------------------- +%%% HELP FUNCTIONS +%%%----------------------------------------------------------------- + +setup(Test, Config) -> + Opts0 = ct_test_support:get_opts(Config), + Level = ?config(trace_level, Config), + EvHArgs = [{cbm,ct_test_support},{trace_level,Level}], + Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}}|Test], + ERPid = ct_test_support:start_event_receiver(Config), + {Opts,ERPid}. + +reformat(Events, EH) -> + ct_test_support:reformat(Events, EH). + +%%%----------------------------------------------------------------- +%%% TEST EVENTS +%%%----------------------------------------------------------------- + +test_events(start_interactive) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]. diff --git a/lib/common_test/test/ct_shell_SUITE_data/cfgdata b/lib/common_test/test/ct_shell_SUITE_data/cfgdata new file mode 100644 index 0000000000..23a40ad21a --- /dev/null +++ b/lib/common_test/test/ct_shell_SUITE_data/cfgdata @@ -0,0 +1,2 @@ +{key1,value1}. +{key2,value2}. diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index 877aa775fd..5c9fdfc47e 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.6.2 +COMMON_TEST_VSN = 1.6.2.1 diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl index 3e3c12405f..99388438b1 100644 --- a/lib/dialyzer/src/dialyzer.erl +++ b/lib/dialyzer/src/dialyzer.erl @@ -162,14 +162,17 @@ run(Opts) -> {error, Msg} -> throw({dialyzer_error, Msg}); OptsRecord -> - case cl_check_init(OptsRecord) of - {ok, ?RET_NOTHING_SUSPICIOUS} -> - case dialyzer_cl:start(OptsRecord) of - {?RET_DISCREPANCIES, Warnings} -> Warnings; - {?RET_NOTHING_SUSPICIOUS, []} -> [] - end; - {error, ErrorMsg1} -> - throw({dialyzer_error, ErrorMsg1}) + case OptsRecord#options.check_plt of + true -> + case cl_check_init(OptsRecord) of + {ok, ?RET_NOTHING_SUSPICIOUS} -> ok; + {error, ErrorMsg1} -> throw({dialyzer_error, ErrorMsg1}) + end; + false -> ok + end, + case dialyzer_cl:start(OptsRecord) of + {?RET_DISCREPANCIES, Warnings} -> Warnings; + {?RET_NOTHING_SUSPICIOUS, []} -> [] end catch throw:{dialyzer_error, ErrorMsg} -> diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index c237d4e0e9..86618a4915 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -326,13 +326,6 @@ cleanup_callgraph(#analysis_state{plt = InitPlt, parent = Parent, ModuleDeps = dialyzer_callgraph:module_deps(Callgraph), send_mod_deps(Parent, ModuleDeps), {Callgraph1, ExtCalls} = dialyzer_callgraph:remove_external(Callgraph), - RelevantAPICalls = - dialyzer_behaviours:get_behaviour_apis([gen_server]), - BehaviourAPICalls = [Call || {_From, To} = Call <- ExtCalls, - lists:member(To, RelevantAPICalls)], - Callgraph2 = - dialyzer_callgraph:put_behaviour_api_calls(BehaviourAPICalls, - Callgraph1), ExtCalls1 = [Call || Call = {_From, To} <- ExtCalls, not dialyzer_plt:contains_mfa(InitPlt, To)], {BadCalls1, RealExtCalls} = @@ -355,7 +348,7 @@ cleanup_callgraph(#analysis_state{plt = InitPlt, parent = Parent, true -> send_ext_calls(Parent, lists:usort([To || {_From, To} <- RealExtCalls])) end, - Callgraph2. + Callgraph1. compile_src(File, Includes, Defines, Callgraph, CServer, UseContracts) -> DefaultIncludes = default_includes(filename:dirname(File)), diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl index b84071b95c..36aef2a37f 100644 --- a/lib/dialyzer/src/dialyzer_behaviours.erl +++ b/lib/dialyzer/src/dialyzer_behaviours.erl @@ -30,11 +30,9 @@ -module(dialyzer_behaviours). --export([check_callbacks/5, get_behaviour_apis/1, - translate_behaviour_api_call/5, translatable_behaviours/1, - translate_callgraph/3]). +-export([check_callbacks/5]). --export_type([behaviour/0, behaviour_api_dict/0]). +-export_type([behaviour/0]). %%-------------------------------------------------------------------- @@ -224,103 +222,3 @@ get_line([]) -> -1. get_file([{file, File}|_]) -> File; get_file([_|Tail]) -> get_file(Tail). - -%%----------------------------------------------------------------------------- - --spec translatable_behaviours(cerl:c_module()) -> behaviour_api_dict(). - -translatable_behaviours(Tree) -> - Attrs = cerl:module_attrs(Tree), - {Behaviours, _BehLines} = get_behaviours(Attrs), - [{B, Calls} || B <- Behaviours, (Calls = behaviour_api_calls(B)) =/= []]. - --spec get_behaviour_apis([behaviour()]) -> [mfa()]. - -get_behaviour_apis(Behaviours) -> - get_behaviour_apis(Behaviours, []). - --spec translate_behaviour_api_call(dialyzer_callgraph:mfa_or_funlbl(), - [erl_types:erl_type()], - [dialyzer_races:core_vars()], - module(), - behaviour_api_dict()) -> - {dialyzer_callgraph:mfa_or_funlbl(), - [erl_types:erl_type()], - [dialyzer_races:core_vars()]} - | 'plain_call'. - -translate_behaviour_api_call(_Fun, _ArgTypes, _Args, _Module, []) -> - plain_call; -translate_behaviour_api_call({Module, Fun, Arity}, ArgTypes, Args, - CallbackModule, BehApiInfo) -> - case lists:keyfind(Module, 1, BehApiInfo) of - false -> plain_call; - {Module, Calls} -> - case lists:keyfind({Fun, Arity}, 1, Calls) of - false -> plain_call; - {{Fun, Arity}, {CFun, CArity, COrder}} -> - {{CallbackModule, CFun, CArity}, - [nth_or_0(N, ArgTypes, erl_types:t_any()) || N <-COrder], - [nth_or_0(N, Args, bypassed) || N <-COrder]} - end - end; -translate_behaviour_api_call(_Fun, _ArgTypes, _Args, _Module, _BehApiInfo) -> - plain_call. - --spec translate_callgraph(behaviour_api_dict(), atom(), - dialyzer_callgraph:callgraph()) -> - dialyzer_callgraph:callgraph(). - -translate_callgraph([{Behaviour,_}|Behaviours], Module, Callgraph) -> - UsedCalls = [Call || {_From, {M, _F, _A}} = Call <- - dialyzer_callgraph:get_behaviour_api_calls(Callgraph), - M =:= Behaviour], - Calls = [{{Behaviour, API, Arity}, Callback} || - {{API, Arity}, Callback} <- behaviour_api_calls(Behaviour)], - DirectCalls = [{From, {Module, Fun, Arity}} || - {From, To} <- UsedCalls,{API, {Fun, Arity, _Ord}} <- Calls, - To =:= API], - dialyzer_callgraph:add_edges(DirectCalls, Callgraph), - translate_callgraph(Behaviours, Module, Callgraph); -translate_callgraph([], _Module, Callgraph) -> - Callgraph. - -get_behaviour_apis([], Acc) -> - Acc; -get_behaviour_apis([Behaviour | Rest], Acc) -> - MFAs = [{Behaviour, Fun, Arity} || - {{Fun, Arity}, _} <- behaviour_api_calls(Behaviour)], - get_behaviour_apis(Rest, MFAs ++ Acc). - -%------------------------------------------------------------------------------ - -nth_or_0(0, _List, Zero) -> - Zero; -nth_or_0(N, List, _Zero) -> - lists:nth(N, List). - -%------------------------------------------------------------------------------ - --type behaviour_api_dict()::[{behaviour(), behaviour_api_info()}]. --type behaviour_api_info()::[{original_fun(), replacement_fun()}]. --type original_fun()::{atom(), arity()}. --type replacement_fun()::{atom(), arity(), arg_list()}. --type arg_list()::[byte()]. - --spec behaviour_api_calls(behaviour()) -> behaviour_api_info(). - -behaviour_api_calls(gen_server) -> - [{{start_link, 3}, {init, 1, [2]}}, - {{start_link, 4}, {init, 1, [3]}}, - {{start, 3}, {init, 1, [2]}}, - {{start, 4}, {init, 1, [3]}}, - {{call, 2}, {handle_call, 3, [2, 0, 0]}}, - {{call, 3}, {handle_call, 3, [2, 0, 0]}}, - {{multi_call, 2}, {handle_call, 3, [2, 0, 0]}}, - {{multi_call, 3}, {handle_call, 3, [3, 0, 0]}}, - {{multi_call, 4}, {handle_call, 3, [3, 0, 0]}}, - {{cast, 2}, {handle_cast, 2, [2, 0]}}, - {{abcast, 2}, {handle_cast, 2, [2, 0]}}, - {{abcast, 3}, {handle_cast, 2, [3, 0]}}]; -behaviour_api_calls(_Other) -> - []. diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 7131633da1..0ef008bc58 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -91,9 +91,8 @@ warning_mode = false :: boolean(), warnings = [] :: [dial_warning()], work :: {[_], [_], set()}, - module :: module(), - behaviour_api_dict = [] :: - dialyzer_behaviours:behaviour_api_dict()}). + module :: module() + }). -record(map, {dict = dict:new() :: dict(), subst = dict:new() :: dict(), @@ -135,38 +134,15 @@ get_fun_types(Tree, Plt, Callgraph, Records) -> analyze_module(Tree, Plt, Callgraph, Records, GetWarnings) -> debug_pp(Tree, false), Module = cerl:atom_val(cerl:module_name(Tree)), - RaceDetection = dialyzer_callgraph:get_race_detection(Callgraph), - BehaviourTranslations = - case RaceDetection of - true -> dialyzer_behaviours:translatable_behaviours(Tree); - false -> [] - end, TopFun = cerl:ann_c_fun([{label, top}], [], Tree), - State = - state__new(Callgraph, TopFun, Plt, Module, Records, BehaviourTranslations), + State = state__new(Callgraph, TopFun, Plt, Module, Records), State1 = state__race_analysis(not GetWarnings, State), State2 = analyze_loop(State1), case GetWarnings of true -> State3 = state__set_warning_mode(State2), State4 = analyze_loop(State3), - - %% EXPERIMENTAL: Turn all behaviour API calls into calls to the - %% respective callback module's functions. - - case BehaviourTranslations of - [] -> dialyzer_races:race(State4); - Behaviours -> - Digraph = dialyzer_callgraph:get_digraph(State4#state.callgraph), - TranslatedCallgraph = - dialyzer_behaviours:translate_callgraph(Behaviours, Module, - Callgraph), - St = - dialyzer_races:race(State4#state{callgraph = TranslatedCallgraph}), - FinalCallgraph = dialyzer_callgraph:put_digraph(Digraph, - St#state.callgraph), - St#state{callgraph = FinalCallgraph} - end; + dialyzer_races:race(State4); false -> State2 end. @@ -530,21 +506,8 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], Ann = cerl:get_ann(Tree), File = get_file(Ann), Line = abs(get_line(Ann)), - - %% EXPERIMENTAL: Turn a behaviour's API call into a call to the - %% respective callback module's function. - - Module = State#state.module, - BehApiDict = State#state.behaviour_api_dict, - {RealFun, RealArgTypes, RealArgs} = - case dialyzer_behaviours:translate_behaviour_api_call(Fun, ArgTypes, - Args, Module, - BehApiDict) of - plain_call -> {Fun, ArgTypes, Args}; - BehaviourAPI -> BehaviourAPI - end, - dialyzer_races:store_race_call(RealFun, RealArgTypes, RealArgs, - {File, Line}, State); + dialyzer_races:store_race_call(Fun, ArgTypes, Args, + {File, Line}, State); false -> State end, FailedConj = any_none([RetWithoutLocal|NewArgTypes]), @@ -2711,7 +2674,7 @@ determine_mode(Type, Opaques) -> %%% %%% =========================================================================== -state__new(Callgraph, Tree, Plt, Module, Records, BehaviourTranslations) -> +state__new(Callgraph, Tree, Plt, Module, Records) -> Opaques = erl_types:module_builtin_opaques(Module) ++ erl_types:t_opaque_from_records(Records), TreeMap = build_tree_map(Tree), @@ -2725,7 +2688,7 @@ state__new(Callgraph, Tree, Plt, Module, Records, BehaviourTranslations) -> #state{callgraph = Callgraph, envs = Env, fun_tab = FunTab, opaques = Opaques, plt = Plt, races = dialyzer_races:new(), records = Records, warning_mode = false, warnings = [], work = Work, tree_map = TreeMap, - module = Module, behaviour_api_dict = BehaviourTranslations}. + module = Module}. state__warning_mode(#state{warning_mode = WM}) -> WM. diff --git a/lib/dialyzer/src/dialyzer_races.erl b/lib/dialyzer/src/dialyzer_races.erl index cdb9f25999..2aa8343bce 100644 --- a/lib/dialyzer/src/dialyzer_races.erl +++ b/lib/dialyzer/src/dialyzer_races.erl @@ -1758,7 +1758,10 @@ compare_var_list(Var, VarList, RaceVarMap) -> ets_list_args(MaybeList) -> case is_list(MaybeList) of - true -> [ets_tuple_args(T) || T <- MaybeList]; + true -> + try [ets_tuple_args(T) || T <- MaybeList] + catch _:_ -> [?no_label] + end; false -> [ets_tuple_args(MaybeList)] end. diff --git a/lib/dialyzer/test/race_SUITE_data/results/ets_insert_args10 b/lib/dialyzer/test/race_SUITE_data/results/ets_insert_args10 new file mode 100644 index 0000000000..c3c9b12bdd --- /dev/null +++ b/lib/dialyzer/test/race_SUITE_data/results/ets_insert_args10 @@ -0,0 +1,2 @@ + +ets_insert_args10.erl:9: The call ets:insert(T::'foo',[{'counter',number()},...]) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup(T::'foo','counter') call in ets_insert_args10.erl on line 8 diff --git a/lib/dialyzer/test/race_SUITE_data/src/ets_insert_args10.erl b/lib/dialyzer/test/race_SUITE_data/src/ets_insert_args10.erl new file mode 100644 index 0000000000..c897a34af0 --- /dev/null +++ b/lib/dialyzer/test/race_SUITE_data/src/ets_insert_args10.erl @@ -0,0 +1,19 @@ +%% This tests the presence of possible races due to an ets:lookup/ets:insert +%% combination. It takes into account the argument types of the calls. + +-module(ets_insert_args10). +-export([start/0]). + +start() -> + F = fun(T) -> [{_, N}] = ets:lookup(T, counter), + ets:insert(T, [{counter, N+1}]) + end, + io:format("Created ~w\n", [ets:new(foo, [named_table, public])]), + A = {counter, 0}, + B = [], + ets:insert(foo, [A|B]), + io:format("Inserted ~w\n", [{counter, 0}]), + F(foo), + io:format("Update complete\n", []), + ObjectList = ets:lookup(foo, counter), + io:format("Counter: ~w\n", [ObjectList]). diff --git a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes index 8dc0361b0d..4850f3ff0c 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes +++ b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes @@ -6,7 +6,7 @@ contracts_with_subtypes.erl:109: The call contracts_with_subtypes:rec_arg({'b',{ contracts_with_subtypes.erl:110: The call contracts_with_subtypes:rec_arg({'a',{'b',{'a','b'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) contracts_with_subtypes.erl:111: The call contracts_with_subtypes:rec_arg({'b',{'a',{'b','a'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) contracts_with_subtypes.erl:142: The pattern 1 can never match the type binary() | string() -contracts_with_subtypes.erl:145: The pattern 'alpha' can never match the type {'ok',X} | {'ok',X,binary() | string()} +contracts_with_subtypes.erl:145: The pattern 'alpha' can never match the type {'ok',_} | {'ok',_,binary() | string()} contracts_with_subtypes.erl:147: The pattern 42 can never match the type {'ok',_} | {'ok',_,binary() | string()} contracts_with_subtypes.erl:163: The pattern 'alpha' can never match the type {'ok',X} contracts_with_subtypes.erl:165: The pattern 42 can never match the type {'ok',X} diff --git a/lib/dialyzer/test/small_SUITE_data/src/remote_tuple_set.erl b/lib/dialyzer/test/small_SUITE_data/src/remote_tuple_set.erl new file mode 100644 index 0000000000..6c440ed04c --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/remote_tuple_set.erl @@ -0,0 +1,8 @@ +-module(remote_tuple_set). + +-export([parse_cidr/0]). + +-spec parse_cidr() -> {inet:address_family(),1,2} | {error}. + +parse_cidr() -> + {inet,1,2}. diff --git a/lib/diameter/doc/src/diameter_app.xml b/lib/diameter/doc/src/diameter_app.xml index 4a4b212787..9d8a6568eb 100644 --- a/lib/diameter/doc/src/diameter_app.xml +++ b/lib/diameter/doc/src/diameter_app.xml @@ -112,7 +112,8 @@ and, for the call-specific callbacks, any extra arguments passed to <item> <p> A record containing the identities of -the local Diameter node and the remote Diameter peer having an established transport +the local Diameter node and the remote Diameter peer having an +established transport connection, as well as the capabilities as determined by capabilities exchange. Each field of the record is a 2-tuple consisting of @@ -168,13 +169,14 @@ Fields should not be set in return values except as documented.</p> <tag><c>peer_ref() = term()</c></tag> <item> <p> -A term identifying a transport connection with a Diameter peer. -Should be treated opaquely.</p> +A term identifying a transport connection with a Diameter peer.</p> </item> <marker id="peer"/> -<tag><c>peer() = {<seealso marker="#peer_ref">peer_ref()</seealso>, <seealso marker="#capabilities">capabilities()</seealso>}</c></tag> +<tag><c>peer() = + {<seealso marker="#peer_ref">peer_ref()</seealso>, + <seealso marker="#capabilities">capabilities()</seealso>}</c></tag> <item> <p> A tuple representing a Diameter peer connection.</p> @@ -219,10 +221,29 @@ process.</p> </type> <desc> <p> -Invoked when a transport connection has been established -and a successful capabilities exchange has indicated that the peer -supports the Diameter application of the application on which -the callback module in question has been configured.</p> +Invoked to signal the availability of a peer connection. +In particular, capabilities exchange with the peer has indicated +support for the application in question, the RFC 3539 watchdog state +machine for the connection has reached state <c>OKAY</c> and Diameter +messages can be both sent and received.</p> + +<note> +<p> +A watchdog state machine can reach state <c>OKAY</c> from state +<c>SUSPECT</c> without a new capabilities exchange taking place. +A new transport connection (and capabilities exchange) results in a +new peer_ref().</p> +</note> + +<note> +<p> +There is no requirement that a callback return before incoming +requests are received: <seealso +marker="#handle_request">handle_request/3</seealso> callbacks must be +handled independently of <seealso +marker="#peer_up">peer_up/3</seealso> and <seealso +marker="#peer_down">peer_down/3</seealso>.</p> +</note> <marker id="peer_down"/> </desc> @@ -238,36 +259,42 @@ the callback module in question has been configured.</p> </type> <desc> <p> -Invoked when a transport connection has been lost following a previous -call to <seealso marker="#peer_up">peer_up/3</seealso>.</p> +Invoked to signal that a peer connection is no longer available +following a previous call to <seealso +marker="#peer_up">peer_up/3</seealso>. +In particular, that the RFC 3539 watchdog state machine for the +connection has left state <c>OKAY</c> and the peer will no longer be a +candidate in <seealso marker="#pick_peer">pick_peer()</seealso> +callbacks.</p> <marker id="pick_peer"/> </desc> </func> <func> -<name>Mod:pick_peer(Candidates, Reserved, SvcName, State) - -> {ok, Peer} | {Peer, NewState} | false</name> +<name>Mod:pick_peer(Candidates, _Reserved, SvcName, State) + -> Selection | false</name> <fsummary>Select a target peer for an outgoing request.</fsummary> <type> <v>Candidates = [<seealso marker="#peer">peer()</seealso>]</v> -<v>Peer = <seealso marker="#peer">peer()</seealso> | false</v> <v>SvcName = <seealso marker="diameter#service_name">diameter:service_name()</seealso></v> <v>State = NewState = <seealso marker="#state">state()</seealso></v> +<v>Selection = {ok, Peer} | {Peer, NewState}</v> +<v>Peer = <seealso marker="#peer">peer()</seealso> | false</v> </type> <desc> <p> Invoked as a consequence of a call to <seealso marker="diameter#call">diameter:call/4</seealso> to select a destination -peer for an outgoing request, the return value indicating the selected -peer.</p> +peer for an outgoing request. +The return value indicates the selected peer.</p> <p> -The candidate peers list will only include those -which are selected by any <c>filter</c> option specified in the call to -<seealso marker="diameter#call">diameter:call/4</seealso>, and only -those which have indicated support for the Diameter application in -question. +The candidate list contains only those peers that have advertised +support for the Diameter application in question during capabilities +exchange, that have not be excluded by a <c>filter</c> option in +the call to <seealso marker="diameter#call">diameter:call/4</seealso> +and whose watchdog state machine is in the <c>OKAY</c> state. The order of the elements is unspecified except that any peers whose Origin-Host and Origin-Realm matches that of the outgoing request (in the sense of a <c>{filter, {all, [host, realm]}}</c> @@ -275,36 +302,40 @@ option to <seealso marker="diameter#call">diameter:call/4</seealso>) will be placed at the head of the list.</p> <p> -The return values <c>false</c> and <c>{false, State}</c> are -equivalent when callback state is mutable, as are -<c>{ok, Peer}</c> and <c>{Peer, State}</c>. -Returning a peer as <c>false</c> causes <c>{error, no_connection}</c> -to be returned from <seealso marker="diameter#call">diameter:call/4</seealso>. -Returning a <seealso marker="#peer">peer()</seealso> from an initial -pick_peer/4 callback will result in a -<seealso marker="#prepare_request">prepare_request/3</seealso> callback -followed by either <seealso -marker="#handle_answer">handle_answer/4</seealso> +A callback that returns a peer() will be followed by a +<seealso marker="#prepare_request">prepare_request/3</seealso> +callback and, if the latter indicates that the request should be sent, +by either <seealso marker="#handle_answer">handle_answer/4</seealso> or <seealso marker="#handle_error">handle_error/4</seealso> depending on whether or not an answer message is received from the peer. -If transport with the peer is lost before this then a new <seealso -marker="#pick_peer">pick_peer/4</seealso> callback takes place to -select an alternate peer.</p> - -<p> -Note that there is no guarantee that a <seealso +If the transport becomes unavailable after <seealso +marker="prepare_request">prepare_request/3</seealso> then a new <seealso +marker="#pick_peer">pick_peer/4</seealso> callback may take place to +failover to an alternate peer, after which <seealso +marker="#prepare_retransmit">prepare_retransmit/3</seealso> takes the +place of <seealso +marker="prepare_request">prepare_request/3</seealso> in resending the +request. +There is no guarantee that a <seealso marker="#pick_peer">pick_peer/4</seealso> callback to select -an alternate peer will be followed by any additional callbacks, only -that the initial <seealso -marker="#pick_peer">pick_peer/4</seealso> will be, since a +an alternate peer will be followed by any additional callbacks since a retransmission to an alternate peer is abandoned if an answer is received from a previously selected peer.</p> +<p> +Returning <c>false</c> or <c>{false, NewState}</c> causes <c>{error, +no_connection}</c> to be returned from <seealso +marker="diameter#call">diameter:call/4</seealso>.</p> + +<p> +The return values <c>false</c> and <c>{false, State}</c> (that is, +<c>NewState = State</c>) are equivalent, as are <c>{ok, Peer}</c> and +<c>{Peer, State}</c>.</p> + <note> <p> -<c>{Peer, NewState}</c> and its equivalents can only be returned if -the Diameter application in question was -configured with the <seealso +The return value <c>{Peer, NewState}</c> is only allowed if +the Diameter application in question was configured with the <seealso marker="diameter#application_opt">diameter:application_opt()</seealso> <c>{call_mutates_state, true}</c>. Otherwise, the <c>State</c> argument is always @@ -325,33 +356,45 @@ or <seealso marker="#peer_down">peer_down/3</seealso> callback.</p> <v>Packet = <seealso marker="#packet">packet()</seealso></v> <v>SvcName = <seealso marker="diameter#service_name">diameter:service_name()</seealso></v> <v>Peer = <seealso marker="#peer">peer()</seealso></v> -<v>Action = {send, <seealso marker="#packet">packet()</seealso> | <seealso marker="#message">message()</seealso>} | {discard, Reason} | discard</v> +<v>Action = Send | Discard | {eval_packet, Action, PostF}</v> +<v>Send = {send, <seealso marker="#packet">packet()</seealso> + | <seealso marker="#message">message()</seealso>}</v> +<v>Discard = {discard, Reason} | discard</v> +<v>PostF = + <seealso marker="diameter#evaluable">diameter:evaluable()</seealso>}</v> </type> <desc> <p> Invoked to return a request for encoding and transport. -Allows the sender to access the selected peer's capabilities -in order to set (for example) <c>Destination-Host</c> and/or -<c>Destination-Realm</c> in the outgoing request, although the -callback need not be limited to this usage. +Allows the sender to use the selected peer's capabilities +to modify the outgoing request. Many implementations may simply want to return <c>{send, Packet}</c></p> <p> -A returned <seealso marker="#packet">packet()</seealso> should set the request to be encoded in its +A returned <seealso marker="#packet">packet()</seealso> should set the +request to be encoded in its <c>msg</c> field and can set the <c>transport_data</c> field in order -to pass information to the transport module. +to pass information to the transport process. Extra arguments passed to <seealso marker="diameter#call">diameter:call/4</seealso> can be used to -communicate transport data to the callback. -A returned <seealso marker="#packet">packet()</seealso> can also set the <c>header</c> field to a -<c>#diameter_header{}</c> record in order to specify values that should -be preserved in the outgoing request, although this should typically -not be necessary and allows the callback to set header values -inappropriately. +communicate transport (or any other) data to the callback.</p> + +<p> +A returned <seealso marker="#packet">packet()</seealso> can set +the <c>header</c> field to a +<c>#diameter_header{}</c> in order to specify values that should +be preserved in the outgoing request, values otherwise being those in +the header record contained in <c>Packet</c>. A returned <c>length</c>, <c>cmd_code</c> or <c>application_id</c> is ignored.</p> <p> +A returned <c>PostF</c> will be evaluated on any encoded +<c>#diameter_packet{}</c> prior to transmission, the <c>bin</c> field +containing the encoded binary. +The return value is ignored.</p> + +<p> Returning <c>{discard, Reason}</c> causes the request to be aborted and the <seealso marker="diameter#call">diameter:call/4</seealso> for which the @@ -364,13 +407,18 @@ discarded}</c>.</p> </func> <func> -<name>Mod:prepare_retransmit(Packet, SvcName, Peer) -> Result</name> +<name>Mod:prepare_retransmit(Packet, SvcName, Peer) -> Action</name> <fsummary>Return a request for encoding and retransmission.</fsummary> <type> <v>Packet = <seealso marker="#packet">packet()</seealso></v> <v>SvcName = <seealso marker="diameter#service_name">diameter:service_name()</seealso></v> -<v>Peer = <seealso marker="#peer">peer()</seealso></v> -<v>Result = {send, <seealso marker="#packet">packet()</seealso> | <seealso marker="#message">message()</seealso>} | {discard, Reason} | discard</v> +<v>Peer = <seealso marker="#peer">peer()</seealso></v> +<v>Action = Send | Discard | {eval_packet, Action, PostF}</v> +<v>Send = {send, <seealso marker="#packet">packet()</seealso> + | <seealso marker="#message">message()</seealso>}</v> +<v>Discard = {discard, Reason} | discard</v> +<v>PostF = + <seealso marker="diameter#evaluable">diameter:evaluable()</seealso>}</v> </type> <desc> <p> @@ -378,8 +426,9 @@ Invoked to return a request for encoding and retransmission. Has the same role as <seealso marker="#prepare_request">prepare_request/3</seealso> in the case that a peer connection is lost an an alternate peer selected but the -argument <seealso marker="#packet">packet()</seealso> is as returned by the initial -<c>prepare_request/3</c>.</p> +argument <seealso marker="#packet">packet()</seealso> is as returned +by the initial <seealso +marker="#prepare_request">prepare_request/3</seealso>.</p> <p> Returning <c>{discard, Reason}</c> causes the request to be aborted @@ -406,40 +455,41 @@ discarded}</c>.</p> <desc> <p> Invoked when an answer message is received from a peer. -The return value is returned from the call to <seealso -marker="diameter#call">diameter:call/4</seealso> for which the -callback takes place unless the <c>detach</c> option was -specified.</p> +The return value is returned from <seealso +marker="diameter#call">diameter:call/4</seealso> unless the +<c>detach</c> option was specified.</p> <p> -The decoded answer record is in the <c>msg</c> field of the argument -<seealso marker="#packet">packet()</seealso>, -the undecoded binary in the <c>packet</c> field. +The decoded answer record and undecoded binary are in the <c>msg</c> +and <c>bin</c> fields of the argument +<seealso marker="#packet">packet()</seealso> respectively. <c>Request</c> is the outgoing request message as was returned from <seealso marker="#prepare_request">prepare_request/3</seealso> or -<seealso marker="#prepare_retransmit">prepare_retransmit/3</seealso> -before the request was passed to the transport.</p> +<seealso + marker="#prepare_retransmit">prepare_retransmit/3</seealso>.</p> <p> For any given call to <seealso marker="diameter#call">diameter:call/4</seealso> there is at most one -call to the handle_answer callback of the application in question: any +<seealso marker="#handle_answer">handle_answer/4</seealso> callback: any duplicate answer (due to retransmission or otherwise) is discarded. -Similarly, only one of <c>handle_answer/4</c> or <c>handle_error/4</c> is -called for any given request.</p> +Similarly, only one of <seealso +marker="#handle_answer">handle_answer/4</seealso> or +<seealso marker="#handle_error">handle_error/4</seealso> is +called.</p> <p> By default, an incoming answer message that cannot be successfully -decoded causes the request process in question to fail, causing the -relevant call to <seealso -marker="diameter#call">diameter:call/4</seealso> -to return <c>{error, failure} (unless the <c>detach</c> option was -specified)</c>. -In particular, there is no <c>handle_error/4</c> callback in this +decoded causes the request process to fail, causing +<seealso marker="diameter#call">diameter:call/4</seealso> +to return <c>{error, failure}</c> unless the <c>detach</c> option was +specified. +In particular, there is no <seealso +marker="#handle_error">handle_error/4</seealso> callback in this case. -Application configuration may change this behaviour as described for -<seealso -marker="diameter#start_service">diameter:start_service/2</seealso>.</p> +The <seealso +marker="diameter#application_opt">diameter:application_opt()</seealso> +<c>answer_errors</c> can be set to change this behaviour.</p> <marker id="handle_error"/> </desc> @@ -457,21 +507,20 @@ marker="diameter#start_service">diameter:start_service/2</seealso>.</p> </type> <desc> <p> -Invoked when an error occurs before an answer message is received from -a peer in response to an outgoing request. -The return value is returned from the call to <seealso -marker="diameter#call">diameter:call/4</seealso> for which the -callback takes place (unless the <c>detach</c> option was -specified).</p> +Invoked when an error occurs before an answer message is received +in response to an outgoing request. +The return value is returned from <seealso +marker="diameter#call">diameter:call/4</seealso> unless the +<c>detach</c> option was specified.</p> <p> Reason <c>timeout</c> indicates that an answer message has not been -received within the required time. +received within the time specified with the corresponding <seealso +marker="diameter#call_opt">diameter:call_opt()</seealso>. Reason <c>failover</c> indicates that the transport connection to the peer to which the request has -been sent has been lost but that not alternate node was available, -possibly because a <seealso marker="#pick_peer">pick_peer/4</seealso> -callback returned false.</p> +been sent has become unavailable and that not alternate peer was +not selected.</p> <marker id="handle_request"/> </desc> @@ -484,7 +533,10 @@ callback returned false.</p> <v>Packet = <seealso marker="#packet">packet()</seealso></v> <v>SvcName = term()</v> <v>Peer = <seealso marker="#peer">peer()</seealso></v> -<v>Action = Reply | {relay, [Opt]} | discard | {eval, Action, PostF}</v> +<v>Action = Reply + | {relay, [Opt]} + | discard + | {eval|eval_packet, Action, PostF}</v> <v>Reply = {reply, <seealso marker="#message">message()</seealso>} | {protocol_error, 3000..3999}</v> <v>Opt = <seealso marker="diameter#call_opt">diameter:call_opt()</seealso></v> @@ -603,14 +655,25 @@ causes the request to be answered with 3002 (DIAMETER_UNABLE_TO_DELIVER).</p> <tag><c>discard</c></tag> <item> <p> -Discard the request.</p> +Discard the request. +No answer message is sent to the peer.</p> </item> <tag><c>{eval, Action, PostF}</c></tag> <item> <p> Handle the request as if <c>Action</c> has been returned and then -evaluate <c>PostF</c> in the request process.</p> +evaluate <c>PostF</c> in the request process. +The return value is ignored.</p> +</item> + +<tag><c>{eval_packet, Action, PostF}</c></tag> +<item> +<p> +Like <c>eval</c> but evaluate <c>PostF</c> on any encoded +<c>#diameter_packet{}</c> prior to transmission, the <c>bin</c> field +containing the encoded binary. +The return value is ignored.</p> </item> </taglist> diff --git a/lib/diameter/src/base/diameter_capx.erl b/lib/diameter/src/base/diameter_capx.erl index 6c4d60ee9b..190d37262b 100644 --- a/lib/diameter/src/base/diameter_capx.erl +++ b/lib/diameter/src/base/diameter_capx.erl @@ -141,7 +141,9 @@ cap('Host-IP-Address', Vs) when is_list(Vs) -> lists:map(fun ipaddr/1, Vs); -cap('Firmware-Revision', V) -> +cap(K, V) + when K == 'Firmware-Revision'; + K == 'Origin-State-Id' -> [V]; cap(_, Vs) @@ -149,7 +151,7 @@ cap(_, Vs) Vs; cap(K, V) -> - ?THROW({invalid, K, V}). + ?THROW({invalid, {K,V}}). ipaddr(A) -> try diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl index e47f63f814..d1916c26e6 100644 --- a/lib/diameter/src/base/diameter_config.erl +++ b/lib/diameter/src/base/diameter_config.erl @@ -563,7 +563,7 @@ make_caps(Caps, Opts) -> case diameter_capx:make_caps(Caps, Opts) of {ok, T} -> T; - {error, {Reason, _}} -> + {error, Reason} -> ?THROW(Reason) end. diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index 725cccda1e..2fcd35c9a9 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -979,10 +979,9 @@ connection_up(T, P, C, #state{peerT = PeerT, insert(PeerT, P#peer{op_state = {?STATE_UP, ?WD_OKAY}}), request_peer_up(TPid), + insert_local_peer(SApps, {{TPid, Caps}, {SvcName, Apps}}, LDict), report_status(up, P, C, S, T), - S#state{local_peers = insert_local_peer(SApps, - {{TPid, Caps}, {SvcName, Apps}}, - LDict)}. + S. insert_local_peer(SApps, T, LDict) -> lists:foldl(fun(A,D) -> ilp(A, T, D) end, LDict, SApps). @@ -1058,12 +1057,9 @@ connection_down(#peer{conn = TPid, local_peers = LDict} = S) -> report_status(down, P, C, S, []), - NewS = S#state{local_peers - = remove_local_peer(SApps, - {{TPid, Caps}, {SvcName, Apps}}, - LDict)}, - request_peer_down(TPid, NewS), - NewS. + remove_local_peer(SApps, {{TPid, Caps}, {SvcName, Apps}}, LDict), + request_peer_down(TPid, S), + S. remove_local_peer(SApps, T, LDict) -> lists:foldl(fun(A,D) -> rlp(A, T, D) end, LDict, SApps). @@ -1301,28 +1297,34 @@ cm([_,_|_], _, _, _) -> %% The mod field of the #diameter_app{} here includes any extra %% arguments passed to diameter:call/2. -send_request({TPid, Caps, App}, Msg, Opts, Caller, SvcName) -> +send_request({TPid, Caps, App} = T, Msg, Opts, Caller, SvcName) -> #diameter_app{module = ModX} = App, Pkt = make_request_packet(Msg), - case cb(ModX, prepare_request, [Pkt, SvcName, {TPid, Caps}]) of - {send, P} -> - send_request(make_request_packet(P, Pkt), - TPid, - Caps, - App, - Opts, - Caller, - SvcName); - {discard, Reason} -> - {error, Reason}; - discard -> - {error, discarded}; - T -> - ?ERROR({invalid_return, prepare_request, App, T}) - end. + send_req(cb(ModX, prepare_request, [Pkt, SvcName, {TPid, Caps}]), + Pkt, + T, + Opts, + Caller, + SvcName, + []). + +send_req({send, P}, Pkt, T, Opts, Caller, SvcName, Fs) -> + send_request(make_request_packet(P, Pkt), T, Opts, Caller, SvcName, Fs); + +send_req({discard, Reason} , _, _, _, _, _, _) -> + {error, Reason}; + +send_req(discard, _, _, _, _, _, _) -> + {error, discarded}; + +send_req({eval_packet, RC, F}, Pkt, T, Opts, Caller, SvcName, Fs) -> + send_req(RC, Pkt, T, Opts, Caller, SvcName, [F|Fs]); + +send_req(E, _, {_, _, App}, _, _, _, _) -> + ?ERROR({invalid_return, prepare_request, App, E}). %% make_request_packet/1 %% @@ -1400,16 +1402,16 @@ fold_record(undefined, R) -> fold_record(Rec, R) -> diameter_lib:fold_tuple(2, Rec, R). -%% send_request/7 +%% send_request/6 -send_request(Pkt, TPid, Caps, App, Opts, Caller, SvcName) -> +send_request(Pkt, {TPid, Caps, App}, Opts, Caller, SvcName, Fs) -> #diameter_app{alias = Alias, dictionary = Dict, module = ModX, options = [{answer_errors, AE} | _]} = App, - EPkt = encode(Dict, Pkt), + EPkt = encode(Dict, Pkt, Fs), #options{filter = Filter, timeout = Timeout} @@ -1490,6 +1492,13 @@ msg(#diameter_packet{msg = undefined, bin = Bin}) -> msg(#diameter_packet{msg = Msg}) -> Msg. +%% encode/3 + +encode(Dict, Pkt, Fs) -> + P = encode(Dict, Pkt), + eval_packet(P, Fs), + P. + %% encode/2 %% Note that prepare_request can return a diameter_packet containing @@ -1571,38 +1580,47 @@ send(Pid, Pkt) -> %% retransmit/4 -retransmit({TPid, Caps, #diameter_app{alias = Alias} = App}, - #request{app = Alias, - packet = Pkt} +retransmit({TPid, Caps, #diameter_app{alias = Alias} = App} = T, + #request{app = Alias, packet = Pkt} = Req, SvcName, Timeout) -> have_request(Pkt, TPid) %% Don't failover to a peer we've andalso ?THROW(timeout), %% already sent to. - case cb(App, prepare_retransmit, [Pkt, SvcName, {TPid, Caps}]) of - {send, P} -> - retransmit(make_request_packet(P, Pkt), TPid, Caps, Req, Timeout); - {discard, Reason} -> - ?THROW(Reason); - discard -> - ?THROW(discarded); - T -> - ?ERROR({invalid_return, prepare_retransmit, App, T}) - end. + resend_req(cb(App, prepare_retransmit, [Pkt, SvcName, {TPid, Caps}]), + T, + Req, + Timeout, + []). -%% retransmit/5 +resend_req({send, P}, T, #request{packet = Pkt} = Req, Timeout, Fs) -> + retransmit(make_request_packet(P, Pkt), T, Req, Timeout, Fs); -retransmit(Pkt, TPid, Caps, #request{dictionary = Dict} = Req, Timeout) -> - EPkt = encode(Dict, Pkt), +resend_req({discard, Reason}, _, _, _, _) -> + ?THROW(Reason); - NewReq = Req#request{transport = TPid, - packet = Pkt, - caps = Caps}, +resend_req(discard, _, _, _, _) -> + ?THROW(discarded); - ?LOG(retransmission, NewReq), - TRef = send_request(TPid, EPkt, NewReq, Timeout), - {TRef, NewReq}. +resend_req({eval_packet, RC, F}, T, Req, Timeout, Fs) -> + resend_req(RC, T, Req, Timeout, [F|Fs]); + +resend_req(T, {_, _, App}, _, _, _) -> + ?ERROR({invalid_return, prepare_retransmit, App, T}). + +%% retransmit/6 + +retransmit(Pkt, {TPid, Caps, _}, #request{dictionary = D} = Req0, Tmo, Fs) -> + EPkt = encode(D, Pkt, Fs), + + Req = Req0#request{transport = TPid, + packet = Pkt, + caps = Caps}, + + ?LOG(retransmission, Req), + TRef = send_request(TPid, EPkt, Req, Tmo), + {TRef, Req}. %% store_request/4 @@ -1805,7 +1823,12 @@ recv_request(T, TC, App, Pkt) -> %% (3xxx) errors that lead to an answer-message. request_cb({SvcName, _OH, _OR} = T, TC, App, Pkt) -> - request_cb(cb(App, handle_request, [Pkt, SvcName, TC]), App, T, TC, Pkt). + request_cb(cb(App, handle_request, [Pkt, SvcName, TC]), + App, + T, + TC, + [], + Pkt). %% examine/1 %% @@ -1825,7 +1848,7 @@ examine(#diameter_packet{errors = Es} = Pkt) -> Pkt#diameter_packet{errors = [5011 | Es]}. %% It's odd/unfortunate that this isn't a protocol error. -%% request_cb/5 +%% request_cb/6 %% A reply may be an answer-message, constructed either here or by %% the handle_request callback. The header from the incoming request @@ -1836,20 +1859,21 @@ request_cb({reply, Ans}, #diameter_app{dictionary = Dict}, _, {TPid, _}, + Fs, Pkt) -> - reply(Ans, Dict, TPid, Pkt); + reply(Ans, Dict, TPid, Fs, Pkt); %% An 3xxx result code, for which the E-bit is set in the header. -request_cb({protocol_error, RC}, _, T, {TPid, _}, Pkt) +request_cb({protocol_error, RC}, _, T, {TPid, _}, Fs, Pkt) when 3000 =< RC, RC < 4000 -> - protocol_error(RC, T, TPid, Pkt); + protocol_error(RC, T, TPid, Fs, Pkt); %% RFC 3588 says we must reply 3001 to anything unrecognized or %% unsupported. 'noreply' is undocumented (and inappropriately named) %% backwards compatibility for this, protocol_error the documented %% alternative. -request_cb(noreply, _, T, {TPid, _}, Pkt) -> - protocol_error(3001, T, TPid, Pkt); +request_cb(noreply, _, T, {TPid, _}, Fs, Pkt) -> + protocol_error(3001, T, TPid, Fs, Pkt); %% Relay a request to another peer. This is equivalent to doing an %% explicit call/4 with the message in question except that (1) a loop @@ -1871,26 +1895,36 @@ request_cb({A, Opts}, = App, T, TC, + Fs, Pkt) when A == relay, Id == ?APP_ID_RELAY; A == proxy, Id /= ?APP_ID_RELAY; A == resend -> - resend(Opts, App, T, TC, Pkt); + resend(Opts, App, T, TC, Fs, Pkt); -request_cb(discard, _, _, _, _) -> +request_cb(discard, _, _, _, _, _) -> ok; -request_cb({eval, RC, F}, App, T, TC, Pkt) -> - request_cb(RC, App, T, TC, Pkt), +request_cb({eval_packet, RC, F}, App, T, TC, Fs, Pkt) -> + request_cb(RC, App, T, TC, [F|Fs], Pkt); + +request_cb({eval, RC, F}, App, T, TC, Fs, Pkt) -> + request_cb(RC, App, T, TC, Pkt, Fs), diameter_lib:eval(F). -%% protocol_error/4 +%% protocol_error/5 -protocol_error(RC, {_, OH, OR}, TPid, #diameter_packet{avps = Avps} = Pkt) -> +protocol_error(RC, {_, OH, OR}, TPid, Fs, Pkt) -> + #diameter_packet{avps = Avps} = Pkt, ?LOG({error, RC}, Pkt), - reply(answer_message({OH, OR, RC}, Avps), ?BASE, TPid, Pkt). + reply(answer_message({OH, OR, RC}, Avps), ?BASE, TPid, Fs, Pkt). + +%% protocol_error/4 -%% resend/5 +protocol_error(RC, T, TPid, Pkt) -> + protocol_error(RC, T, TPid, [], Pkt). + +%% resend/6 %% %% Resend a message as a relay or proxy agent. @@ -1898,9 +1932,12 @@ resend(Opts, #diameter_app{} = App, {_SvcName, OH, _OR} = T, {_TPid, _Caps} = TC, + Fs, #diameter_packet{avps = Avps} = Pkt) -> {Code, _Flags, Vid} = ?BASE:avp_header('Route-Record'), - resend(is_loop(Code, Vid, OH, Avps), Opts, App, T, TC, Pkt). + resend(is_loop(Code, Vid, OH, Avps), Opts, App, T, TC, Fs, Pkt). + +%% resend/7 %% DIAMETER_LOOP_DETECTED 3005 %% An agent detected a loop while trying to get the message to the @@ -1908,8 +1945,8 @@ resend(Opts, %% if one is available, but the peer reporting the error has %% identified a configuration problem. -resend(true, _, _, T, {TPid, _}, Pkt) -> %% Route-Record loop - protocol_error(3005, T, TPid, Pkt); +resend(true, _, _, T, {TPid, _}, Fs, Pkt) -> %% Route-Record loop + protocol_error(3005, T, TPid, Fs, Pkt); %% 6.1.8. Relaying and Proxying Requests %% @@ -1922,6 +1959,7 @@ resend(false, App, {SvcName, _, _} = T, {TPid, #diameter_caps{origin_host = {_, OH}}}, + Fs, #diameter_packet{header = Hdr0, avps = Avps} = Pkt) -> @@ -1929,7 +1967,7 @@ resend(false, Seq = diameter_session:sequence(), Hdr = Hdr0#diameter_header{hop_by_hop_id = Seq}, Msg = [Hdr, Route | Avps], - resend(call(SvcName, App, Msg, Opts), T, TPid, Pkt). + resend(call(SvcName, App, Msg, Opts), T, TPid, Fs, Pkt). %% The incoming request is relayed with the addition of a %% Route-Record. Note the requirement on the return from call/4 below, %% which places a requirement on the value returned by the @@ -1955,15 +1993,18 @@ resend(#diameter_packet{bin = B} = Pkt, _, TPid, + Fs, #diameter_packet{header = #diameter_header{hop_by_hop_id = Id}, transport_data = TD}) -> - send(TPid, Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B), - transport_data = TD}); + P = Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B), + transport_data = TD}, + eval_packet(P, Fs), + send(TPid, P); %% TODO: counters %% Or not: DIAMETER_UNABLE_TO_DELIVER. -resend(_, T, TPid, Pkt) -> - protocol_error(3002, T, TPid, Pkt). +resend(_, T, TPid, Fs, Pkt) -> + protocol_error(3002, T, TPid, Fs, Pkt). %% is_loop/4 %% @@ -1985,33 +2026,38 @@ is_loop(Code, Vid, OH, [_ | Avps]) is_loop(Code, Vid, OH, Avps) -> is_loop(Code, Vid, ?BASE:avp(encode, OH, 'Route-Record'), Avps). -%% reply/4 +%% reply/5 %% %% Send a locally originating reply. %% Skip the setting of Result-Code and Failed-AVP's below. -reply([Msg], Dict, TPid, Pkt) +reply([Msg], Dict, TPid, Fs, Pkt) when is_list(Msg); is_tuple(Msg) -> - reply(Msg, Dict, TPid, Pkt#diameter_packet{errors = []}); + reply(Msg, Dict, TPid, Fs, Pkt#diameter_packet{errors = []}); %% No errors or a diameter_header/avp list. -reply(Msg, Dict, TPid, #diameter_packet{errors = Es, - transport_data = TD} - = ReqPkt) +reply(Msg, Dict, TPid, Fs, #diameter_packet{errors = Es, + transport_data = TD} + = ReqPkt) when [] == Es; is_record(hd(Msg), diameter_header) -> Pkt = diameter_codec:encode(Dict, make_answer_packet(Msg, ReqPkt)), + eval_packet(Pkt, Fs), incr(send, Pkt, Dict, TPid), %% count result codes in sent answers send(TPid, Pkt#diameter_packet{transport_data = TD}); %% Or not: set Result-Code and Failed-AVP AVP's. -reply(Msg, Dict, TPid, #diameter_packet{errors = [H|_] = Es} = Pkt) -> +reply(Msg, Dict, TPid, Fs, #diameter_packet{errors = [H|_] = Es} = Pkt) -> reply(rc(Msg, rc(H), [A || {_,A} <- Es], Dict), Dict, TPid, + Fs, Pkt#diameter_packet{errors = []}). +eval_packet(Pkt, Fs) -> + lists:foreach(fun(F) -> diameter_lib:eval([F,Pkt]) end, Fs). + %% make_answer_packet/2 %% Binaries and header/avp lists are sent as-is. diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl index d7474e5c56..53f5f42396 100644 --- a/lib/diameter/src/base/diameter_watchdog.erl +++ b/lib/diameter/src/base/diameter_watchdog.erl @@ -555,7 +555,7 @@ timeout(#watchdog{status = T, = S) when T == suspect; T == reopen, P, N < 0 -> - exit(TPid, shutdown), + exit(TPid, {shutdown, watchdog_timeout}), close(S), S#watchdog{status = down}; diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index 669918f757..dd07679764 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -624,7 +624,10 @@ prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Name) -> {send, prepare(Pkt, Caps, Name)}. prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, send_detach, _) -> - {send, prepare(Pkt, Caps)}. + {eval_packet, {send, prepare(Pkt, Caps)}, [fun log/2, detach]}. + +log(#diameter_packet{} = P, T) -> + io:format("~p: ~p~n", [T,P]). prepare(Pkt, Caps, send_unsupported) -> Req = prepare(Pkt, Caps), @@ -738,7 +741,7 @@ handle_request(#diameter_packet{msg = M}, ?SERVER, {_Ref, Caps}) -> request(#diameter_base_accounting_ACR{'Accounting-Record-Number' = 0}, _) -> - {protocol_error, ?INVALID_AVP_BITS}; + {eval_packet, {protocol_error, ?INVALID_AVP_BITS}, [fun log/2, invalid]}; request(#diameter_base_accounting_ACR{'Session-Id' = SId, 'Accounting-Record-Type' = RT, diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 1579735773..bc7ea17077 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -687,8 +687,8 @@ t_solve_remote(?tuple(Types, _Arity, _Tag), ET, R, C) -> {RL, RR} = list_solve_remote(Types, ET, R, C), {t_tuple(RL), RR}; t_solve_remote(?tuple_set(Set), ET, R, C) -> - {NewSet, RR} = tuples_solve_remote(Set, ET, R, C), - {?tuple_set(NewSet), RR}; + {NewTuples, RR} = tuples_solve_remote(Set, ET, R, C), + {t_sup(NewTuples), RR}; t_solve_remote(?remote(Set), ET, R, C) -> RemoteList = ordsets:to_list(Set), {RL, RR} = list_solve_remote_type(RemoteList, ET, R, C), @@ -788,10 +788,10 @@ opaques_solve_remote([#opaque{struct = Struct} = Remote|Tail], ET, R, C) -> tuples_solve_remote([], _ET, _R, _C) -> {[], []}; -tuples_solve_remote([{Sz, Tuples}|Tail], ET, R, C) -> +tuples_solve_remote([{_Sz, Tuples}|Tail], ET, R, C) -> {RL, RR1} = list_solve_remote(Tuples, ET, R, C), {LSzTpls, RR2} = tuples_solve_remote(Tail, ET, R, C), - {[{Sz, RL}|LSzTpls], RR1 ++ RR2}. + {RL ++ LSzTpls, RR1 ++ RR2}. %%----------------------------------------------------------------------------- %% Unit type. Signals non termination. diff --git a/lib/ic/test/java_client_erl_server_SUITE_data/Makefile.src b/lib/ic/test/java_client_erl_server_SUITE_data/Makefile.src index c106261efd..ac8f2e619f 100644 --- a/lib/ic/test/java_client_erl_server_SUITE_data/Makefile.src +++ b/lib/ic/test/java_client_erl_server_SUITE_data/Makefile.src @@ -66,8 +66,11 @@ CLASS_FILES = $(JAVA_FILES:.java=.class) ERL_FILES = $(GEN_ERL_FILES) m_i_impl.erl EBINS = $(ERL_FILES:.erl=.@EMULATOR@) - +@IFEQ@ (@jinterface_classpath@,) +all: +@ELSE all: $(CLASS_FILES) $(EBINS) +@ENDIF@ $(GEN_ERL_FILES) $(GEN_HRL_FILES): java_erl_test.built_erl $(GEN_JAVA_FILES): java_erl_test.built_java diff --git a/lib/inets/test/inets_app_test.erl b/lib/inets/test/inets_app_test.erl index db2218f3b6..d32f7e290b 100644 --- a/lib/inets/test/inets_app_test.erl +++ b/lib/inets/test/inets_app_test.erl @@ -35,6 +35,15 @@ 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. @@ -240,13 +249,6 @@ undef_funcs(suite) -> undef_funcs(doc) -> []; undef_funcs(Config) when is_list(Config) -> - %% 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), App = inets, AppFile = key1search(app_file, Config), Mods = key1search(modules, AppFile), diff --git a/lib/jinterface/test/jitu.erl b/lib/jinterface/test/jitu.erl index c57fb9bfad..fb262cf9d7 100644 --- a/lib/jinterface/test/jitu.erl +++ b/lib/jinterface/test/jitu.erl @@ -89,13 +89,19 @@ classpath(Dir) -> {win32, _} -> ";"; _ -> ":" end, - Dir++PS++ + es(Dir++PS++ filename:join([code:lib_dir(jinterface),"priv","OtpErlang.jar"])++PS++ case os:getenv("CLASSPATH") of false -> ""; Classpath -> Classpath - end. - + end). + +es(L) -> + lists:flatmap(fun($ ) -> + "\\ "; + (C) -> + [C] + end,lists:flatten(L)). cmd(Cmd) -> PortOpts = [{line,80},eof,exit_status,stderr_to_stdout], diff --git a/lib/kernel/doc/src/heart.xml b/lib/kernel/doc/src/heart.xml index 26d1e27822..2826d3d00a 100644 --- a/lib/kernel/doc/src/heart.xml +++ b/lib/kernel/doc/src/heart.xml @@ -71,6 +71,39 @@ timeout and try to reboot the system. This can happen, for example, if the system clock is adjusted automatically by use of NTP (Network Time Protocol).</p> + + <p> If a crash occurs, an <c><![CDATA[erl_crash.dump]]></c> will <em>not</em> be written + unless the environment variable <c><![CDATA[ERL_CRASH_DUMP_SECONDS]]></c> is set. + </p> + + <pre> +% <input>erl -heart -env ERL_CRASH_DUMP_SECONDS 10 ...</input></pre> + <p> + Furthermore, <c><![CDATA[ERL_CRASH_DUMP_SECONDS]]></c> has the following behaviour on + <c>heart</c>: + </p> + <taglist> + <tag><c><![CDATA[ERL_CRASH_DUMP_SECONDS=0]]></c></tag> + <item><p> + Suppresses the writing a crash dump file entirely, + thus rebooting the runtime system immediately. + This is the same as not setting the environment variable. + </p> + </item> + <tag><c><![CDATA[ERL_CRASH_DUMP_SECONDS=-1]]></c></tag> + <item><p> Setting the environment variable to a negative value will not reboot + the runtime system until the crash dump file has been completly written. + </p> + </item> + <tag><c><![CDATA[ERL_CRASH_DUMP_SECONDS=S]]></c></tag> + <item><p> + Heart will wait for <c>S</c> seconds to let the crash dump file be written. + After <c>S</c> seconds <c>heart</c> will reboot the runtime system regardless of + the crash dump file has been written or not. + </p> + </item> + </taglist> + <p>In the following descriptions, all function fails with reason <c>badarg</c> if <c>heart</c> is not started.</p> </description> diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl index 28452a377e..de287bfa43 100644 --- a/lib/kernel/src/heart.erl +++ b/lib/kernel/src/heart.erl @@ -42,6 +42,7 @@ -define(CLEAR_CMD, 5). -define(GET_CMD, 6). -define(HEART_CMD, 7). +-define(PREPARING_CRASH, 8). % Used in beam vm -define(TIMEOUT, 5000). -define(CYCLE_TIMEOUT, 10000). @@ -130,6 +131,8 @@ start_portprogram() -> Port when is_port(Port) -> case wait_ack(Port) of ok -> + %% register port so the vm can find it if need be + register(heart_port, Port), {ok, Port}; {error, Reason} -> report_problem({{port_problem, Reason}, diff --git a/lib/kernel/test/global_SUITE.erl b/lib/kernel/test/global_SUITE.erl index 60035b50a0..6eb2134644 100644 --- a/lib/kernel/test/global_SUITE.erl +++ b/lib/kernel/test/global_SUITE.erl @@ -168,7 +168,7 @@ end_per_testcase(_Case, Config) -> register_1(suite) -> []; register_1(Config) when is_list(Config) -> Timeout = 15, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), P = spawn_link(?MODULE, lock_global, [self(), Config]), @@ -195,7 +195,6 @@ register_1(Config) when is_list(Config) -> ?line _ = global:unregister_name(foo), write_high_level_trace(Config), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. lock_global(Parent, Config) -> @@ -238,7 +237,7 @@ lock_global(Parent, Config) -> both_known_1(suite) -> []; both_known_1(Config) when is_list(Config) -> Timeout = 30, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), @@ -316,7 +315,6 @@ both_known_1(Config) when is_list(Config) -> stop_node(Cp3), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. lost_unregister(suite) -> []; @@ -324,7 +322,7 @@ lost_unregister(doc) -> ["OTP-6428. An unregistered name reappears."]; lost_unregister(Config) when is_list(Config) -> Timeout = 30, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), @@ -361,7 +359,6 @@ lost_unregister(Config) when is_list(Config) -> stop_node(B), stop_node(C), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. -define(UNTIL_LOOP, 300). @@ -448,7 +445,7 @@ lock_global2(Id, Parent) -> names(suite) -> []; names(Config) when is_list(Config) -> Timeout = 30, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -532,7 +529,6 @@ names(Config) when is_list(Config) -> ?line ?UNTIL(undefined =:= global:whereis_name(test)), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. names_hidden(suite) -> []; @@ -541,7 +537,7 @@ names_hidden(doc) -> "visible nodes."]; names_hidden(Config) when is_list(Config) -> Timeout = 30, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -639,13 +635,12 @@ names_hidden(Config) when is_list(Config) -> stop_node(Cp3), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. locks(suite) -> []; locks(Config) when is_list(Config) -> Timeout = 30, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line {ok, Cp1} = start_node(cp1, Config), @@ -750,7 +745,6 @@ locks(Config) when is_list(Config) -> ?line test_server:sleep(10), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. @@ -760,7 +754,7 @@ locks_hidden(doc) -> "visible nodes."]; locks_hidden(Config) when is_list(Config) -> Timeout = 30, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNodes = nodes(), @@ -833,14 +827,13 @@ locks_hidden(Config) when is_list(Config) -> stop_node(Cp3), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. bad_input(suite) -> []; bad_input(Config) when is_list(Config) -> Timeout = 15, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), Pid = whereis(global_name_server), @@ -854,13 +847,12 @@ bad_input(Config) when is_list(Config) -> ?line {'EXIT', _} = (catch global:trans({id, self()}, {m,f}, [node()], -1)), ?line Pid = whereis(global_name_server), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. names_and_locks(suite) -> []; names_and_locks(Config) when is_list(Config) -> Timeout = 30, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -922,7 +914,6 @@ names_and_locks(Config) when is_list(Config) -> stop_node(Cp3), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. lock_die(suite) -> []; @@ -930,7 +921,7 @@ lock_die(doc) -> ["OTP-6341. Remove locks using monitors."]; lock_die(Config) when is_list(Config) -> Timeout = 30, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -964,7 +955,6 @@ lock_die(Config) when is_list(Config) -> stop_node(Cp1), stop_node(Cp2), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. name_die(suite) -> []; @@ -972,7 +962,7 @@ name_die(doc) -> ["OTP-6341. Remove names using monitors."]; name_die(Config) when is_list(Config) -> Timeout = 30, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -1027,7 +1017,6 @@ name_die(Config) when is_list(Config) -> write_high_level_trace(Config), stop_nodes(Cps), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. kill_pid(Pid, File, Config) -> @@ -1040,7 +1029,7 @@ basic_partition(doc) -> ["Tests that two partitioned networks exchange correct info."]; basic_partition(Config) when is_list(Config) -> Timeout = 30, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -1088,7 +1077,6 @@ basic_partition(Config) when is_list(Config) -> stop_node(Cp2), stop_node(Cp3), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. basic_name_partition(suite) -> @@ -1099,7 +1087,7 @@ basic_name_partition(doc) -> "during connect phase are handled correctly."]; basic_name_partition(Config) when is_list(Config) -> Timeout = 60, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -1167,7 +1155,6 @@ basic_name_partition(Config) when is_list(Config) -> stop_node(Cp2), stop_node(Cp3), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. %Peer nodes cp0 - cp6 are started. Break apart the connections from @@ -1190,7 +1177,7 @@ advanced_partition(doc) -> "partitioned networks connect."]; advanced_partition(Config) when is_list(Config) -> Timeout = 60, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -1278,7 +1265,6 @@ advanced_partition(Config) when is_list(Config) -> stop_node(Cp5), stop_node(Cp6), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. %Peer nodes cp0 - cp6 are started, and partitioned just like in @@ -1297,7 +1283,7 @@ stress_partition(doc) -> "go up/down a bit."]; stress_partition(Config) when is_list(Config) -> Timeout = 90, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -1377,7 +1363,6 @@ stress_partition(Config) when is_list(Config) -> stop_node(Cp7), stop_node(Cp8), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. @@ -1408,7 +1393,7 @@ ring(doc) -> "Make sure that there's just one winner."]; ring(Config) when is_list(Config) -> Timeout = 60, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -1486,7 +1471,6 @@ ring(Config) when is_list(Config) -> stop_node(Cp7), stop_node(Cp8), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. simple_ring(suite) -> @@ -1499,7 +1483,7 @@ simple_ring(doc) -> "Make sure that there's just one winner."]; simple_ring(Config) when is_list(Config) -> Timeout = 60, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -1565,7 +1549,6 @@ simple_ring(Config) when is_list(Config) -> stop_node(Cp4), stop_node(Cp5), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. line(suite) -> @@ -1576,7 +1559,7 @@ line(doc) -> "Make sure that there's just one winner."]; line(Config) when is_list(Config) -> Timeout = 60, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -1655,7 +1638,6 @@ line(Config) when is_list(Config) -> stop_node(Cp7), stop_node(Cp8), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. @@ -1669,7 +1651,7 @@ simple_line(doc) -> "Make sure that there's just one winner."]; simple_line(Config) when is_list(Config) -> Timeout = 60, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -1735,7 +1717,6 @@ simple_line(Config) when is_list(Config) -> stop_node(Cp4), stop_node(Cp5), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. otp_1849(suite) -> []; @@ -1743,7 +1724,7 @@ otp_1849(doc) -> ["Test ticket: Global should keep track of all pids that set the same lock."]; otp_1849(Config) when is_list(Config) -> Timeout = 30, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line {ok, Cp1} = start_node(cp1, Config), @@ -1822,7 +1803,6 @@ otp_1849(Config) when is_list(Config) -> stop_node(Cp2), stop_node(Cp3), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. @@ -1840,7 +1820,7 @@ otp_3162(Config) when is_list(Config) -> do_otp_3162(StartFun, Config) -> Timeout = 30, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line [Cp1, Cp2, Cp3] = StartFun(), @@ -1898,7 +1878,6 @@ do_otp_3162(StartFun, Config) -> stop_node(Cp2), stop_node(Cp3), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. @@ -1907,7 +1886,7 @@ otp_5640(doc) -> ["OTP-5640. 'allow' multiple names for registered processes."]; otp_5640(Config) when is_list(Config) -> Timeout = 25, - ?line Dog = test_server:timetrap(test_server:seconds(Timeout)), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), init_condition(Config), ?line {ok, B} = start_node(b, Config), @@ -1965,7 +1944,6 @@ otp_5640(Config) when is_list(Config) -> write_high_level_trace(Config), stop_node(B), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. otp_5640_proc(_Parent) -> @@ -1979,7 +1957,7 @@ otp_5737(doc) -> ["OTP-5737. set_lock/3 and trans/4 accept Retries = 0."]; otp_5737(Config) when is_list(Config) -> Timeout = 25, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), @@ -2000,7 +1978,6 @@ otp_5737(Config) when is_list(Config) -> write_high_level_trace(Config), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. otp_6931(suite) -> []; @@ -2025,7 +2002,7 @@ simple_disconnect(suite) -> []; simple_disconnect(doc) -> ["OTP-5563. Disconnected nodes (not partitions)"]; simple_disconnect(Config) when is_list(Config) -> Timeout = 30, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -2075,7 +2052,6 @@ simple_disconnect(Config) when is_list(Config) -> write_high_level_trace(Config), stop_nodes(Cps), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. %% Not used right now. @@ -2118,7 +2094,7 @@ simple_resolve(suite) -> []; simple_resolve(doc) -> ["OTP-5563. Partitions and names."]; simple_resolve(Config) when is_list(Config) -> Timeout = 360, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -2245,7 +2221,6 @@ simple_resolve(Config) when is_list(Config) -> write_high_level_trace(Config), stop_nodes(Cps), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. simple_resolve2(suite) -> []; @@ -2255,7 +2230,7 @@ simple_resolve2(Config) when is_list(Config) -> %% always work to re-start z_2. "Cannot be a global bug." Timeout = 30, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -2283,7 +2258,6 @@ simple_resolve2(Config) when is_list(Config) -> write_high_level_trace(Config), stop_nodes(Cps), % Not all nodes may be present, but it works anyway. ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. simple_resolve3(suite) -> []; @@ -2292,7 +2266,7 @@ simple_resolve3(Config) when is_list(Config) -> %% Continuation of simple_resolve. Timeout = 30, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -2320,7 +2294,6 @@ simple_resolve3(Config) when is_list(Config) -> write_high_level_trace(Config), stop_nodes(Cps), % Not all nodes may be present, but it works anyway. ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. res({Res,Resolver}, [N1, A2, Z2], Cf) -> @@ -2504,7 +2477,7 @@ leftover_name(suite) -> []; leftover_name(doc) -> ["OTP-5563. Bug: nodedown while synching."]; leftover_name(Config) when is_list(Config) -> Timeout = 30, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -2565,7 +2538,6 @@ leftover_name(Config) when is_list(Config) -> write_high_level_trace(Config), stop_nodes(Cps), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. %% Runs on n_1 @@ -2604,7 +2576,7 @@ re_register_name(Config) when is_list(Config) -> %% occupied by links, that's all. %% Later: now monitors are checked. Timeout = 15, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), Me = self(), @@ -2618,7 +2590,6 @@ re_register_name(Config) when is_list(Config) -> receive {Pid2, MonitoredBy2} -> [_] = MonitoredBy2 end, ?line _ = global:unregister_name(name), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. proc(Parent) -> @@ -2652,7 +2623,7 @@ do_name_exit(StartFun, Version, Config) -> %% The current release uses monitors so this test is not so relevant. Timeout = 60, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -2692,7 +2663,6 @@ do_name_exit(StartFun, Version, Config) -> write_high_level_trace(Config), stop_nodes(Cps), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. long_lock(Parent) -> @@ -2709,7 +2679,7 @@ external_nodes(suite) -> []; external_nodes(doc) -> ["OTP-5563. External nodes (cnodes)."]; external_nodes(Config) when is_list(Config) -> Timeout = 30, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -2793,7 +2763,6 @@ external_nodes(Config) when is_list(Config) -> ?line ?UNTIL(length(get_ext_names()) =:= 0), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. get_ext_names() -> @@ -2845,8 +2814,8 @@ many_nodes(suite) -> many_nodes(doc) -> ["OTP-5770. Start many nodes. Make them connect at the same time."]; many_nodes(Config) when is_list(Config) -> - Timeout = 180, - ?line Dog = test_server:timetrap({seconds,Timeout}), + Timeout = 240, + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -2902,7 +2871,6 @@ many_nodes(Config) when is_list(Config) -> write_high_level_trace(Config), ?line stop_nodes(Cps), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), Diff = Time2 - Time, Return = lists:flatten(io_lib:format("~w nodes took ~w ms", [N_cps, Diff])), @@ -2988,7 +2956,7 @@ sync_0(doc) -> ["OTP-5770. sync/0."]; sync_0(Config) when is_list(Config) -> Timeout = 180, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), @@ -3013,7 +2981,6 @@ sync_0(Config) when is_list(Config) -> stop_nodes(Cps), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. start_and_sync([]) -> @@ -3031,7 +2998,7 @@ global_groups_change(suite) -> []; global_groups_change(doc) -> ["Test change of global_groups parameter."]; global_groups_change(Config) -> Timeout = 90, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line M = from($@, atom_to_list(node())), @@ -3376,7 +3343,6 @@ global_groups_change(Config) -> stop_node(CpE), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. sync_and_wait(Node) -> @@ -3919,7 +3885,7 @@ global_lost_nodes(doc) -> ["Tests that locally loaded nodes do not loose contact with other nodes."]; global_lost_nodes(Config) when is_list(Config) -> Timeout = 60, - Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), @@ -3943,7 +3909,6 @@ global_lost_nodes(Config) when is_list(Config) -> ?line stop_node(Node1), ?line stop_node(Node2), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. global_load(MyName, OtherNode, OtherName) -> @@ -3994,7 +3959,7 @@ mass_death(doc) -> ["Tests the simultaneous death of many processes with registered names"]; mass_death(Config) when is_list(Config) -> Timeout = 90, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line OrigNames = global:registered_names(), @@ -4023,9 +3988,9 @@ mass_death(Config) when is_list(Config) -> {H,M,S} = time(), io:format("Started probing: ~.4.0w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w~n", [YYYY,MM,DD,H,M,S]), - wait_mass_death(Dog, Nodes, OrigNames, erlang:now(), Config). + wait_mass_death(Nodes, OrigNames, erlang:now(), Config). -wait_mass_death(Dog, Nodes, OrigNames, Then, Config) -> +wait_mass_death(Nodes, OrigNames, Then, Config) -> ?line Names = global:registered_names(), ?line case Names--OrigNames of @@ -4036,12 +4001,11 @@ wait_mass_death(Dog, Nodes, OrigNames, Then, Config) -> stop_node(Node) end, Nodes), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), {comment,lists:flatten(io_lib:format("~.3f s~n", [T/1000.0]))}; Ndiff -> ?line io:format("Ndiff: ~p~n", [Ndiff]), ?line test_server:sleep(1000), - ?line wait_mass_death(Dog, Nodes, OrigNames, Then, Config) + ?line wait_mass_death(Nodes, OrigNames, Then, Config) end. mass_spawn([]) -> @@ -4213,7 +4177,7 @@ garbage_messages(suite) -> []; garbage_messages(Config) when is_list(Config) -> Timeout = 25, - ?line Dog = test_server:timetrap({seconds,Timeout}), + ct:timetrap({seconds,Timeout}), init_high_level_trace(Timeout), ?line init_condition(Config), ?line [Slave] = start_nodes([garbage_messages], slave, Config), @@ -4233,7 +4197,6 @@ garbage_messages(Config) when is_list(Config) -> write_high_level_trace(Config), ?line stop_node(Slave), ?line init_condition(Config), - ?line test_server:timetrap_cancel(Dog), ok. wait_for_ready_net(Config) -> diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl index 233e438dc9..e64d2914c4 100644 --- a/lib/kernel/test/heart_SUITE.erl +++ b/lib/kernel/test/heart_SUITE.erl @@ -22,7 +22,10 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, start/1, restart/1, - reboot/1, set_cmd/1, clear_cmd/1, get_cmd/1, + reboot/1, + node_start_immediately_after_crash/1, + node_start_soon_after_crash/1, + set_cmd/1, clear_cmd/1, get_cmd/1, dont_drop/1, kill_pid/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -38,15 +41,15 @@ init_per_testcase(_Func, Config) -> end_per_testcase(_Func, Config) -> Nodes = nodes(), lists:foreach(fun(X) -> - NNam = list_to_atom(hd(string:tokens(atom_to_list(X),"@"))), - case NNam of - heart_test -> - ?t:format(1, "WARNING: Killed ~p~n", [X]), - rpc:cast(X, erlang, halt, []); - _ -> - ok - end - end, Nodes), + NNam = list_to_atom(hd(string:tokens(atom_to_list(X),"@"))), + case NNam of + heart_test -> + ?t:format(1, "WARNING: Killed ~p~n", [X]), + rpc:cast(X, erlang, halt, []); + _ -> + ok + end + end, Nodes), Dog=?config(watchdog, Config), test_server:timetrap_cancel(Dog). @@ -57,8 +60,13 @@ end_per_testcase(_Func, Config) -> %%----------------------------------------------------------------- suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> - [start, restart, reboot, set_cmd, clear_cmd, get_cmd, kill_pid]. +all() -> [ + start, restart, reboot, + node_start_immediately_after_crash, + node_start_soon_after_crash, + set_cmd, clear_cmd, get_cmd, + kill_pid + ]. groups() -> []. @@ -80,17 +88,22 @@ init_per_suite(Config) when is_list(Config) -> end_per_suite(Config) when is_list(Config) -> Config. + start_check(Type, Name) -> + start_check(Type, Name, []). +start_check(Type, Name, Envs) -> Args = case ?t:os_type() of - {win32,_} -> "-heart -env HEART_COMMAND no_reboot"; - _ -> "-heart" - end, + {win32,_} -> + "-heart " ++ env_encode([{"HEART_COMMAND", no_reboot}|Envs]); + _ -> + "-heart " ++ env_encode(Envs) + end, {ok, Node} = case Type of - loose -> - loose_node:start(Name, Args, ?DEFAULT_TIMEOUT_SECS); - _ -> - ?t:start_node(Name, Type, [{args, Args}]) - end, + loose -> + loose_node:start(Name, Args, ?DEFAULT_TIMEOUT_SECS); + _ -> + ?t:start_node(Name, Type, [{args, Args}]) + end, erlang:monitor_node(Node, true), case rpc:call(Node, erlang, whereis, [heart]) of Pid when is_pid(Pid) -> @@ -103,21 +116,19 @@ start_check(Type, Name) -> start(doc) -> []; start(suite) -> {req, [{time, 10}]}; start(Config) when is_list(Config) -> - ?line {ok, Node} = start_check(slave, heart_test), - ?line rpc:call(Node, init, reboot, []), + {ok, Node} = start_check(slave, heart_test), + rpc:call(Node, init, reboot, []), receive - {nodedown, Node} -> - ok - after 2000 -> - test_server:fail(node_not_closed) + {nodedown, Node} -> ok + after 2000 -> test_server:fail(node_not_closed) end, test_server:sleep(5000), - ?line case net_adm:ping(Node) of - pang -> - ok; - _ -> - test_server:fail(node_rebooted) - end, + case net_adm:ping(Node) of + pang -> + ok; + _ -> + test_server:fail(node_rebooted) + end, test_server:stop_node(Node). %% Also test fixed bug in R1B (it was not possible to @@ -125,6 +136,10 @@ start(Config) when is_list(Config) -> %% Slave executes erlang:halt() on master nodedown. %% Therefore the slave process has to be killed %% before restart. + +%% restart +%% Purpose: +%% Check that a node is up and running after a init:restart/0 restart(doc) -> []; restart(suite) -> case ?t:os_type() of @@ -134,8 +149,8 @@ restart(suite) -> {skip, "Only run on unix and win32"} end; restart(Config) when is_list(Config) -> - ?line {ok, Node} = start_check(loose, heart_test), - ?line rpc:call(Node, init, restart, []), + {ok, Node} = start_check(loose, heart_test), + rpc:call(Node, init, restart, []), receive {nodedown, Node} -> ok @@ -143,32 +158,21 @@ restart(Config) when is_list(Config) -> test_server:fail(node_not_closed) end, test_server:sleep(5000), - - ?line case net_adm:ping(Node) of - pong -> - erlang:monitor_node(Node, true), - ?line rpc:call(Node, init, stop, []), - receive - {nodedown, Node} -> - ok - after 2000 -> - test_server:fail(node_not_closed2) - end, - ok; - _ -> - test_server:fail(node_not_restarted) - end, + node_check_up_down(Node, 2000), loose_node:stop(Node). +%% reboot +%% Purpose: +%% Check that a node is up and running after a init:reboot/0 reboot(doc) -> []; reboot(suite) -> {req, [{time, 10}]}; reboot(Config) when is_list(Config) -> {ok, Node} = start_check(slave, heart_test), - ?line ok = rpc:call(Node, heart, set_cmd, + ok = rpc:call(Node, heart, set_cmd, [atom_to_list(lib:progname()) ++ " -noshell -heart " ++ name(Node) ++ "&"]), - ?line rpc:call(Node, init, reboot, []), + rpc:call(Node, init, reboot, []), receive {nodedown, Node} -> ok @@ -176,44 +180,119 @@ reboot(Config) when is_list(Config) -> test_server:fail(node_not_closed) end, test_server:sleep(5000), - ?line case net_adm:ping(Node) of - pong -> - erlang:monitor_node(Node, true), - ?line rpc:call(Node, init, reboot, []), - receive - {nodedown, Node} -> - ok - after 2000 -> - test_server:fail(node_not_closed2) - end, - ok; - _ -> - test_server:fail(node_not_rebooted) - end, + node_check_up_down(Node, 2000), ok. +%% node_start_immediately_after_crash +%% Purpose: +%% Check that a node is up and running after a crash. +%% This test exhausts the atom table on the remote node. +%% ERL_CRASH_DUMP_SECONDS=0 will force beam not to dump an erl_crash.dump. +node_start_immediately_after_crash(suite) -> {req, [{time, 10}]}; +node_start_immediately_after_crash(Config) when is_list(Config) -> + {ok, Node} = start_check(loose, heart_test_imm, [{"ERL_CRASH_DUMP_SECONDS", "0"}]), + + ok = rpc:call(Node, heart, set_cmd, + [atom_to_list(lib:progname()) ++ + " -noshell -heart " ++ name(Node) ++ "&"]), + + Mod = exhaust_atoms, + + Code = generate(Mod, [], [ + "do() -> " + " Set = lists:seq($a,$z), " + " [ list_to_atom([A,B,C,D,E]) || " + " A <- Set, B <- Set, C <- Set, E <- Set, D <- Set ]." + ]), + + %% crash it with atom exhaustion + rpc:call(Node, erlang, load_module, [Mod, Code]), + rpc:cast(Node, Mod, do, []), + + T0 = now(), + + receive {nodedown, Node} -> + test_server:format("Took ~.2f s. for node to go down~n", [timer:now_diff(now(), T0)/1000000]), + ok + %% timeout is very liberal here. nodedown is received in about 1 s. on linux (palantir) + %% and in about 10 s. on solaris (carcharoth) + after (15000*test_server:timetrap_scale_factor()) -> test_server:fail(node_not_closed) + end, + test_server:sleep(3000), + node_check_up_down(Node, 2000), + loose_node:stop(Node). + +%% node_start_soon_after_crash +%% Purpose: +%% Check that a node is up and running after a crash. +%% This test exhausts the atom table on the remote node. +%% ERL_CRASH_DUMP_SECONDS=10 will force beam +%% to only dump an erl_crash.dump for 10 seconds. +node_start_soon_after_crash(suite) -> {req, [{time, 10}]}; +node_start_soon_after_crash(Config) when is_list(Config) -> + {ok, Node} = start_check(loose, heart_test_soon, [{"ERL_CRASH_DUMP_SECONDS", "10"}]), + + ok = rpc:call(Node, heart, set_cmd, + [atom_to_list(lib:progname()) ++ + " -noshell -heart " ++ name(Node) ++ "&"]), + + Mod = exhaust_atoms, + + Code = generate(Mod, [], [ + "do() -> " + " Set = lists:seq($a,$z), " + " [ list_to_atom([A,B,C,D,E]) || " + " A <- Set, B <- Set, C <- Set, E <- Set, D <- Set ]." + ]), + + %% crash it with atom exhaustion + rpc:call(Node, erlang, load_module, [Mod, Code]), + rpc:cast(Node, Mod, do, []), + + receive {nodedown, Node} -> ok + after (15000*test_server:timetrap_scale_factor()) -> test_server:fail(node_not_closed) + end, + test_server:sleep(20000), + node_check_up_down(Node, 15000), + loose_node:stop(Node). + + +node_check_up_down(Node, Tmo) -> + case net_adm:ping(Node) of + pong -> + erlang:monitor_node(Node, true), + rpc:call(Node, init, reboot, []), + receive + {nodedown, Node} -> ok + after Tmo -> + test_server:fail(node_not_closed2) + end; + _ -> + test_server:fail(node_not_rebooted) + end. + %% Only tests bad command, correct behaviour is tested in reboot/1. set_cmd(suite) -> []; set_cmd(Config) when is_list(Config) -> - ?line {ok, Node} = start_check(slave, heart_test), + {ok, Node} = start_check(slave, heart_test), Cmd = wrong_atom, - ?line {error, {bad_cmd, Cmd}} = rpc:call(Node, heart, set_cmd, [Cmd]), + {error, {bad_cmd, Cmd}} = rpc:call(Node, heart, set_cmd, [Cmd]), Cmd1 = lists:duplicate(2047, $a), - ?line {error, {bad_cmd, Cmd1}} = rpc:call(Node, heart, set_cmd, [Cmd1]), + {error, {bad_cmd, Cmd1}} = rpc:call(Node, heart, set_cmd, [Cmd1]), Cmd2 = lists:duplicate(28, $a), - ?line ok = rpc:call(Node, heart, set_cmd, [Cmd2]), + ok = rpc:call(Node, heart, set_cmd, [Cmd2]), Cmd3 = lists:duplicate(2000, $a), - ?line ok = rpc:call(Node, heart, set_cmd, [Cmd3]), + ok = rpc:call(Node, heart, set_cmd, [Cmd3]), stop_node(Node), ok. clear_cmd(suite) -> {req,[{time,15}]}; clear_cmd(Config) when is_list(Config) -> - ?line {ok, Node} = start_check(slave, heart_test), - ?line ok = rpc:call(Node, heart, set_cmd, + {ok, Node} = start_check(slave, heart_test), + ok = rpc:call(Node, heart, set_cmd, [atom_to_list(lib:progname()) ++ " -noshell -heart " ++ name(Node) ++ "&"]), - ?line rpc:call(Node, init, reboot, []), + rpc:call(Node, init, reboot, []), receive {nodedown, Node} -> ok @@ -221,16 +300,16 @@ clear_cmd(Config) when is_list(Config) -> test_server:fail(node_not_closed) end, test_server:sleep(5000), - ?line case net_adm:ping(Node) of - pong -> - erlang:monitor_node(Node, true); - _ -> - test_server:fail(node_not_rebooted) - end, - ?line ok = rpc:call(Node, heart, set_cmd, + case net_adm:ping(Node) of + pong -> + erlang:monitor_node(Node, true); + _ -> + test_server:fail(node_not_rebooted) + end, + ok = rpc:call(Node, heart, set_cmd, ["erl -noshell -heart " ++ name(Node) ++ "&"]), - ?line ok = rpc:call(Node, heart, clear_cmd, []), - ?line rpc:call(Node, init, reboot, []), + ok = rpc:call(Node, heart, clear_cmd, []), + rpc:call(Node, init, reboot, []), receive {nodedown, Node} -> ok @@ -238,20 +317,20 @@ clear_cmd(Config) when is_list(Config) -> test_server:fail(node_not_closed) end, test_server:sleep(5000), - ?line case net_adm:ping(Node) of - pang -> - ok; - _ -> - test_server:fail(node_rebooted) - end, + case net_adm:ping(Node) of + pang -> + ok; + _ -> + test_server:fail(node_rebooted) + end, ok. get_cmd(suite) -> []; get_cmd(Config) when is_list(Config) -> - ?line {ok, Node} = start_check(slave, heart_test), + {ok, Node} = start_check(slave, heart_test), Cmd = "test", - ?line ok = rpc:call(Node, heart, set_cmd, [Cmd]), - ?line {ok, Cmd} = rpc:call(Node, heart, get_cmd, []), + ok = rpc:call(Node, heart, set_cmd, [Cmd]), + {ok, Cmd} = rpc:call(Node, heart, get_cmd, []), stop_node(Node), ok. @@ -274,57 +353,53 @@ dont_drop(Config) when is_list(Config) -> ok end. -do_dont_drop(_,0) -> - []; +do_dont_drop(_,0) -> []; do_dont_drop(Config,N) -> %% Name of first slave node - ?line NN1 = atom_to_list(?MODULE) ++ "slave_1", + NN1 = atom_to_list(?MODULE) ++ "slave_1", %% Name of node started by heart on failure - ?line NN2 = atom_to_list(?MODULE) ++ "slave_2", + NN2 = atom_to_list(?MODULE) ++ "slave_2", %% Name of node started by heart on success - ?line NN3 = atom_to_list(?MODULE) ++ "slave_3", - ?line Host = hd(tl(string:tokens(atom_to_list(node()),"@"))), + NN3 = atom_to_list(?MODULE) ++ "slave_3", + Host = hd(tl(string:tokens(atom_to_list(node()),"@"))), %% The initial heart command - ?line FirstCmd = erl() ++ name(NN2 ++ "@" ++ Host), + FirstCmd = erl() ++ name(NN2 ++ "@" ++ Host), %% Separated the parameters to start_node_run for clarity... - ?line Name = list_to_atom(NN1), - ?line Env = [{"HEART_COMMAND", FirstCmd}], - ?line Func = "start_heart_stress", - ?line Arg = NN3 ++ "@" ++ Host ++ " " ++ + Name = list_to_atom(NN1), + Env = [{"HEART_COMMAND", FirstCmd}], + Func = "start_heart_stress", + Arg = NN3 ++ "@" ++ Host ++ " " ++ filename:join(?config(data_dir, Config), "simple_echo"), - ?line start_node_run(Name,Env,Func,Arg), - ?line case wait_for_any_of(list_to_atom(NN2 ++ "@" ++ Host), - list_to_atom(NN3 ++ "@" ++ Host)) of - 2 -> - ?line [ok | do_dont_drop(Config,N-1)]; - _ -> - ?line false - end. + start_node_run(Name,Env,Func,Arg), + case wait_for_any_of(list_to_atom(NN2 ++ "@" ++ Host), + list_to_atom(NN3 ++ "@" ++ Host)) of + 2 -> + [ok | do_dont_drop(Config,N-1)]; + _ -> + false + end. wait_for_any_of(N1,N2) -> - ?line wait_for_any_of(N1,N2,45). + wait_for_any_of(N1,N2,45). wait_for_any_of(_N1,_N2,0) -> - ?line false; + false; wait_for_any_of(N1,N2,Times) -> - ?line receive - after 1000 -> - ?line ok - end, - ?line case net_adm:ping(N1) of - pang -> - ?line case net_adm:ping(N2) of - pang -> - ?line wait_for_any_of(N1,N2,Times - 1); - pong -> - ?line rpc:call(N2,init,stop,[]), - ?line 2 - end; - pong -> - ?line rpc:call(N1,init,stop,[]), - ?line 1 - end. + receive after 1000 -> ok end, + case net_adm:ping(N1) of + pang -> + case net_adm:ping(N2) of + pang -> + wait_for_any_of(N1,N2,Times - 1); + pong -> + rpc:call(N2,init,stop,[]), + 2 + end; + pong -> + rpc:call(N1,init,stop,[]), + 1 + end. kill_pid(suite) -> @@ -347,9 +422,7 @@ do_kill_pid(_Config) -> {ok,Node} = start_node_run(Name,Env,suicide_by_heart,[]), ok = wait_for_node(Node,15), erlang:monitor_node(Node, true), - receive - {nodedown,Node} -> - ok + receive {nodedown,Node} -> ok after 30000 -> false end. @@ -357,23 +430,16 @@ do_kill_pid(_Config) -> wait_for_node(_,0) -> false; wait_for_node(Node,N) -> - receive - after 1000 -> - ok - end, + receive after 1000 -> ok end, case net_adm:ping(Node) of - pong -> - ok; - pang -> - wait_for_node(Node,N-1) + pong -> ok; + pang -> wait_for_node(Node,N-1) end. erl() -> case os:type() of - {win32,_} -> - "werl "; - _ -> - "erl " + {win32,_} -> "werl "; + _ -> "erl " end. name(Node) when is_list(Node) -> name(Node,[]); @@ -390,15 +456,13 @@ name([H|T], Name) -> name(T, [H|Name]). -atom_conv(A) when is_atom(A) -> - atom_to_list(A); -atom_conv(A) when is_list(A) -> - A. +enc(A) when is_atom(A) -> atom_to_list(A); +enc(A) when is_binary(A) -> binary_to_list(A); +enc(A) when is_list(A) -> A. -env_conv([]) -> - []; -env_conv([{X,Y}|T]) -> - atom_conv(X) ++ " \"" ++ atom_conv(Y) ++ "\" " ++ env_conv(T). +env_encode([]) -> []; +env_encode([{X,Y}|T]) -> + "-env " ++ enc(X) ++ " \"" ++ enc(Y) ++ "\" " ++ env_encode(T). %%% %%% Starts a node and runs a function in this @@ -409,12 +473,12 @@ env_conv([{X,Y}|T]) -> %%% Argument is the argument(s) to send through erl -s %%% start_node_run(Name, Env, Function, Argument) -> - ?line PA = filename:dirname(code:which(?MODULE)), - ?line Params = "-heart -env " ++ env_conv(Env) ++ " -pa " ++ PA ++ - " -s " ++ - atom_conv(?MODULE) ++ " " ++ atom_conv(Function) ++ " " ++ - atom_conv(Argument), - ?line start_node(Name, Params). + PA = filename:dirname(code:which(?MODULE)), + Params = "-heart " ++ env_encode(Env) ++ " -pa " ++ PA ++ + " -s " ++ + enc(?MODULE) ++ " " ++ enc(Function) ++ " " ++ + enc(Argument), + start_node(Name, Params). start_node(Name, Param) -> test_server:start_node(Name, slave, [{args, Param}]). @@ -480,3 +544,24 @@ suicide_by_heart() -> {makaronipudding} -> sallad end. + + +%% generate a module from binary +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] ++ + [ Function || {_, Function} <- FunForms], + {ok, Module, Bin} = compile:forms(Forms), + Bin. + + +function_forms([]) -> []; +function_forms([S|Ss]) -> + {ok, Ts,_} = erl_scan:string(S), + {ok, Form} = erl_parse:parse_form(Ts), + Fun = element(3, Form), + Arity = element(4, Form), + [{{Fun,Arity}, Form}|function_forms(Ss)]. diff --git a/lib/kernel/test/interactive_shell_SUITE.erl b/lib/kernel/test/interactive_shell_SUITE.erl index 4787f19250..7549e2c83e 100644 --- a/lib/kernel/test/interactive_shell_SUITE.erl +++ b/lib/kernel/test/interactive_shell_SUITE.erl @@ -30,19 +30,10 @@ init_per_testcase(_Func, Config) -> Dog = test_server:timetrap(test_server:seconds(60)), - Term = case os:getenv("TERM") of - List when is_list(List) -> - List; - _ -> - "dumb" - end, - os:putenv("TERM","vt100"), - [{watchdog,Dog},{term,Term}|Config]. + [{watchdog,Dog}|Config]. end_per_testcase(_Func, Config) -> Dog = ?config(watchdog, Config), - Term = ?config(term,Config), - os:putenv("TERM",Term), test_server:timetrap_cancel(Dog). @@ -56,9 +47,19 @@ groups() -> []. init_per_suite(Config) -> - Config. + Term = case os:getenv("TERM") of + List when is_list(List) -> + List; + _ -> + "dumb" + end, + os:putenv("TERM","vt100"), + DefShell = get_default_shell(), + [{default_shell,DefShell},{term,Term}|Config]. -end_per_suite(_Config) -> +end_per_suite(Config) -> + Term = ?config(term,Config), + os:putenv("TERM",Term), ok. init_per_group(_GroupName, Config) -> @@ -78,70 +79,118 @@ end_per_group(_GroupName, Config) -> get_columns_and_rows(suite) -> []; get_columns_and_rows(doc) -> ["Test that the shell can access columns and rows"]; get_columns_and_rows(Config) when is_list(Config) -> - ?line rtnode([{putline,""}, - {putline, "2."}, - {getline, "2"}, - {putline,"io:columns()."}, -%% Behaviour change in R12B-5, returns 80 -%% {getline,"{error,enotsup}"}, - {getline,"{ok,80}"}, - {putline,"io:rows()."}, -%% Behaviour change in R12B-5, returns 24 -%% {getline,"{error,enotsup}"} - {getline,"{ok,24}"} - ],[]), - ?line rtnode([{putline,""}, - {putline, "2."}, - {getline, "2"}, - {putline,"io:columns()."}, - {getline,"{ok,90}"}, - {putline,"io:rows()."}, - {getline,"{ok,40}"}], - [], - "stty rows 40; stty columns 90; "). + case proplists:get_value(default_shell,Config) of + old -> + %% Old shell tests + ?dbg(old_shell), + ?line rtnode([{putline,""}, + {putline, "2."}, + {getline, "2"}, + {putline,"io:columns()."}, + {getline_re,".*{error,enotsup}"}, + {putline,"io:rows()."}, + {getline_re,".*{error,enotsup}"} + + ],[]), + ?line rtnode([{putline,""}, + {putline, "2."}, + {getline, "2"}, + {putline,"io:columns()."}, + {getline_re,".*{ok,90}"}, + {putline,"io:rows()."}, + {getline_re,".*{ok,40}"}], + [], + "stty rows 40; stty columns 90; "); + new -> + % New shell tests + ?dbg(new_shell), + ?line rtnode([{putline,""}, + {putline, "2."}, + {getline, "2"}, + {putline,"io:columns()."}, + %% Behaviour change in R12B-5, returns 80 + %% {getline,"{error,enotsup}"}, + {getline,"{ok,80}"}, + {putline,"io:rows()."}, + %% Behaviour change in R12B-5, returns 24 + %% {getline,"{error,enotsup}"} + {getline,"{ok,24}"} + ],[]), + ?line rtnode([{putline,""}, + {putline, "2."}, + {getline, "2"}, + {putline,"io:columns()."}, + {getline,"{ok,90}"}, + {putline,"io:rows()."}, + {getline,"{ok,40}"}], + [], + "stty rows 40; stty columns 90; ") + end. exit_initial(suite) -> []; exit_initial(doc) -> ["Tests that exit of initial shell restarts shell"]; exit_initial(Config) when is_list(Config) -> - ?line rtnode([{putline,""}, - {putline, "2."}, - {getline, "2"}, - {putline,"exit()."}, - {getline,""}, - {getline,"Eshell"}, - {putline,""}, - {putline,"35."}, - {getline,"35"}],[]). + case proplists:get_value(default_shell,Config) of + old -> + rtnode([{putline,""}, + {putline, "2."}, + {getline_re, ".*2"}, + {putline,"exit()."}, + {getline,""}, + {getline,"Eshell"}, + {putline,""}, + {putline,"35."}, + {getline_re,".*35"}],[]); + new -> + rtnode([{putline,""}, + {putline, "2."}, + {getline, "2"}, + {putline,"exit()."}, + {getline,""}, + {getline,"Eshell"}, + {putline,""}, + {putline,"35."}, + {getline_re,"35"}],[]) + end. job_control_local(suite) -> []; job_control_local(doc) -> [ "Tests that local shell can be " "started by means of job control" ]; job_control_local(Config) when is_list(Config) -> - ?line rtnode([{putline,""}, - {putline, "2."}, - {getline, "2"}, - {putline,[7]}, - {sleep,timeout(short)}, - {putline,""}, - {getline," -->"}, - {putline,"s"}, - {putline,"c"}, - {putline_raw,""}, - {getline,"Eshell"}, - {putline_raw,""}, - {getline,"1>"}, - {putline,"35."}, - {getline,"35"}],[]). + case proplists:get_value(default_shell,Config) of + old -> + %% Old shell tests + {skip,"No new shell found"}; + new -> + %% New shell tests + ?line rtnode([{putline,""}, + {putline, "2."}, + {getline, "2"}, + {putline,[7]}, + {sleep,timeout(short)}, + {putline,""}, + {getline," -->"}, + {putline,"s"}, + {putline,"c"}, + {putline_raw,""}, + {getline,"Eshell"}, + {putline_raw,""}, + {getline,"1>"}, + {putline,"35."}, + {getline,"35"}],[]) + end. job_control_remote(suite) -> []; job_control_remote(doc) -> [ "Tests that remote shell can be " "started by means of job control" ]; job_control_remote(Config) when is_list(Config) -> - case node() of - nonode@nohost -> + case {node(),proplists:get_value(default_shell,Config)} of + {nonode@nohost,_} -> ?line exit(not_distributed); + {_,old} -> + {skip,"No new shell found"}; _ -> ?line RNode = create_nodename(), ?line MyNode = atom_to_list(node()), @@ -190,9 +239,11 @@ job_control_remote_noshell(doc) -> [ "Tests that remote shell can be " "started by means of job control to -noshell node" ]; job_control_remote_noshell(Config) when is_list(Config) -> - case node() of - nonode@nohost -> + case {node(),proplists:get_value(default_shell,Config)} of + {nonode@nohost,_} -> ?line exit(not_distributed); + {_,old} -> + {skip,"No new shell found"}; _ -> ?line RNode = create_nodename(), ?line NSNode = start_noshell_node(interactive_shell_noshell), @@ -351,6 +402,33 @@ get_and_put(CPid, [{getline, Match}|T],N) -> end end; +%% Hey ho copy paste from stdlib/io_proto_SUITE +get_and_put(CPid, [{getline_re, Match}|T],N) -> + ?dbg({getline_re, Match}), + CPid ! {self(), {get_line, timeout(normal)}}, + receive + {get_line, timeout} -> + error_logger:error_msg("~p: getline_re timeout waiting for \"~s\" " + "(command number ~p, skipped: ~p)~n", + [?MODULE, Match,N,get(getline_skipped)]), + {error, timeout}; + {get_line, Data} -> + ?dbg({data,Data}), + case re:run(Data, Match,[{capture,none}]) of + match -> + erase(getline_skipped), + get_and_put(CPid, T,N+1); + _ -> + case get(getline_skipped) of + undefined -> + put(getline_skipped,[Data]); + List -> + put(getline_skipped,List ++ [Data]) + end, + get_and_put(CPid, [{getline_re, Match}|T],N) + end + end; + get_and_put(CPid, [{putline_raw, Line}|T],N) -> ?dbg({putline_raw, Line}), CPid ! {self(), {send_line, Line}}, @@ -631,6 +709,13 @@ get_data_within(Port, Timeout, Acc) -> timeout end. - - - +get_default_shell() -> + try + rtnode([{putline,""}, + {putline, "whereis(user_drv)."}, + {getline, "undefined"}],[]), + old + catch E:R -> + ?dbg({E,R}), + new + end. diff --git a/lib/kernel/test/wrap_log_reader_SUITE.erl b/lib/kernel/test/wrap_log_reader_SUITE.erl index 96dc3e6d33..6c47fda9c5 100644 --- a/lib/kernel/test/wrap_log_reader_SUITE.erl +++ b/lib/kernel/test/wrap_log_reader_SUITE.erl @@ -557,7 +557,7 @@ rec(M, Where) -> M -> ok; Else -> ?t:fail({error, {Where, Else}}) - after 1000 -> ?t:fail({error, {Where, time_out}}) + after 5000 -> ?t:fail({error, {Where, time_out}}) end. pps() -> diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk index c494f8a864..7254d714eb 100644 --- a/lib/kernel/vsn.mk +++ b/lib/kernel/vsn.mk @@ -1 +1 @@ -KERNEL_VSN = 2.15.2 +KERNEL_VSN = 2.15.3 diff --git a/lib/percept/src/percept.app.src b/lib/percept/src/percept.app.src index c70fede721..7b20093ece 100644 --- a/lib/percept/src/percept.app.src +++ b/lib/percept/src/percept.app.src @@ -17,14 +17,26 @@ %% %CopyrightEnd% %% -{application,percept, - [{description, "PERCEPT Erlang Concurrency Profiling Tool"}, - {vsn, "%VSN%"}, - {modules, [percept,percept_db,percept_html,percept_graph,percept_analyzer]}, - {registered, [percept_db,percept_port]}, - {applications, [kernel,stdlib]}, - {env, []} - ]}. - +{application,percept, [ + {description, "PERCEPT Erlang Concurrency Profiling Tool"}, + {vsn, "%VSN%"}, + {modules, [ + egd, + egd_font, + egd_png, + egd_primitives, + egd_render, + percept, + percept_analyzer, + percept_db, + percept_graph, + percept_html, + percept_image + ]}, + {registered, [percept_db,percept_port]}, + {applications, [kernel,stdlib]}, + {env,[]} +]}. +%% vim: syntax=erlang diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl index 661d57c85b..17e69f7c1c 100644 --- a/lib/stdlib/test/io_proto_SUITE.erl +++ b/lib/stdlib/test/io_proto_SUITE.erl @@ -96,7 +96,8 @@ groups() -> []. init_per_suite(Config) -> - Config. + DefShell = get_default_shell(), + [{default_shell,DefShell}|Config]. end_per_suite(_Config) -> ok. @@ -124,20 +125,25 @@ unicode_prompt(doc) -> ["Test that an Unicode prompt does not crash the shell"]; unicode_prompt(Config) when is_list(Config) -> ?line PA = filename:dirname(code:which(?MODULE)), - ?line rtnode([{putline,""}, - {putline, "2."}, - {getline, "2"}, - {putline, "shell:prompt_func({io_proto_SUITE,uprompt})."}, - {getline, "default"}, - {putline, "io:get_line('')."}, - {putline, "hej"}, - {getline, "\"hej\\n\""}, - {putline, "io:setopts([{binary,true}])."}, - {getline, "ok"}, - {putline, "io:get_line('')."}, - {putline, "hej"}, - {getline, "<<\"hej\\n\">>"} - ],[],[],"-pa \""++ PA++"\""), + case proplists:get_value(default_shell,Config) of + old -> + ok; + new -> + ?line rtnode([{putline,""}, + {putline, "2."}, + {getline, "2"}, + {putline, "shell:prompt_func({io_proto_SUITE,uprompt})."}, + {getline, "default"}, + {putline, "io:get_line('')."}, + {putline, "hej"}, + {getline, "\"hej\\n\""}, + {putline, "io:setopts([{binary,true}])."}, + {getline, "ok"}, + {putline, "io:get_line('')."}, + {putline, "hej"}, + {getline, "<<\"hej\\n\">>"} + ],[],[],"-pa \""++ PA++"\"") + end, %% And one with oldshell ?line rtnode([{putline,""}, {putline, "2."}, @@ -234,21 +240,26 @@ setopts_getopts(Config) when is_list(Config) -> lists:sort(io:getopts(RFile)), ?line eof = io:get_line(RFile,''), ?line file:close(RFile), - %% So, lets test another node with new interactive shell - ?line rtnode([{putline,""}, - {putline, "2."}, - {getline, "2"}, - {putline, "lists:keyfind(binary,1,io:getopts())."}, - {getline, "{binary,false}"}, - {putline, "io:get_line('')."}, - {putline, "hej"}, - {getline, "\"hej\\n\""}, - {putline, "io:setopts([{binary,true}])."}, - {getline, "ok"}, - {putline, "io:get_line('')."}, - {putline, "hej"}, - {getline, "<<\"hej\\n\">>"} - ],[]), + case proplists:get_value(default_shell,Config) of + old -> + ok; + new -> + %% So, lets test another node with new interactive shell + ?line rtnode([{putline,""}, + {putline, "2."}, + {getline, "2"}, + {putline, "lists:keyfind(binary,1,io:getopts())."}, + {getline, "{binary,false}"}, + {putline, "io:get_line('')."}, + {putline, "hej"}, + {getline, "\"hej\\n\""}, + {putline, "io:setopts([{binary,true}])."}, + {getline, "ok"}, + {putline, "io:get_line('')."}, + {putline, "hej"}, + {getline, "<<\"hej\\n\">>"} + ],[]) + end, %% And one with oldshell ?line rtnode([{putline,""}, {putline, "2."}, @@ -433,21 +444,27 @@ unicode_options(Config) when is_list(Config) -> end, ?line [ ok = CannotWriteFile(F,FailDir) || F <- AllNoBom ], - %% OK, time for the group_leaders... - ?line rtnode([{putline,""}, - {putline, "2."}, - {getline, "2"}, - {putline, "lists:keyfind(encoding,1,io:getopts())."}, - {getline, "{encoding,latin1}"}, - {putline, "io:format(\"~ts~n\",[[1024]])."}, - {getline, "\\x{400}"}, - {putline, "io:setopts([unicode])."}, - {getline, "ok"}, - {putline, "io:format(\"~ts~n\",[[1024]])."}, - {getline, - binary_to_list(unicode:characters_to_binary( - [1024],unicode,utf8))} - ],[],"LC_CTYPE=\""++get_lc_ctype()++"\"; export LC_CTYPE; "), + case proplists:get_value(default_shell,Config) of + old -> + ok; + new -> + %% OK, time for the group_leaders... + ?line rtnode([{putline,""}, + {putline, "2."}, + {getline, "2"}, + {putline, "lists:keyfind(encoding,1,io:getopts())."}, + {getline, "{encoding,latin1}"}, + {putline, "io:format(\"~ts~n\",[[1024]])."}, + {getline, "\\x{400}"}, + {putline, "io:setopts([unicode])."}, + {getline, "ok"}, + {putline, "io:format(\"~ts~n\",[[1024]])."}, + {getline, + binary_to_list(unicode:characters_to_binary( + [1024],unicode,utf8))} + ],[],"LC_CTYPE=\""++get_lc_ctype()++"\"; " + "export LC_CTYPE; ") + end, ?line rtnode([{putline,""}, {putline, "2."}, {getline_re, ".*2."}, @@ -680,23 +697,28 @@ binary_options(Config) when is_list(Config) -> ?line file:close(F3), %% OK, time for the group_leaders... %% io:format(standard_error,"Hmmm:~w~n",["<<\""++binary_to_list(<<"\345\344\366"/utf8>>)++"\\n\">>"]), - ?line rtnode([{putline,""}, - {putline, "2."}, - {getline, "2"}, - {putline, "lists:keyfind(binary,1,io:getopts())."}, - {getline, "{binary,false}"}, - {putline, "io:get_line('')."}, - {putline, "hej"}, - {getline, "\"hej\\n\""}, - {putline, "io:setopts([{binary,true},unicode])."}, - {getline, "ok"}, - {putline, "io:get_line('')."}, - {putline, "hej"}, - {getline, "<<\"hej\\n\">>"}, - {putline, "io:get_line('')."}, - {putline, binary_to_list(<<"\345\344\366"/utf8>>)}, - {getline, "<<\""++binary_to_list(unicode:characters_to_binary(<<"\345\344\366"/utf8>>,latin1,utf8))++"\\n\">>"} - ],[]), + case proplists:get_value(default_shell,Config) of + old -> + ok; + new -> + ?line rtnode([{putline,""}, + {putline, "2."}, + {getline, "2"}, + {putline, "lists:keyfind(binary,1,io:getopts())."}, + {getline, "{binary,false}"}, + {putline, "io:get_line('')."}, + {putline, "hej"}, + {getline, "\"hej\\n\""}, + {putline, "io:setopts([{binary,true},unicode])."}, + {getline, "ok"}, + {putline, "io:get_line('')."}, + {putline, "hej"}, + {getline, "<<\"hej\\n\">>"}, + {putline, "io:get_line('')."}, + {putline, binary_to_list(<<"\345\344\366"/utf8>>)}, + {getline, "<<\""++binary_to_list(unicode:characters_to_binary(<<"\345\344\366"/utf8>>,latin1,utf8))++"\\n\">>"} + ],[]) + end, %% And one with oldshell ?line rtnode([{putline,""}, {putline, "2."}, @@ -1146,9 +1168,11 @@ read_modes_gl(suite) -> read_modes_gl(doc) -> ["Test various modes when reading from the group leade from another machine"]; read_modes_gl(Config) when is_list(Config) -> - case get_progs() of - {error,Reason} -> + case {get_progs(),proplists:get_value(default_shell,Config)} of + {{error,Reason},_} -> {skipped,Reason}; + {_,old} -> + {skipper,"No new shell"}; _ -> read_modes_gl_1(Config,answering_machine1) end. @@ -1754,6 +1778,17 @@ get_data_within(Port, Timeout, Acc) -> timeout end. +get_default_shell() -> + try + rtnode([{putline,""}, + {putline, "whereis(user_drv)."}, + {getline, "undefined"}],[]), + old + catch E:R -> + ?dbg({E,R}), + new + end. + %% %% Test I/O-server %% diff --git a/lib/stdlib/vsn.mk b/lib/stdlib/vsn.mk index 3df7495ec4..6524d83689 100644 --- a/lib/stdlib/vsn.mk +++ b/lib/stdlib/vsn.mk @@ -1 +1 @@ -STDLIB_VSN = 1.18.2 +STDLIB_VSN = 1.18.3 diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index 4899f38d2b..42b286ef64 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/test_server/src/ts.erl @@ -291,12 +291,19 @@ run(Testspec, Config) when is_atom(Testspec), is_list(Config) -> Options=check_test_get_opts(Testspec, Config), File=atom_to_list(Testspec), Spec = case code:lib_dir(Testspec) of - {error, bad_name} when Testspec /= emulator, - Testspec /= system, - Testspec /= epmd -> + _ when Testspec == emulator; + Testspec == system; + Testspec == epmd -> + File++".spec"; + {error, bad_name} -> create_skip_spec(Testspec, tests(Testspec)); - _ -> - File++".spec" + Path -> + case file:read_file_info(filename:join(Path,"ebin")) of + {ok,_} -> + File++".spec"; + _ -> + create_skip_spec(Testspec, tests(Testspec)) + end end, run_test(File, [{spec,[Spec]}], Options); %% Runs one module in a spec (interactive) diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src index cd9b622f15..94998fb763 100644 --- a/lib/tools/src/tools.app.src +++ b/lib/tools/src/tools.app.src @@ -24,6 +24,7 @@ eprof, fprof, instrument, + lcnt, make, xref, xref_base, |