aboutsummaryrefslogtreecommitdiffstats
path: root/lib/common_test
diff options
context:
space:
mode:
Diffstat (limited to 'lib/common_test')
-rw-r--r--lib/common_test/doc/src/ct.xml36
-rw-r--r--lib/common_test/src/ct.erl35
-rw-r--r--lib/common_test/src/ct_config.erl1
-rw-r--r--lib/common_test/src/ct_default_gl.erl1
-rw-r--r--lib/common_test/src/ct_event.erl1
-rw-r--r--lib/common_test/src/ct_gen_conn.erl9
-rw-r--r--lib/common_test/src/ct_hooks_lock.erl1
-rw-r--r--lib/common_test/src/ct_logs.erl4
-rw-r--r--lib/common_test/src/ct_master.erl2
-rw-r--r--lib/common_test/src/ct_master_event.erl1
-rw-r--r--lib/common_test/src/ct_master_logs.erl1
-rw-r--r--lib/common_test/src/ct_repeat.erl2
-rw-r--r--lib/common_test/src/ct_run.erl14
-rw-r--r--lib/common_test/src/ct_slave.erl1
-rw-r--r--lib/common_test/src/ct_telnet_client.erl1
-rw-r--r--lib/common_test/src/ct_util.erl68
-rw-r--r--lib/common_test/src/ct_webtool.erl1
-rw-r--r--lib/common_test/src/ct_webtool_sup.erl1
-rw-r--r--lib/common_test/src/cth_log_redirect.erl1
-rw-r--r--lib/common_test/src/test_server.erl10
-rw-r--r--lib/common_test/src/test_server_ctrl.erl2
-rw-r--r--lib/common_test/src/test_server_gl.erl1
-rw-r--r--lib/common_test/src/test_server_io.erl9
-rw-r--r--lib/common_test/src/test_server_node.erl1
-rw-r--r--lib/common_test/src/test_server_sup.erl3
-rw-r--r--lib/common_test/src/vts.erl2
-rw-r--r--lib/common_test/test/Makefile3
-rw-r--r--lib/common_test/test/ct_auto_clean_SUITE.erl262
-rw-r--r--lib/common_test/test/ct_auto_clean_SUITE_data/ac_SUITE.erl181
-rw-r--r--lib/common_test/test/ct_auto_clean_SUITE_data/cth_auto_clean.erl214
30 files changed, 861 insertions, 8 deletions
diff --git a/lib/common_test/doc/src/ct.xml b/lib/common_test/doc/src/ct.xml
index 1a3cfdb0c5..afd8741cd1 100644
--- a/lib/common_test/doc/src/ct.xml
+++ b/lib/common_test/doc/src/ct.xml
@@ -1060,6 +1060,42 @@
</desc>
</func>
+ <func>
+ <name>remaining_test_procs() -&gt; {TestProcs,SharedGL,OtherGLs}</name>
+ <fsummary>>This function will return the identity of test- and group
+ leader processes that are still running at the time of this call.</fsummary>
+ <type>
+ <v>TestProcs = [{pid(),GL}]</v>
+ <v>GL = pid()</v>
+ <v>SharedGL = pid()</v>
+ <v>OtherGLs = [pid()]</v>
+ </type>
+ <desc><marker id="remaining_test_procs-0"/>
+ <p>This function will return the identity of test- and group
+ leader processes that are still running at the time of this call.
+ <c>TestProcs</c> are processes in the system that have a Common Test IO
+ process as group leader. <c>SharedGL</c> is the central Common Test
+ IO process, responsible for printing to log files for configuration
+ functions and sequentially executing test cases. <c>OtherGLs</c> are
+ Common Test IO processes that print to log files for test cases
+ in parallel test case groups.</p>
+ <p>The process information returned by this function may be
+ used to locate and terminate remaining processes after tests have
+ finished executing. The function would typically by called from
+ Common Test Hook functions.</p>
+ <p>Note that processes that execute configuration functions or
+ test cases are never included in <c>TestProcs</c>. It is therefore safe
+ to use post configuration hook functions (such as post_end_per_suite,
+ post_end_per_group, post_end_per_testcase) to terminate all processes
+ in <c>TestProcs</c> that have the current group leader process as its group
+ leader.</p>
+ <p>Note also that the shared group leader (<c>SharedGL</c>) must never be
+ terminated by the user, only by Common Test. Group leader processes
+ for parallel test case groups (<c>OtherGLs</c>) may however be terminated
+ in post_end_per_group hook functions.</p>
+ </desc>
+ </func>
+
<func>
<name>remove_config(Callback, Config) -&gt; ok</name>
<fsummary>Removes configuration variables (together with
diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl
index 875301a8b2..69e371a30f 100644
--- a/lib/common_test/src/ct.erl
+++ b/lib/common_test/src/ct.erl
@@ -89,6 +89,8 @@
-export([get_target_name/1]).
-export([parse_table/1, listenv/1]).
+-export([remaining_test_procs/0]).
+
%%----------------------------------------------------------------------
%% Exported types
%%----------------------------------------------------------------------
@@ -1474,3 +1476,36 @@ continue() ->
%%% in order to let the test case proceed.</p>
continue(TestCase) ->
test_server:continue(TestCase).
+
+
+%%%-----------------------------------------------------------------
+%%% @spec remaining_test_procs() -> {TestProcs,SharedGL,OtherGLs}
+%%% TestProcs = [{pid(),GL}]
+%%% GL = SharedGL = pid()
+%%% OtherGLs = [pid()]
+%%%
+%%% @doc <p>This function will return the identity of test- and group
+%%% leader processes that are still running at the time of this call.
+%%% TestProcs are processes in the system that have a Common Test IO
+%%% process as group leader. SharedGL is the central Common Test
+%%% IO process, responsible for printing to log files for configuration
+%%% functions and sequentially executing test cases. OtherGLs are
+%%% Common Test IO processes that print to log files for test cases
+%%% in parallel test case groups.</p>
+%%% <p>The process information returned by this function may be
+%%% used to locate and terminate remaining processes after tests have
+%%% finished executing. The function would typically by called from
+%%% Common Test Hook functions.</p>
+%%% <p>Note that processes that execute configuration functions or
+%%% test cases are never included in TestProcs. It is therefore safe
+%%% to use post configuration hook functions (such as post_end_per_suite,
+%%% post_end_per_group, post_end_per_testcase) to terminate all processes
+%%% in TestProcs that have the current group leader process as its group
+%%% leader.</p>
+%%% <p>Note also that the shared group leader (SharedGL) must never be
+%%% terminated by the user, only by Common Test. Group leader processes
+%%% for parallel test case groups (OtherGLs) may however be terminated
+%%% in post_end_per_group hook functions.</p>
+%%%
+remaining_test_procs() ->
+ ct_util:remaining_test_procs().
diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl
index b3f983dd46..6c87b11f8d 100644
--- a/lib/common_test/src/ct_config.erl
+++ b/lib/common_test/src/ct_config.erl
@@ -81,6 +81,7 @@ start(Mode) ->
do_start(Parent) ->
process_flag(trap_exit,true),
+ ct_util:mark_process(),
register(ct_config_server,self()),
ct_util:create_table(?attr_table,bag,#ct_conf.key),
{ok,StartDir} = file:get_cwd(),
diff --git a/lib/common_test/src/ct_default_gl.erl b/lib/common_test/src/ct_default_gl.erl
index d1b52e5f4f..9ae430c546 100644
--- a/lib/common_test/src/ct_default_gl.erl
+++ b/lib/common_test/src/ct_default_gl.erl
@@ -55,6 +55,7 @@ stop() ->
init([ParentGL]) ->
register(?MODULE, self()),
+ ct_util:mark_process(),
{ok,#{parent_gl_pid => ParentGL,
parent_gl_monitor => erlang:monitor(process,ParentGL)}}.
diff --git a/lib/common_test/src/ct_event.erl b/lib/common_test/src/ct_event.erl
index 1a0ee4f3cd..8b5bba7600 100644
--- a/lib/common_test/src/ct_event.erl
+++ b/lib/common_test/src/ct_event.erl
@@ -137,6 +137,7 @@ is_alive() ->
%% this function is called to initialize the event handler.
%%--------------------------------------------------------------------
init(RecvPids) ->
+ ct_util:mark_process(),
%% RecvPids = [{RecvTag,Pid}]
{ok,#state{receivers=RecvPids}}.
diff --git a/lib/common_test/src/ct_gen_conn.erl b/lib/common_test/src/ct_gen_conn.erl
index badb7c52ae..456bfd8bd1 100644
--- a/lib/common_test/src/ct_gen_conn.erl
+++ b/lib/common_test/src/ct_gen_conn.erl
@@ -186,9 +186,11 @@ end_log() ->
do_within_time(Fun,Timeout) ->
Self = self(),
Silent = get(silent),
- TmpPid = spawn_link(fun() -> put(silent,Silent),
- R = Fun(),
- Self ! {self(),R}
+ TmpPid = spawn_link(fun() ->
+ ct_util:mark_process(),
+ put(silent,Silent),
+ R = Fun(),
+ Self ! {self(),R}
end),
ConnPid = get(conn_pid),
receive
@@ -301,6 +303,7 @@ return({To,Ref},Result) ->
init_gen(Parent,Opts) ->
process_flag(trap_exit,true),
+ ct_util:mark_process(),
put(silent,false),
try (Opts#gen_opts.callback):init(Opts#gen_opts.name,
Opts#gen_opts.address,
diff --git a/lib/common_test/src/ct_hooks_lock.erl b/lib/common_test/src/ct_hooks_lock.erl
index fea298e535..a82be288e1 100644
--- a/lib/common_test/src/ct_hooks_lock.erl
+++ b/lib/common_test/src/ct_hooks_lock.erl
@@ -78,6 +78,7 @@ release() ->
%% @doc Initiates the server
init(Id) ->
+ ct_util:mark_process(),
{ok, #state{ id = Id }}.
%% @doc Handling call messages
diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl
index 72107542a9..9861b1e521 100644
--- a/lib/common_test/src/ct_logs.erl
+++ b/lib/common_test/src/ct_logs.erl
@@ -666,6 +666,7 @@ log_timestamp({MS,S,US}) ->
logger(Parent, Mode, Verbosity) ->
register(?MODULE,self()),
+ ct_util:mark_process(),
%%! Below is a temporary workaround for the limitation of
%%! max one test run per second.
%%! --->
@@ -1004,6 +1005,7 @@ print_to_log(async, FromPid, Category, TCGL, Content, EscChars, State) ->
if FromPid /= TCGL ->
IoFun = create_io_fun(FromPid, CtLogFd, EscChars),
fun() ->
+ ct_util:mark_process(),
test_server:permit_io(TCGL, self()),
%% Since asynchronous io gets can get buffered if
@@ -1035,6 +1037,7 @@ print_to_log(async, FromPid, Category, TCGL, Content, EscChars, State) ->
end;
true ->
fun() ->
+ ct_util:mark_process(),
unexpected_io(FromPid, Category, ?MAX_IMPORTANCE,
Content, CtLogFd, EscChars)
end
@@ -3002,6 +3005,7 @@ simulate() ->
S = self(),
Pid = spawn(fun() ->
register(?MODULE,self()),
+ ct_util:mark_process(),
S ! {self(),started},
simulate_logger_loop()
end),
diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl
index 44d3fb8f64..e2ea525cdd 100644
--- a/lib/common_test/src/ct_master.erl
+++ b/lib/common_test/src/ct_master.erl
@@ -346,6 +346,7 @@ init_master(Parent,NodeOptsList,EvHandlers,MasterLogDir,LogDirs,
case whereis(ct_master) of
undefined ->
register(ct_master,self()),
+ ct_util:mark_process(),
ok;
_Pid ->
io:format("~nWarning: ct_master already running!~n"),
@@ -690,6 +691,7 @@ refresh_logs([],Refreshed) ->
init_node_ctrl(MasterPid,Cookie,Opts) ->
%% make sure tests proceed even if connection to master is lost
process_flag(trap_exit, true),
+ ct_util:mark_process(),
MasterNode = node(MasterPid),
group_leader(whereis(user),self()),
io:format("~n********** node_ctrl process ~w started on ~w **********~n",
diff --git a/lib/common_test/src/ct_master_event.erl b/lib/common_test/src/ct_master_event.erl
index d535d1274e..bd4d1efc92 100644
--- a/lib/common_test/src/ct_master_event.erl
+++ b/lib/common_test/src/ct_master_event.erl
@@ -116,6 +116,7 @@ sync_notify(Event) ->
%% this function is called to initialize the event handler.
%%--------------------------------------------------------------------
init(_) ->
+ ct_util:mark_process(),
ct_master_logs:log("CT Master Event Handler started","",[]),
{ok,#state{}}.
diff --git a/lib/common_test/src/ct_master_logs.erl b/lib/common_test/src/ct_master_logs.erl
index fd92f73f63..1308720823 100644
--- a/lib/common_test/src/ct_master_logs.erl
+++ b/lib/common_test/src/ct_master_logs.erl
@@ -88,6 +88,7 @@ stop() ->
init(Parent,LogDir,Nodes) ->
register(?MODULE,self()),
+ ct_util:mark_process(),
Time = calendar:local_time(),
RunDir = make_dirname(Time),
RunDirAbs = filename:join(LogDir,RunDir),
diff --git a/lib/common_test/src/ct_repeat.erl b/lib/common_test/src/ct_repeat.erl
index c043c9846c..177ef37d1f 100644
--- a/lib/common_test/src/ct_repeat.erl
+++ b/lib/common_test/src/ct_repeat.erl
@@ -70,6 +70,7 @@ loop_test(If,Args) when is_list(Args) ->
CtrlPid = self(),
spawn(
fun() ->
+ ct_util:mark_process(),
stop_after(CtrlPid,Secs,ForceStop)
end)
end,
@@ -134,6 +135,7 @@ spawn_tester(script,Ctrl,Args) ->
spawn_tester(func,Ctrl,Opts) ->
Tester = fun() ->
+ ct_util:mark_process(),
case catch ct_run:run_test2(Opts) of
{'EXIT',Reason} ->
exit(Reason);
diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl
index 9436236719..8c401cf3f5 100644
--- a/lib/common_test/src/ct_run.erl
+++ b/lib/common_test/src/ct_run.erl
@@ -250,6 +250,8 @@ finish(Tracing, ExitStatus, Args) ->
end.
script_start1(Parent, Args) ->
+ %% tag this process
+ ct_util:mark_process(),
%% read general start flags
Label = get_start_opt(label, fun([Lbl]) -> Lbl end, Args),
Profile = get_start_opt(profile, fun([Prof]) -> Prof end, Args),
@@ -956,7 +958,10 @@ run_test(StartOpts) when is_list(StartOpts) ->
-spec run_test1_fun(_) -> fun(() -> no_return()).
run_test1_fun(StartOpts) ->
- fun() -> run_test1(StartOpts) end.
+ fun() ->
+ ct_util:mark_process(),
+ run_test1(StartOpts)
+ end.
run_test1(StartOpts) when is_list(StartOpts) ->
case proplists:get_value(refresh_logs, StartOpts) of
@@ -1447,7 +1452,10 @@ run_testspec(TestSpec) ->
-spec run_testspec1_fun(_) -> fun(() -> no_return()).
run_testspec1_fun(TestSpec) ->
- fun() -> run_testspec1(TestSpec) end.
+ fun() ->
+ ct_util:mark_process(),
+ run_testspec1(TestSpec)
+ end.
run_testspec1(TestSpec) ->
{ok,Cwd} = file:get_cwd(),
@@ -1906,10 +1914,12 @@ possibly_spawn(true, Tests, Skip, Opts) ->
CTUtilSrv = whereis(ct_util_server),
Supervisor =
fun() ->
+ ct_util:mark_process(),
process_flag(trap_exit, true),
link(CTUtilSrv),
TestRun =
fun() ->
+ ct_util:mark_process(),
TestResult = (catch do_run_test(Tests, Skip, Opts)),
case TestResult of
{EType,_} = Error when EType == user_error;
diff --git a/lib/common_test/src/ct_slave.erl b/lib/common_test/src/ct_slave.erl
index 61e6446df8..0c16ad5980 100644
--- a/lib/common_test/src/ct_slave.erl
+++ b/lib/common_test/src/ct_slave.erl
@@ -318,6 +318,7 @@ monitor_master(MasterNode) ->
% code of the masterdeath-waiter process
monitor_master_int(MasterNode) ->
+ ct_util:mark_process(),
erlang:monitor_node(MasterNode, true),
receive
{nodedown, MasterNode}->
diff --git a/lib/common_test/src/ct_telnet_client.erl b/lib/common_test/src/ct_telnet_client.erl
index c8d217cd2a..76e4b9ea70 100644
--- a/lib/common_test/src/ct_telnet_client.erl
+++ b/lib/common_test/src/ct_telnet_client.erl
@@ -118,6 +118,7 @@ get_data(Pid) ->
%%%-----------------------------------------------------------------
%%% Internal functions
init(Parent, Server, Port, Timeout, KeepAlive, NoDelay, ConnName) ->
+ ct_util:mark_process(),
case gen_tcp:connect(Server, Port, [list,{packet,0},{nodelay,NoDelay}], Timeout) of
{ok,Sock} ->
dbg("~tp connected to: ~tp (port: ~w, keep_alive: ~w)\n",
diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl
index 3c0fead5b2..10a06d5c88 100644
--- a/lib/common_test/src/ct_util.erl
+++ b/lib/common_test/src/ct_util.erl
@@ -65,6 +65,9 @@
-export([warn_duplicates/1]).
+-export([mark_process/0, mark_process/1, is_marked/1, is_marked/2,
+ remaining_test_procs/0]).
+
-export([get_profile_data/0, get_profile_data/1,
get_profile_data/2, open_url/3]).
@@ -126,6 +129,7 @@ start(Mode, LogDir, Verbosity) ->
do_start(Parent, Mode, LogDir, Verbosity) ->
process_flag(trap_exit,true),
register(ct_util_server,self()),
+ mark_process(),
create_table(?conn_table,#conn.handle),
create_table(?board_table,2),
create_table(?suite_table,#suite_data.key),
@@ -934,6 +938,70 @@ warn_duplicates(Suites) ->
%%% @spec
%%%
%%% @doc
+mark_process() ->
+ mark_process(system).
+
+mark_process(Type) ->
+ put(ct_process_type, Type).
+
+is_marked(Pid) ->
+ is_marked(Pid, system).
+
+is_marked(Pid, Type) ->
+ case process_info(Pid, dictionary) of
+ {dictionary,List} ->
+ Type == proplists:get_value(ct_process_type, List);
+ undefined ->
+ false
+ end.
+
+remaining_test_procs() ->
+ Procs = processes(),
+ {SharedGL,OtherGLs,Procs2} =
+ lists:foldl(
+ fun(Pid, ProcTypes = {Shared,Other,Procs1}) ->
+ case is_marked(Pid, group_leader) of
+ true ->
+ if not is_pid(Shared) ->
+ case test_server_io:get_gl(true) of
+ Pid ->
+ {Pid,Other,
+ lists:delete(Pid,Procs1)};
+ _ ->
+ {Shared,[Pid|Other],Procs1}
+ end;
+ true -> % SharedGL already found
+ {Shared,[Pid|Other],Procs1}
+ end;
+ false ->
+ case is_marked(Pid) of
+ true ->
+ {Shared,Other,lists:delete(Pid,Procs1)};
+ false ->
+ ProcTypes
+ end
+ end
+ end, {undefined,[],Procs}, Procs),
+
+ AllGLs = [SharedGL | OtherGLs],
+ TestProcs =
+ lists:flatmap(fun(Pid) ->
+ case process_info(Pid, group_leader) of
+ {group_leader,GL} ->
+ case lists:member(GL, AllGLs) of
+ true -> [{Pid,GL}];
+ false -> []
+ end;
+ undefined ->
+ []
+ end
+ end, Procs2),
+ {TestProcs, SharedGL, OtherGLs}.
+
+%%%-----------------------------------------------------------------
+%%% @spec
+%%%
+%%% @doc
get_profile_data() ->
get_profile_data(all).
diff --git a/lib/common_test/src/ct_webtool.erl b/lib/common_test/src/ct_webtool.erl
index 9016aca899..82aa78fc4b 100644
--- a/lib/common_test/src/ct_webtool.erl
+++ b/lib/common_test/src/ct_webtool.erl
@@ -343,6 +343,7 @@ code_change(_,State,_)->
% Start the gen_server
%----------------------------------------------------------------------
init({Path,Config})->
+ ct_util:mark_process(),
case filelib:is_dir(Path) of
true ->
{ok, Table} = get_tool_files_data(),
diff --git a/lib/common_test/src/ct_webtool_sup.erl b/lib/common_test/src/ct_webtool_sup.erl
index c02ec69d04..6c6dbde0a6 100644
--- a/lib/common_test/src/ct_webtool_sup.erl
+++ b/lib/common_test/src/ct_webtool_sup.erl
@@ -46,6 +46,7 @@ stop(Pid)->
%% {error, Reason}
%%----------------------------------------------------------------------
init(_StartArgs) ->
+ ct_util:mark_process(),
%%Child1 =
%%Child2 ={webcover_backend,{webcover_backend,start_link,[]},permanent,2000,worker,[webcover_backend]},
%%{ok,{{simple_one_for_one,5,10},[Child1]}}.
diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl
index 1c55e17686..b05f0bd28b 100644
--- a/lib/common_test/src/cth_log_redirect.erl
+++ b/lib/common_test/src/cth_log_redirect.erl
@@ -56,6 +56,7 @@ id(_Opts) ->
?MODULE.
init(?MODULE, _Opts) ->
+ ct_util:mark_process(),
error_logger:add_report_handler(?MODULE),
tc_log_async.
diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl
index 35a73e6d2e..7250041e13 100644
--- a/lib/common_test/src/test_server.erl
+++ b/lib/common_test/src/test_server.erl
@@ -415,6 +415,7 @@ run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
St = #st{ref=Ref,pid=Pid,mf={Mod,Func},last_known_loc=unknown,
status=starting,ret_val=[],comment="",timeout=infinity,
config=hd(Args)},
+ ct_util:mark_process(),
run_test_case_msgloop(St).
%% Ugly bug (pre R5A):
@@ -785,6 +786,7 @@ spawn_fw_call(Mod,IPTC={init_per_testcase,Func},CurrConf,Pid,
Why,Loc,SendTo) ->
FwCall =
fun() ->
+ ct_util:mark_process(),
Skip = {skip,{failed,{Mod,init_per_testcase,Why}}},
%% if init_per_testcase fails, the test case
%% should be skipped
@@ -815,6 +817,7 @@ spawn_fw_call(Mod,EPTC={end_per_testcase,Func},EndConf,Pid,
Why,_Loc,SendTo) ->
FwCall =
fun() ->
+ ct_util:mark_process(),
{RetVal,Report} =
case proplists:get_value(tc_status, EndConf) of
undefined ->
@@ -864,6 +867,7 @@ spawn_fw_call(Mod,EPTC={end_per_testcase,Func},EndConf,Pid,
spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) ->
FwCall =
fun() ->
+ ct_util:mark_process(),
test_server_sup:framework_call(report, [framework_error,
{{FwMod,FwFunc},
FwError}]),
@@ -880,6 +884,7 @@ spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) ->
spawn_link(FwCall);
spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) ->
+ ct_util:mark_process(),
{Func1,EndTCFunc} = case Func of
CF when CF == init_per_suite; CF == end_per_suite;
CF == init_per_group; CF == end_per_group ->
@@ -918,6 +923,7 @@ start_job_proxy() ->
%% The io_reply_proxy is not the most satisfying solution but it works...
io_reply_proxy(ReplyTo) ->
+ ct_util:mark_process(),
receive
IoReply when is_tuple(IoReply),
element(1, IoReply) == io_reply ->
@@ -927,6 +933,7 @@ io_reply_proxy(ReplyTo) ->
end.
job_proxy_msgloop() ->
+ ct_util:mark_process(),
receive
%%
@@ -1804,6 +1811,7 @@ break(CBM, TestCase, Comment) ->
spawn_break_process(Pid, PName) ->
spawn(fun() ->
register(PName, self()),
+ ct_util:mark_process(),
receive
continue -> continue(Pid);
cancel -> ok
@@ -2001,6 +2009,7 @@ time_ms_apply(Func, TCPid, MultAndScale) ->
user_timetrap_supervisor(Func, Spawner, TCPid, GL, T0, MultAndScale) ->
process_flag(trap_exit, true),
+ ct_util:mark_process(),
Spawner ! {self(),infinity},
MonRef = monitor(process, TCPid),
UserTTSup = self(),
@@ -2571,6 +2580,7 @@ run_on_shielded_node(Fun, CArgs) when is_function(Fun), is_list(CArgs) ->
-spec start_job_proxy_fun(_, _) -> fun(() -> no_return()).
start_job_proxy_fun(Master, Fun) ->
fun () ->
+ ct_util:mark_process(),
_ = start_job_proxy(),
receive
Ref ->
diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl
index 5988af4a29..3a454a1e84 100644
--- a/lib/common_test/src/test_server_ctrl.erl
+++ b/lib/common_test/src/test_server_ctrl.erl
@@ -1127,6 +1127,7 @@ init_tester(Mod, Func, Args, Dir, Name, {_,_,MinLev}=Levels,
RejectIoReqs, CreatePrivDir, TCCallback, ExtraTools) ->
process_flag(trap_exit, true),
_ = test_server_io:start_link(),
+ put(app, common_test),
put(test_server_name, Name),
put(test_server_dir, Dir),
put(test_server_total_time, 0),
@@ -3725,6 +3726,7 @@ run_test_case(Ref, Num, Mod, Func, Args, RunInit, TimetrapData, Mode) ->
spawn_link(
fun() ->
process_flag(trap_exit, true),
+ ct_util:mark_process(),
_ = [put(Key, Val) || {Key,Val} <- Dictionary],
set_io_buffering({tc,Main}),
run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
diff --git a/lib/common_test/src/test_server_gl.erl b/lib/common_test/src/test_server_gl.erl
index ce7682d101..24dd5cd54c 100644
--- a/lib/common_test/src/test_server_gl.erl
+++ b/lib/common_test/src/test_server_gl.erl
@@ -132,6 +132,7 @@ set_props(GL, PropList) ->
%%% Internal functions.
init([TSIO]) ->
+ ct_util:mark_process(group_leader),
EscChars = case application:get_env(test_server, esc_chars) of
{ok,ECBool} -> ECBool;
_ -> true
diff --git a/lib/common_test/src/test_server_io.erl b/lib/common_test/src/test_server_io.erl
index 062e3bd8ff..ef31521950 100644
--- a/lib/common_test/src/test_server_io.erl
+++ b/lib/common_test/src/test_server_io.erl
@@ -184,6 +184,7 @@ reset_state() ->
init([]) ->
process_flag(trap_exit, true),
+ ct_util:mark_process(),
Empty = gb_trees:empty(),
{ok,Shared} = test_server_gl:start_link(self()),
{ok,#st{fds=Empty,shared_gl=Shared,gls=gb_sets:empty(),
@@ -262,7 +263,7 @@ handle_call(reset_state, From, #st{phase=stopping,pending_ops=Ops}=St) ->
{Result,NewSt1}
end,
{noreply,St#st{pending_ops=[{From,Op}|Ops]}};
-handle_call(reset_state, _From, #st{fds=Fds,tags=Tags,gls=Gls,
+handle_call(reset_state, _From, #st{fds=Fds,tags=Tags,shared_gl=Shared0,gls=Gls,
offline_buffer=OfflineBuff}) ->
%% close open log files
lists:foreach(fun(Tag) ->
@@ -273,6 +274,7 @@ handle_call(reset_state, _From, #st{fds=Fds,tags=Tags,gls=Gls,
file:close(Fd)
end
end, Tags),
+ test_server_gl:stop(Shared0),
GlList = gb_sets:to_list(Gls),
_ = [test_server_gl:stop(GL) || GL <- GlList],
timer:sleep(100),
@@ -320,7 +322,7 @@ handle_call(finish, From, St) ->
handle_info({'EXIT',Pid,normal}, #st{gls=Gls0,stopping=From}=St) ->
Gls = gb_sets:delete_any(Pid, Gls0),
- case gb_sets:is_empty(Gls) andalso stopping =/= undefined of
+ case gb_sets:is_empty(Gls) andalso From =/= undefined of
true ->
%% No more group leaders left.
gen_server:reply(From, ok),
@@ -329,6 +331,9 @@ handle_info({'EXIT',Pid,normal}, #st{gls=Gls0,stopping=From}=St) ->
%% Wait for more group leaders to finish.
{noreply,St#st{gls=Gls,phase=stopping}}
end;
+handle_info({'EXIT',Pid,killed}, #st{gls=Gls0}=St) ->
+ %% forced termination of group leader
+ {noreply,St#st{gls=gb_sets:delete_any(Pid, Gls0)}};
handle_info({'EXIT',_Pid,Reason}, _St) ->
exit(Reason);
handle_info(stop_group_leaders, #st{gls=Gls}=St) ->
diff --git a/lib/common_test/src/test_server_node.erl b/lib/common_test/src/test_server_node.erl
index f0f9cea6e0..b2d4f199c3 100644
--- a/lib/common_test/src/test_server_node.erl
+++ b/lib/common_test/src/test_server_node.erl
@@ -749,6 +749,7 @@ unpack(Bin) ->
id(I) -> I.
print_data(Port) ->
+ ct_util:mark_process(),
receive
{Port, {data, Bytes}} ->
io:put_chars(Bytes),
diff --git a/lib/common_test/src/test_server_sup.erl b/lib/common_test/src/test_server_sup.erl
index 21f4be22fe..6ddbf1ad27 100644
--- a/lib/common_test/src/test_server_sup.erl
+++ b/lib/common_test/src/test_server_sup.erl
@@ -56,6 +56,7 @@ timetrap(Timeout0, Scale, Pid) ->
timetrap(Timeout0, ReportTVal, Scale, Pid) ->
process_flag(priority, max),
+ ct_util:mark_process(),
Timeout = if not Scale -> Timeout0;
true -> test_server:timetrap_scale_factor() * Timeout0
end,
@@ -773,6 +774,7 @@ framework_call(Callback,Func,Args,DefaultReturn) ->
false ->
ok
end,
+ ct_util:mark_process(),
try apply(Mod,Func,Args) of
Result ->
Result
@@ -850,6 +852,7 @@ util_start() ->
undefined ->
spawn_link(fun() ->
register(?MODULE, self()),
+ put(app, common_test),
util_loop(#util_state{starter=Starter})
end),
ok;
diff --git a/lib/common_test/src/vts.erl b/lib/common_test/src/vts.erl
index 99a109cfe8..83fcde2f48 100644
--- a/lib/common_test/src/vts.erl
+++ b/lib/common_test/src/vts.erl
@@ -157,6 +157,7 @@ test_info(_VtsPid,Type,Data) ->
init(Parent) ->
register(?MODULE,self()),
process_flag(trap_exit,true),
+ ct_util:mark_process(),
Parent ! {self(),started},
{ok,Cwd} = file:get_cwd(),
InitState = #state{start_dir=Cwd},
@@ -284,6 +285,7 @@ run_test1(State=#state{tests=Tests,current_log_dir=LogDir,
logopts=LogOpts}) ->
Self=self(),
RunTest = fun() ->
+ ct_util:mark_process(),
case ct_run:do_run(Tests,[],LogDir,LogOpts) of
{error,_Reason} ->
aborted();
diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile
index 0d9149f489..ecd1f727a2 100644
--- a/lib/common_test/test/Makefile
+++ b/lib/common_test/test/Makefile
@@ -73,7 +73,8 @@ MODULES= \
ct_log_SUITE \
ct_SUITE \
ct_keep_logs_SUITE \
- ct_unicode_SUITE
+ ct_unicode_SUITE \
+ ct_auto_clean_SUITE
ERL_FILES= $(MODULES:%=%.erl)
HRL_FILES= test_server_test_lib.hrl
diff --git a/lib/common_test/test/ct_auto_clean_SUITE.erl b/lib/common_test/test/ct_auto_clean_SUITE.erl
new file mode 100644
index 0000000000..fd81430d0d
--- /dev/null
+++ b/lib/common_test/test/ct_auto_clean_SUITE.erl
@@ -0,0 +1,262 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(ct_auto_clean_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).
+
+%%--------------------------------------------------------------------
+%% Function: init_per_suite(Config0) -> Config1 | {skip,Reason}
+%%
+%% Config0 = Config1 = [tuple()]
+%% A list of key/value pairs, holding the test case configuration.
+%% Reason = term()
+%% The reason for skipping the suite.
+%%
+%% Description: Since Common Test starts another Test Server
+%% instance, the tests need to be performed on a separate node (or
+%% there will be clashes with logging processes etc).
+%%--------------------------------------------------------------------
+init_per_suite(Config) ->
+ DataDir = ?config(data_dir, Config),
+ CTHs = filelib:wildcard(filename:join(DataDir,"cth_*.erl")),
+ ct:pal("CTHs: ~p",[CTHs]),
+ [ct:pal("Compiling ~p: ~p",
+ [FileName,compile:file(FileName,[{outdir,DataDir},debug_info])]) ||
+ FileName <- CTHs],
+ ct_test_support:init_per_suite([{path_dirs,[DataDir]} | Config]).
+
+%%--------------------------------------------------------------------
+%% Function: end_per_suite(Config) -> void()
+%%
+%% Config = [tuple()]
+%% A list of key/value pairs, holding the test case configuration.
+%%
+%% Description: Cleanup after the suite.
+%%--------------------------------------------------------------------
+end_per_suite(Config) ->
+ ct_test_support:end_per_suite(Config).
+
+%%--------------------------------------------------------------------
+%% Function: init_per_testcase(TestCase, Config0) -> Config1 |
+%% {skip,Reason}
+%% TestCase = atom()
+%% Name of the test case that is about to run.
+%% Config0 = Config1 = [tuple()]
+%% A list of key/value pairs, holding the test case configuration.
+%% Reason = term()
+%% The reason for skipping the test case.
+%%
+%% Description: Initialization before each test case.
+%%
+%% Note: This function is free to add any key/value pairs to the Config
+%% variable, but should NOT alter/remove any existing entries.
+%%--------------------------------------------------------------------
+init_per_testcase(TestCase, Config) ->
+ ct_test_support:init_per_testcase(TestCase, Config).
+
+%%--------------------------------------------------------------------
+%% Function: end_per_testcase(TestCase, Config) -> void()
+%%
+%% TestCase = atom()
+%% Name of the test case that is finished.
+%% Config = [tuple()]
+%% A list of key/value pairs, holding the test case configuration.
+%%
+%% Description: Cleanup after each test case.
+%%--------------------------------------------------------------------
+end_per_testcase(TestCase, Config) ->
+ ct_test_support:end_per_testcase(TestCase, Config).
+
+%%--------------------------------------------------------------------
+%% Function: all(Clause) -> Descr | TestCases | {skip,Reason}
+%%
+%% Clause = doc | suite
+%% Indicates expected return value.
+%% Descr = [string()] | []
+%% String that describes the test suite.
+%% TestCases = [TestCase]
+%% TestCase = atom()
+%% Name of a test case.
+%% Reason = term()
+%% The reason for skipping the test suite.
+%%
+%% Description: Returns a description of the test suite (doc) and a
+%% list of all test cases in the suite (suite).
+%%--------------------------------------------------------------------
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [clean].
+
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+%%--------------------------------------------------------------------
+%% TEST CASES
+%%--------------------------------------------------------------------
+
+%%--------------------------------------------------------------------
+%% Function: TestCase(Arg) -> Descr | Spec | ok | exit() | {skip,Reason}
+%%
+%% Arg = doc | suite | Config
+%% Indicates expected behaviour and return value.
+%% Config = [tuple()]
+%% A list of key/value pairs, holding the test case configuration.
+%% Descr = [string()] | []
+%% String that describes the test case.
+%% Spec = [tuple()] | []
+%% A test specification.
+%% Reason = term()
+%% The reason for skipping the test case.
+%%
+%% Description: Test case function. Returns a description of the test
+%% case (doc), then returns a test specification (suite),
+%% or performs the actual test (Config).
+%%--------------------------------------------------------------------
+
+%%%-----------------------------------------------------------------
+%%%
+
+clean(Config) when is_list(Config) ->
+ DataDir = ?config(data_dir, Config),
+
+ ACSuite = filename:join(DataDir, "ac_SUITE"),
+ Opts0 = ct_test_support:get_opts(Config),
+ Opts = eh_opts(Config) ++ Opts0 ++ [{suite,ACSuite},
+ {ct_hooks,[cth_auto_clean]}],
+
+ ERPid = ct_test_support:start_event_receiver(Config),
+
+ ok = ct_test_support:run(Opts, Config),
+
+ Events = ct_test_support:get_events(ERPid, Config),
+ ct_test_support:log_events(?FUNCTION_NAME,
+ ct_test_support:reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
+ TestEvents = events_to_check(?FUNCTION_NAME),
+ ok = ct_test_support:verify_events(TestEvents, Events, Config).
+
+
+%%%-----------------------------------------------------------------
+%%% HELP FUNCTIONS
+%%%-----------------------------------------------------------------
+
+eh_opts(Config) ->
+ Level = ?config(trace_level, Config),
+ [{event_handler,{?eh,[{cbm,ct_test_support},{trace_level,Level}]}}].
+
+events_to_check(Test) ->
+ %% 2 tests (ct:run_test + script_start) is default
+ events_to_check(Test, 2).
+
+events_to_check(_, 0) ->
+ [];
+events_to_check(Test, N) ->
+ events(Test) ++ events_to_check(Test, N-1).
+
+events(clean) ->
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,start_info,{1,1,9}},
+
+ {?eh,tc_start,{ac_SUITE,init_per_suite}},
+ {?eh,tc_done,{ac_SUITE,init_per_suite,ok}},
+
+ {?eh,tc_start,{ac_SUITE,tc1}},
+ {?eh,tc_done,{ac_SUITE,tc1,ok}},
+
+ {?eh,test_stats,{1,0,{0,0}}},
+
+ {?eh,tc_start,{ac_SUITE,tc2}},
+ {?eh,tc_done,{ac_SUITE,tc2,ok}},
+
+ {?eh,test_stats,{2,0,{0,0}}},
+
+ [{?eh,tc_start,{ac_SUITE,{init_per_group,s1,[]}}},
+ {?eh,tc_done,{ac_SUITE,{init_per_group,s1,[]},ok}},
+
+ {?eh,tc_start,{ac_SUITE,stc1}},
+ {?eh,tc_done,{ac_SUITE,stc1,ok}},
+
+ {?eh,test_stats,{3,0,{0,0}}},
+
+ {?eh,tc_start,{ac_SUITE,stc2}},
+ {?eh,tc_done,{ac_SUITE,stc2,ok}},
+
+ {?eh,test_stats,{4,0,{0,0}}},
+
+ {?eh,tc_start,{ac_SUITE,{end_per_group,s1,[]}}},
+ {?eh,tc_done,{ac_SUITE,{end_per_group,s1,[]},ok}}],
+
+ {parallel,
+ [{?eh,tc_start,{ac_SUITE,{init_per_group,p1,[parallel]}}},
+ {?eh,tc_done,{ac_SUITE,{init_per_group,p1,[parallel]},ok}},
+
+ {?eh,tc_start,{ac_SUITE,ptc1}},
+ {?eh,tc_start,{ac_SUITE,ptc2}},
+ {?eh,tc_done,{ac_SUITE,ptc1,ok}},
+ {?eh,test_stats,{5,0,{0,0}}},
+ {?eh,tc_done,{ac_SUITE,ptc2,ok}},
+ {?eh,test_stats,{6,0,{0,0}}},
+
+ {?eh,tc_start,{ac_SUITE,{end_per_group,p1,[parallel]}}},
+ {?eh,tc_done,{ac_SUITE,{end_per_group,p1,[parallel]},ok}}]},
+
+ [{?eh,tc_start,{ac_SUITE,{init_per_group,s2,[]}}},
+ {?eh,tc_done,{ac_SUITE,{init_per_group,s2,[]},ok}},
+
+ {?eh,tc_start,{ac_SUITE,stc1}},
+ {?eh,tc_done,{ac_SUITE,stc1,ok}},
+
+ {?eh,test_stats,{7,0,{0,0}}},
+
+ {?eh,tc_start,{ac_SUITE,stc2}},
+ {?eh,tc_done,{ac_SUITE,stc2,ok}},
+
+ {?eh,test_stats,{8,0,{0,0}}},
+
+ {?eh,tc_start,{ac_SUITE,{end_per_group,s2,[]}}},
+ {?eh,tc_done,{ac_SUITE,{end_per_group,s2,[]},ok}}],
+
+ {?eh,tc_start,{ac_SUITE,tc1}},
+ {?eh,tc_done,{ac_SUITE,tc1,ok}},
+
+ {?eh,test_stats,{9,0,{0,0}}},
+
+ {?eh,tc_start,{ac_SUITE,end_per_suite}},
+ {?eh,tc_done,{ac_SUITE,end_per_suite,ok}},
+
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,stop_logging,[]}
+ ].
diff --git a/lib/common_test/test/ct_auto_clean_SUITE_data/ac_SUITE.erl b/lib/common_test/test/ct_auto_clean_SUITE_data/ac_SUITE.erl
new file mode 100644
index 0000000000..dae7c1e22c
--- /dev/null
+++ b/lib/common_test/test/ct_auto_clean_SUITE_data/ac_SUITE.erl
@@ -0,0 +1,181 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(ac_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+
+%%--------------------------------------------------------------------
+%% @spec suite() -> Info
+%% Info = [tuple()]
+%% @end
+%%--------------------------------------------------------------------
+suite() ->
+ [{timetrap,{seconds,30}}].
+
+%%--------------------------------------------------------------------
+%% @spec init_per_suite(Config0) ->
+%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}
+%% Config0 = Config1 = [tuple()]
+%% Reason = term()
+%% @end
+%%--------------------------------------------------------------------
+init_per_suite(Config) ->
+ start_processes(),
+ Config.
+
+%%--------------------------------------------------------------------
+%% @spec end_per_suite(Config0) -> term() | {save_config,Config1}
+%% Config0 = Config1 = [tuple()]
+%% @end
+%%--------------------------------------------------------------------
+end_per_suite(_Config) ->
+ start_processes(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% @spec init_per_group(GroupName, Config0) ->
+%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}
+%% GroupName = atom()
+%% Config0 = Config1 = [tuple()]
+%% Reason = term()
+%% @end
+%%--------------------------------------------------------------------
+init_per_group(_GroupName, Config) ->
+ start_processes(),
+ Config.
+
+%%--------------------------------------------------------------------
+%% @spec end_per_group(GroupName, Config0) ->
+%% term() | {save_config,Config1}
+%% GroupName = atom()
+%% Config0 = Config1 = [tuple()]
+%% @end
+%%--------------------------------------------------------------------
+end_per_group(_GroupName, _Config) ->
+ start_processes(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% @spec init_per_testcase(TestCase, Config0) ->
+%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}
+%% TestCase = atom()
+%% Config0 = Config1 = [tuple()]
+%% Reason = term()
+%% @end
+%%--------------------------------------------------------------------
+init_per_testcase(_TestCase, Config) ->
+ start_processes(),
+ Config.
+
+%%--------------------------------------------------------------------
+%% @spec end_per_testcase(TestCase, Config0) ->
+%% term() | {save_config,Config1} | {fail,Reason}
+%% TestCase = atom()
+%% Config0 = Config1 = [tuple()]
+%% Reason = term()
+%% @end
+%%--------------------------------------------------------------------
+end_per_testcase(_TestCase, _Config) ->
+ start_processes(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% @spec groups() -> [Group]
+%% Group = {GroupName,Properties,GroupsAndTestCases}
+%% GroupName = atom()
+%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]
+%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase]
+%% TestCase = atom()
+%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}}
+%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |
+%% repeat_until_any_ok | repeat_until_any_fail
+%% N = integer() | forever
+%% @end
+%%--------------------------------------------------------------------
+groups() ->
+ [{s1,[],[stc1,stc2]},
+ {p1,[parallel],[ptc1,ptc2]},
+ {s2,[],[stc1,stc2]}].
+
+%%! What about nested groups??
+
+%%--------------------------------------------------------------------
+%% @spec all() -> GroupsAndTestCases | {skip,Reason}
+%% GroupsAndTestCases = [{group,GroupName} | TestCase]
+%% GroupName = atom()
+%% TestCase = atom()
+%% Reason = term()
+%% @end
+%%--------------------------------------------------------------------
+all() ->
+ [
+ [tc1,tc2],
+ {group,s1},
+ {group,p1},
+ {group,s2},
+ tc1
+ ].
+
+tc1(_Config) ->
+ start_processes(),
+ ok.
+
+tc2(_Config) ->
+ start_processes(),
+ ok.
+
+stc1(_Config) ->
+ start_processes(),
+ ok.
+
+stc2(_Config) ->
+ start_processes(),
+ ok.
+
+ptc1(_Config) ->
+ start_processes(),
+ ok.
+
+ptc2(_Config) ->
+ start_processes(),
+ ok.
+
+
+%%%-----------------------------------------------------------------
+%%%
+
+start_processes() ->
+ Init = fun() ->
+ process_flag(trap_exit, true),
+ do_spawn(fun() -> receive _ -> ok end end),
+ receive _ ->
+ ok
+ end
+ end,
+ do_spawn(Init).
+
+do_spawn(Fun) ->
+ Pid = spawn(Fun),
+ ct:log("Process ~w started with group leader ~w",
+ [Pid,element(2, process_info(Pid, group_leader))]),
+ Pid.
diff --git a/lib/common_test/test/ct_auto_clean_SUITE_data/cth_auto_clean.erl b/lib/common_test/test/ct_auto_clean_SUITE_data/cth_auto_clean.erl
new file mode 100644
index 0000000000..137c81969d
--- /dev/null
+++ b/lib/common_test/test/ct_auto_clean_SUITE_data/cth_auto_clean.erl
@@ -0,0 +1,214 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(cth_auto_clean).
+
+%% CTH Callbacks
+-export([id/1, init/2,
+ pre_init_per_suite/3, post_init_per_suite/4,
+ pre_end_per_suite/3, post_end_per_suite/4,
+ pre_init_per_group/4, post_init_per_group/5,
+ pre_end_per_group/4, post_end_per_group/5,
+ pre_init_per_testcase/4, post_init_per_testcase/5,
+ pre_end_per_testcase/4, post_end_per_testcase/5]).
+
+id(_Opts) ->
+ ?MODULE.
+
+init(?MODULE, _Opts) ->
+ ok.
+
+pre_init_per_suite(_Suite, Config, State) ->
+ identify(?FUNCTION_NAME),
+ SharedGL = test_server_io:get_gl(true),
+ SharedGL = find_and_kill(),
+ do_until(fun() -> ct:remaining_test_procs() end, {[],SharedGL,[]}),
+ %% get status of processes at startup, to be compared with end result
+ {Config, [{all_procs,processes()} | State]}.
+
+post_init_per_suite(_Suite, _Config, Return, State) ->
+ identify(?FUNCTION_NAME),
+ SharedGL = find_and_kill(),
+ do_until(fun() -> ct:remaining_test_procs() end, {[],SharedGL,[]}),
+ {Return, State}.
+
+pre_end_per_suite(_Suite, Config, State) ->
+ identify(?FUNCTION_NAME),
+ SharedGL = find_and_kill(),
+ do_until(fun() -> ct:remaining_test_procs() end, {[],SharedGL,[]}),
+ {Config, State}.
+
+post_end_per_suite(_Suite, _Config, Return, State) ->
+ identify(?FUNCTION_NAME),
+ SharedGL = find_and_kill(),
+ do_until(fun() -> ct:remaining_test_procs() end, {[],SharedGL,[]}),
+ AllProcs = processes(),
+ Remaining = AllProcs--proplists:get_value(all_procs, State),
+ ct:pal("Final remaining processes = ~p", [Remaining]),
+ %% only the end_per_suite process shoud remain at this point!
+ Remaining = [self()],
+ {Return, State}.
+
+pre_init_per_group(_Suite, _Group, Config, State) ->
+ identify(?FUNCTION_NAME),
+ SharedGL = find_and_kill(procs_and_gls),
+ do_until(fun() -> ct:remaining_test_procs() end, {[],SharedGL,[]}),
+ {Config, State}.
+
+post_init_per_group(_Suite, _Group, _Config, Result, State) ->
+ identify(?FUNCTION_NAME),
+ SharedGL = find_and_kill(procs_and_gls),
+ do_until(fun() -> ct:remaining_test_procs() end, {[],SharedGL,[]}),
+ {Result, State}.
+
+pre_init_per_testcase(_Suite, _TC, Config, State) ->
+ identify(?FUNCTION_NAME),
+ ThisGL = group_leader(),
+ find_and_kill(proc, ThisGL),
+ case proplists:get_value(tc_group_properties, Config) of
+ [{name,_},parallel] ->
+ timer:sleep(1000);
+ _ ->
+ do_until(fun() -> element(1,ct:remaining_test_procs()) end, [])
+ end,
+ {Config, State}.
+
+post_init_per_testcase(_Suite, _TC, Config, Return, State) ->
+ identify(?FUNCTION_NAME),
+ ThisGL = group_leader(),
+ find_and_kill(proc, ThisGL),
+ case proplists:get_value(tc_group_properties, Config) of
+ [{name,_},parallel] ->
+ timer:sleep(1000);
+ _ ->
+ do_until(fun() -> element(1,ct:remaining_test_procs()) end, [])
+ end,
+ {Return, State}.
+
+pre_end_per_testcase(_Suite, _TC, Config, State) ->
+ identify(?FUNCTION_NAME),
+ ThisGL = group_leader(),
+ find_and_kill(proc, ThisGL),
+ case proplists:get_value(tc_group_properties, Config) of
+ [{name,_},parallel] ->
+ timer:sleep(1000);
+ _ ->
+ do_until(fun() -> element(1,ct:remaining_test_procs()) end, [])
+ end,
+ {Config, State}.
+
+post_end_per_testcase(_Suite, _TC, Config, Result, State) ->
+ identify(?FUNCTION_NAME),
+ ThisGL = group_leader(),
+ find_and_kill(proc, ThisGL),
+ case proplists:get_value(tc_group_properties, Config) of
+ [{name,_},parallel] ->
+ timer:sleep(1000);
+ _ ->
+ do_until(fun() -> element(1,ct:remaining_test_procs()) end, [])
+ end,
+ {Result, State}.
+
+pre_end_per_group(_Suite, _Group, Config, State) ->
+ identify(?FUNCTION_NAME),
+ SharedGL = find_and_kill(procs_and_gls),
+ do_until(fun() -> ct:remaining_test_procs() end, {[],SharedGL,[]}),
+ {Config, State}.
+
+post_end_per_group(_Suite, _Group, _Config, Return, State) ->
+ identify(?FUNCTION_NAME),
+ SharedGL = find_and_kill(procs_and_gls),
+ do_until(fun() -> ct:remaining_test_procs() end, {[],SharedGL,[]}),
+ {Return, State}.
+
+
+%%%-----------------------------------------------------------------
+%%% HELP FUNCTIONS
+%%%-----------------------------------------------------------------
+
+identify(Func) ->
+ ct:pal("********** THIS IS ~w on ~w", [Func, self()]),
+ ok.
+
+find_and_kill() ->
+ find_and_kill(procs).
+
+find_and_kill(procs) ->
+ {Procs,SharedGL,_ParallelGLs} = ct:remaining_test_procs(),
+ ct:pal("Remaining test processes = ~p", [pi(Procs)]),
+ [pkill(P, kill) || {P,_GL} <- Procs],
+ SharedGL;
+
+find_and_kill(procs_and_gls) ->
+ {Procs,SharedGL,GLs} = ct:remaining_test_procs(),
+ ct:pal("Remaining test processes = ~p", [pi(Procs)]),
+ [pkill(P, kill) || {P,_GL} <- Procs],
+ ct:pal("Remaining group leaders = ~p", [pi(GLs)]),
+ [pkill(GL, kill) || GL <- GLs, GL /= SharedGL],
+ SharedGL.
+
+find_and_kill(proc, ProcGL) ->
+ {Procs,SharedGL,GLs} = ct:remaining_test_procs(),
+ ct:pal("Remaining test processes = ~p", [pi(Procs++GLs)]),
+ [pkill(P, kill) || {P,GL} <- Procs, GL == ProcGL],
+ SharedGL.
+
+pi([{P,_GL}|Ps]) ->
+ pi([P|Ps]);
+pi([P|Ps]) ->
+ case node() == node(P) of
+ true ->
+ {_,GL} = process_info(P,group_leader),
+ {_,CF} = process_info(P,current_function),
+ {_,IC} = process_info(P,initial_call),
+ {_,D} = process_info(P,dictionary),
+ Shared = test_server_io:get_gl(true),
+ User = whereis(user),
+ if (GL /= P) and (GL /= Shared) and (GL /= User) ->
+ [{P,GL,CF,IC,D} | pi([GL|Ps])];
+ true ->
+ [{P,GL,CF,IC,D} | pi(Ps)]
+ end;
+ false ->
+ pi(Ps)
+ end;
+pi([]) ->
+ [].
+
+do_until(Fun, Until) ->
+ io:format("Will do until ~p~n", [Until]),
+ do_until(Fun, Until, 1000).
+
+do_until(_, Until, 0) ->
+ io:format("Couldn't get ~p~n", [Until]),
+ exit({not_reached,Until});
+
+do_until(Fun, Until, N) ->
+ case Fun() of
+ Until ->
+ ok;
+ _Tmp ->
+ do_until(Fun, Until, N-1)
+ end.
+
+pkill(P, How) ->
+ ct:pal("KILLING ~w NOW!", [P]),
+ exit(P, How).
+