diff options
Diffstat (limited to 'lib')
34 files changed, 880 insertions, 588 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/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, |