diff options
author | Björn Gustavsson <bjorn@erlang.org> | 2021-11-10 14:21:36 +0100 |
---|---|---|
committer | GitHub <noreply@github.com> | 2021-11-10 14:21:36 +0100 |
commit | aaf9b2ff1b6e7b08eae9992eb9884a046b444afe (patch) | |
tree | 8301d640a47060ab10e040aa4eb4c9a798edde11 /lib/common_test | |
parent | 161a7555cf86241cafc652623bd3a3426512cc55 (diff) | |
parent | b67b337f0ceb60c5a9ca87ff808b93b3f846703b (diff) | |
download | erlang-aaf9b2ff1b6e7b08eae9992eb9884a046b444afe.tar.gz |
Merge pull request #5162 from max-au/max-au/peer
peer: new module to replace 'slave'
OTP-17720
Diffstat (limited to 'lib/common_test')
-rw-r--r-- | lib/common_test/include/ct.hrl | 11 | ||||
-rw-r--r-- | lib/common_test/src/test_server.erl | 99 | ||||
-rw-r--r-- | lib/common_test/src/test_server_node.erl | 3 |
3 files changed, 113 insertions, 0 deletions
diff --git a/lib/common_test/include/ct.hrl b/lib/common_test/include/ct.hrl index efadb22cec..2860573208 100644 --- a/lib/common_test/include/ct.hrl +++ b/lib/common_test/include/ct.hrl @@ -36,6 +36,17 @@ -define(CT_HOOK_INIT_PROCESS, ct_util_server). -define(CT_HOOK_TERMINATE_PROCESS, ct_util_server). +%% Peer node names generated for Common Test purposes: +-define(CT_PEER_NAME(TestCase), test_server:peer_name(?MODULE_STRING, TestCase)). +-define(CT_PEER_NAME(), ?CT_PEER_NAME(?FUNCTION_NAME)). + +%% Start nodes with command line arguments or extended options +-define(CT_PEER(Opts), test_server:start_peer(Opts, ?MODULE, ?FUNCTION_NAME)). +%% Start a peer with name prefix of current ?MODULE and ?FUNCTION_NAME +-define(CT_PEER(), ?CT_PEER([])). +%% Start a compatibility node - for OTP test suites only +-define(CT_PEER(Opts, Release, PrivDir), test_server:start_peer(Opts, ?MODULE, ?FUNCTION_NAME, Release, PrivDir)). + %% Backward compatibility for test_server test suites. %% DO NOT USE IN NEW TEST SUITES. -define(line,). diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl index 0d2a89ed82..5a9b96aed6 100644 --- a/lib/common_test/src/test_server.erl +++ b/lib/common_test/src/test_server.erl @@ -40,6 +40,7 @@ -export([call_crash/3,call_crash/4,call_crash/5]). -export([temp_name/1]). -export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1, find_release/1]). +-export([peer_name/2, start_peer/3, start_peer/5]). -export([app_test/1, app_test/2, appup_test/1]). -export([comment/1, make_priv_dir/0]). -export([os_type/0]). @@ -2687,6 +2688,7 @@ wait_for_node(Slave) -> end, Result. +-compile([{nowarn_deprecated_function, [{slave, stop, 1}]}]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% stop_node(Name) -> true|false @@ -2779,6 +2781,103 @@ find_release(Release) -> {test_server_ctrl,find_release,[Release]}}, receive {sync_result,R} -> R end. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% API for starting peer nodes according to Common Test conventions +peer_name(Module, TestCase) -> + peer:random_name(lists:concat([Module, "-", TestCase])). + +%% Command line arguments passed +-spec start_peer([string()] | peer:start_options(), atom() | string(), TestCase :: atom() | string()) -> + {ok, gen_statem:server_ref(), node()} | {error, term()}. +start_peer(Args, Module, TestCase) when is_list(Args) -> + start_peer(#{args => Args, name => peer_name(Module, TestCase)}, Module); + +%% Full set of options passed +start_peer(#{name := _Name} = Opts, Module, _TestCase) -> + start_peer(Opts, Module); +start_peer(Opts, Module, TestCase) -> + start_peer(Opts#{name => peer_name(Module, TestCase)}, Module). + +%% Release compatibility testing +-spec start_peer([string()] | peer:start_options(), atom() | string(), TestCase :: atom() | string(), + Release :: string(), OutDir :: file:filename()) -> + {ok, gen_statem:server_ref(), node()} | {error, term()} | not_available. +start_peer(Args, Module, TestCase, Release, OutDir) when is_list(Args) -> + start_peer(#{args => Args}, Module, TestCase, Release, OutDir); +start_peer(Opts, Module, TestCase, Release, OutDir) -> + case find_release(Release) of + not_available -> + not_available; + Erl -> + %% remove ERL_FLAGS/ERL_AFLAGS, because they may contain + %% "-emu_type debug" which does not exist for old releases. Keep "ERL_ZFLAGS", + %% for sometimes you might really need it... + Env = maps:get(env, Opts, []) ++ [{"ERL_AFLAGS", false}, {"ERL_FLAGS", false}], + NewArgs = ["-pa", peer_compile(Erl, code:which(peer), OutDir) | maps:get(args, Opts, [])], + start_peer(Opts#{exec => Erl, args => NewArgs, + env => Env}, Module, TestCase) + end. + +%% Internal implementation +start_peer(#{name := Name} = Opts, Module) -> + CrashDir = test_server_sup:crash_dump_dir(), + CrashFile = filename:join([CrashDir, lists:concat(["erl_crash_dump.", Name])]), + Args = maps:get(args, Opts, []), + CookieArg = + case lists:member("-setcookie", Args) of + false -> + ["-setcookie", atom_to_list(erlang:get_cookie())]; + true -> + [] + end, + FullArgs = CookieArg ++ ["-pa", filename:dirname(code:which(Module)), + "-env", "ERL_CRASH_DUMP", CrashFile] ++ Args, + case test_server:is_cover() of + true -> + %% when cover is active, node must shut down gracefully, otherwise + %% coverage information won't be sent to cover master + CoverMain = cover:get_main_node(), + %% next line is a way to trick Dialyzer into not complaining over undocumented type + Shutdown = binary_to_term(term_to_binary({10000, CoverMain})), + case peer:start_link(Opts#{args => FullArgs, shutdown => Shutdown}) of + {ok, Peer, Node} -> + do_cover_for_node(Node, start), + {ok, Peer, Node}; + Other -> + Other + end; + false -> + peer:start_link(Opts#{args => FullArgs}) + end. + +%% When a different release is requested, peer.erl needs to be compiled for +%% that specific release using the path supplied for 'erl' +peer_compile(Erl, cover_compiled, OutDir) -> + {file, Path} = cover:is_compiled(peer), + peer_compile(Erl, Path, OutDir); +peer_compile(Erl, ModPath, OutDir) -> + {ok, ModSrc} = filelib:find_source(ModPath), + Erlc = filename:join(filename:dirname(Erl), "erlc"), + cmd(Erlc, ["-o", OutDir, ModSrc]), + OutDir. + +%% This should really be implemented as os:cmd. +cmd(Exec, Args) -> + %% remove all ERL_FLAGS/ERL_AFLAGS to drop "-emu_type debug" + Env = [{"ERL_AFLAGS", false}, {"ERL_FLAGS", false}], + Port = open_port({spawn_executable, Exec}, [{args, Args}, {env, Env}, + stream, binary, exit_status, stderr_to_stdout]), + read_std(Port, lists:join(" ", [Exec|Args]), <<>>). + +read_std(Port, Exec, Out) -> + receive + {Port, {data, More}} -> + read_std(Port, Exec, <<Out/binary, More/binary>>); + {Port, {exit_status, 0}} -> + Out; + {Port, {exit_status, Status}} -> + erlang:error({exit, Status, Exec, Out}) + end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% run_on_shielded_node(Fun, CArgs) -> term() diff --git a/lib/common_test/src/test_server_node.erl b/lib/common_test/src/test_server_node.erl index 349402fcca..0959624431 100644 --- a/lib/common_test/src/test_server_node.erl +++ b/lib/common_test/src/test_server_node.erl @@ -179,6 +179,9 @@ start_node_slave(SlaveName, OptList, From, _TI) -> end, gen_server:reply(From,Ret). +%% Temporary suppression, to avoid a warning calling undocumented +%% but deprecated function. +-compile([{nowarn_deprecated_function,[{slave,start,5}]}]). do_start_node_slave(Host0, SlaveName, Args, Prog, Cleanup) -> Host = |