aboutsummaryrefslogtreecommitdiffstats
path: root/lib/common_test/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/common_test/src')
-rw-r--r--lib/common_test/src/Makefile4
-rw-r--r--lib/common_test/src/ct.erl6
-rw-r--r--lib/common_test/src/ct_framework.erl224
-rw-r--r--lib/common_test/src/ct_hooks.erl305
-rw-r--r--lib/common_test/src/ct_hooks_lock.erl132
-rw-r--r--lib/common_test/src/ct_run.erl130
-rw-r--r--lib/common_test/src/ct_testspec.erl18
-rw-r--r--lib/common_test/src/ct_util.erl35
-rw-r--r--lib/common_test/src/ct_util.hrl1
9 files changed, 761 insertions, 94 deletions
diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile
index 027667e6b0..378a7ba08c 100644
--- a/lib/common_test/src/Makefile
+++ b/lib/common_test/src/Makefile
@@ -67,7 +67,9 @@ MODULES= \
ct_config \
ct_config_plain \
ct_config_xml \
- ct_slave
+ ct_slave \
+ ct_hooks\
+ ct_hooks_lock
TARGET_MODULES= $(MODULES:%=$(EBIN)/%)
diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl
index 405dc40c8b..b0a92dcc15 100644
--- a/lib/common_test/src/ct.erl
+++ b/lib/common_test/src/ct.erl
@@ -148,7 +148,8 @@ run(TestDirs) ->
%%% {auto_compile,Bool} | {multiply_timetraps,M} | {scale_timetraps,Bool} |
%%% {repeat,N} | {duration,DurTime} | {until,StopTime} |
%%% {force_stop,Bool} | {decrypt,DecryptKeyOrFile} |
-%%% {refresh_logs,LogDir} | {basic_html,Bool}
+%%% {refresh_logs,LogDir} | {basic_html,Bool} |
+%%% {ct_hooks, CTHs}
%%% TestDirs = [string()] | string()
%%% Suites = [string()] | string()
%%% Cases = [atom()] | atom()
@@ -176,6 +177,9 @@ run(TestDirs) ->
%%% DecryptKeyOrFile = {key,DecryptKey} | {file,DecryptFile}
%%% DecryptKey = string()
%%% DecryptFile = string()
+%%% CTHs = [CTHModule | {CTHModule, CTHInitArgs}]
+%%% CTHModule = atom()
+%%% CTHInitArgs = term()
%%% Result = [TestResult] | {error,Reason}
%%% @doc Run tests as specified by the combination of options in <code>Opts</code>.
%%% The options are the same as those used with the
diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl
index f2ca023cff..b61eda7152 100644
--- a/lib/common_test/src/ct_framework.erl
+++ b/lib/common_test/src/ct_framework.erl
@@ -24,7 +24,7 @@
-module(ct_framework).
--export([init_tc/3, end_tc/3, get_suite/2, report/2, warn/1]).
+-export([init_tc/3, end_tc/4, get_suite/2, report/2, warn/1]).
-export([error_notification/4]).
-export([overview_html_header/1]).
@@ -207,7 +207,7 @@ init_tc2(Mod,Func,SuiteInfo,MergeResult,Config,DoInit) ->
{skip,{require_failed_in_suite0,Reason}};
{error,Reason} ->
{auto_skip,{require_failed,Reason}};
- FinalConfig ->
+ {ok, FinalConfig} ->
case MergeResult of
{error,Reason} ->
%% suite0 configure finished now, report that
@@ -216,13 +216,25 @@ init_tc2(Mod,Func,SuiteInfo,MergeResult,Config,DoInit) ->
_ ->
case get('$test_server_framework_test') of
undefined ->
- FinalConfig;
+ ct_suite_init(Mod, FuncSpec, FinalConfig);
Fun ->
- Fun(init_tc, FinalConfig)
+ case Fun(init_tc, FinalConfig) of
+ NewConfig when is_list(NewConfig) ->
+ {ok,NewConfig};
+ Else ->
+ Else
+ end
end
end
end.
-
+
+ct_suite_init(Mod, Func, [Config]) when is_list(Config) ->
+ case ct_hooks:init_tc( Mod, Func, Config) of
+ NewConfig when is_list(NewConfig) ->
+ {ok, [NewConfig]};
+ Else ->
+ Else
+ end.
add_defaults(Mod,Func,FuncInfo,DoInit) ->
case (catch Mod:suite()) of
@@ -239,7 +251,9 @@ add_defaults(Mod,Func,FuncInfo,DoInit) ->
(_) -> false
end, SuiteInfo) of
true ->
- SuiteInfo1 = merge_with_suite_defaults(Mod,SuiteInfo),
+ SuiteInfoNoCTH =
+ lists:keydelete(ct_hooks,1,SuiteInfo),
+ SuiteInfo1 = merge_with_suite_defaults(Mod,SuiteInfoNoCTH),
case add_defaults1(Mod,Func,FuncInfo,SuiteInfo1,DoInit) of
Error = {error,_} -> {SuiteInfo1,Error};
MergedInfo -> {SuiteInfo1,MergedInfo}
@@ -362,6 +376,8 @@ configure([{timetrap,off}|Rest],Info,SuiteInfo,Scope,Config) ->
configure([{timetrap,Time}|Rest],Info,SuiteInfo,Scope,Config) ->
Dog = test_server:timetrap(Time),
configure(Rest,Info,SuiteInfo,Scope,[{watchdog,Dog}|Config]);
+configure([{ct_hooks, Hook} | Rest], Info, SuiteInfo, Scope, Config) ->
+ configure(Rest, Info, SuiteInfo, Scope, [{ct_hooks, Hook} | Config]);
configure([_|Rest],Info,SuiteInfo,Scope,Config) ->
configure(Rest,Info,SuiteInfo,Scope,Config);
configure([],_,_,_,Config) ->
@@ -418,14 +434,14 @@ try_set_default(Name,Key,Info,Where) ->
%%%
%%% @doc Test server framework callback, called by the test_server
%%% when a test case is finished.
-end_tc(?MODULE,error_in_suite,_) -> % bad start!
+end_tc(?MODULE,error_in_suite,_, _) -> % bad start!
ok;
-end_tc(Mod,Func,{TCPid,Result,[Args]}) when is_pid(TCPid) ->
- end_tc(Mod,Func,TCPid,Result,Args);
-end_tc(Mod,Func,{Result,[Args]}) ->
- end_tc(Mod,Func,self(),Result,Args).
+end_tc(Mod,Func,{TCPid,Result,[Args]}, Return) when is_pid(TCPid) ->
+ end_tc(Mod,Func,TCPid,Result,Args,Return);
+end_tc(Mod,Func,{Result,[Args]}, Return) ->
+ end_tc(Mod,Func,self(),Result,Args,Return).
-end_tc(Mod,Func,TCPid,Result,Args) ->
+end_tc(Mod,Func,TCPid,Result,Args,Return) ->
case lists:keysearch(watchdog,1,Args) of
{value,{watchdog,Dog}} -> test_server:timetrap_cancel(Dog);
false -> ok
@@ -448,8 +464,10 @@ end_tc(Mod,Func,TCPid,Result,Args) ->
{_,GroupName,_Props} = Group ->
case lists:keysearch(save_config,1,Args) of
{value,{save_config,SaveConfig}} ->
- ct_util:save_suite_data(last_saved_config,
- {Mod,{group,GroupName}},SaveConfig),
+ ct_util:save_suite_data(
+ last_saved_config,
+ {Mod,{group,GroupName}},
+ SaveConfig),
Group;
false ->
Group
@@ -466,12 +484,33 @@ end_tc(Mod,Func,TCPid,Result,Args) ->
end,
ct_util:reset_silent_connections(),
- %% send sync notification so that event handlers may print
- %% in the log file before it gets closed
- ct_event:sync_notify(#event{name=tc_done,
- node=node(),
- data={Mod,FuncSpec,tag(Result)}}),
- case Result of
+ case get('$test_server_framework_test') of
+ undefined ->
+ {FinalResult,FinalNotify} =
+ case ct_hooks:end_tc(
+ Mod, FuncSpec, Args, Result, Return) of
+ '$ct_no_change' ->
+ {FinalResult = ok,Result};
+ FinalResult ->
+ {FinalResult,FinalResult}
+ end,
+ % send sync notification so that event handlers may print
+ % in the log file before it gets closed
+ ct_event:sync_notify(#event{name=tc_done,
+ node=node(),
+ data={Mod,FuncSpec,
+ tag_cth(FinalNotify)}});
+ Fun ->
+ % send sync notification so that event handlers may print
+ % in the log file before it gets closed
+ ct_event:sync_notify(#event{name=tc_done,
+ node=node(),
+ data={Mod,FuncSpec,tag(Result)}}),
+ FinalResult = Fun(end_tc, Return)
+ end,
+
+
+ case FinalResult of
{skip,{sequence_failed,_,_}} ->
%% ct_logs:init_tc is never called for a skipped test case
%% in a failing sequence, so neither should end_tc
@@ -490,12 +529,7 @@ end_tc(Mod,Func,TCPid,Result,Args) ->
_ ->
ok
end,
- case get('$test_server_framework_test') of
- undefined ->
- ok;
- Fun ->
- Fun(end_tc, ok)
- end.
+ FinalResult.
%% {error,Reason} | {skip,Reason} | {timetrap_timeout,TVal} |
%% {testcase_aborted,Reason} | testcase_aborted_or_killed |
@@ -511,6 +545,21 @@ tag(E = testcase_aborted_or_killed) ->
tag(Other) ->
Other.
+tag_cth({STag,Reason}) when STag == skip; STag == skipped ->
+ {skipped,Reason};
+tag_cth({fail, Reason}) ->
+ {failed, {error,Reason}};
+tag_cth(E = {ETag,_}) when ETag == error; ETag == 'EXIT';
+ ETag == timetrap_timeout;
+ ETag == testcase_aborted ->
+ {failed,E};
+tag_cth(E = testcase_aborted_or_killed) ->
+ {failed,E};
+tag_cth(List) when is_list(List) ->
+ ok;
+tag_cth(Other) ->
+ Other.
+
%%%-----------------------------------------------------------------
%%% @spec error_notification(Mod,Func,Args,Error) -> ok
%%% Mod = atom()
@@ -694,12 +743,12 @@ get_suite(Mod, Group={conf,Props,_Init,TCs,_End}) ->
%% init/end functions for top groups will be executed
case catch proplists:get_value(name, element(2, hd(ConfTests))) of
Name -> % top group
- ConfTests;
+ delete_subs(ConfTests, ConfTests);
_ ->
[]
end;
false ->
- ConfTests
+ delete_subs(ConfTests, ConfTests)
end
end;
_ ->
@@ -716,9 +765,25 @@ get_suite(Mod, Name) ->
find_groups(Mod, Name, TCs, GroupDefs) ->
Found = find(Mod, Name, TCs, GroupDefs, [], GroupDefs, false),
Trimmed = trim(Found),
- delete_subs(Trimmed, Trimmed).
-
-find(Mod, all, _TCs, [{Name,Props,Tests} | Gs], Known, Defs, _) ->
+ %% I cannot find a reason to why this function is called,
+ %% It deletes any group which is referenced in any other
+ %% group. i.e.
+ %% groups() ->
+ %% [{test, [], [testcase1]},
+ %% {testcases, [], [{group, test}]}].
+ %% Would be changed to
+ %% groups() ->
+ %% [{testcases, [], [testcase1]}].
+ %% instead of what I believe is correct:
+ %% groups() ->
+ %% [{test, [], [testcase1]},
+ %% {testcases, [], [testcase1]}].
+ %% Have to double check with peppe
+ delete_subs(Trimmed, Trimmed),
+ Trimmed.
+
+find(Mod, all, _TCs, [{Name,Props,Tests} | Gs], Known, Defs, _)
+ when is_atom(Name), is_list(Props), is_list(Tests) ->
cyclic_test(Mod, Name, Known),
[make_conf(Mod, Name, Props,
find(Mod, all, all, Tests, [Name | Known], Defs, true)) |
@@ -740,8 +805,8 @@ find(Mod, Name, TCs, [{Name,Props,Tests} | _Gs], Known, Defs, false)
find(Mod, Name, TCs, [{Name1,Props,Tests} | Gs], Known, Defs, false)
when is_atom(Name1), is_list(Props), is_list(Tests) ->
cyclic_test(Mod, Name1, Known),
- [make_conf(Mod, Name1, Props,
- find(Mod, Name, TCs, Tests, [Name1 | Known], Defs, false)) |
+ [make_conf(Mod,Name1,Props,
+ find(Mod, Name, TCs, Tests, [Name1 | Known], Defs, false)) |
find(Mod, Name, TCs, Gs, [], Defs, false)];
find(Mod, Name, _TCs, [{Name,_Props,_Tests} | _Gs], _Known, _Defs, true)
@@ -757,17 +822,31 @@ find(Mod, Name, all, [{Name1,Props,Tests} | Gs], Known, Defs, true)
find(Mod, Name, all, Tests, [Name1 | Known], Defs, true)) |
find(Mod, Name, all, Gs, [], Defs, true)];
-find(Mod, Name, TCs, [{group,Name1} | Gs], Known, Defs, Found) when is_atom(Name1) ->
+find(Mod, Name, TCs, [{group,Name1} | Gs], Known, Defs, Found)
+ when is_atom(Name1) ->
find(Mod, Name, TCs, [expand(Mod, Name1, Defs) | Gs], Known, Defs, Found);
+%% Undocumented remote group feature, use with caution
+find(Mod, Name, TCs, [{group, ExtMod, ExtGrp} | Gs], Known, Defs, true)
+ when is_atom(ExtMod), is_atom(ExtGrp) ->
+ ExternalDefs = ExtMod:groups(),
+ ExternalTCs = find(ExtMod, ExtGrp, TCs, [{group, ExtGrp}],
+ [], ExternalDefs, false),
+ ExternalTCs ++ find(Mod, Name, TCs, Gs, Known, Defs, true);
+
find(Mod, Name, TCs, [{Name1,Tests} | Gs], Known, Defs, Found)
when is_atom(Name1), is_list(Tests) ->
find(Mod, Name, TCs, [{Name1,[],Tests} | Gs], Known, Defs, Found);
-find(Mod, Name, TCs, [TC | Gs], Known, Defs, false) when is_atom(TC) ->
+find(Mod, Name, TCs, [_TC | Gs], Known, Defs, false) ->
find(Mod, Name, TCs, Gs, Known, Defs, false);
find(Mod, Name, TCs, [TC | Gs], Known, Defs, true) when is_atom(TC) ->
+ [{Mod, TC} | find(Mod, Name, TCs, Gs, Known, Defs, true)];
+
+find(Mod, Name, TCs, [{ExternalTC, Case} = TC | Gs], Known, Defs, true)
+ when is_atom(ExternalTC),
+ is_atom(Case) ->
[TC | find(Mod, Name, TCs, Gs, Known, Defs, true)];
find(Mod, _Name, _TCs, [BadTerm | _Gs], Known, _Defs, _Found) ->
@@ -787,7 +866,7 @@ find(_Mod, _Name, _TCs, [], _Known, _Defs, false) ->
find(_Mod, _Name, _TCs, [], _Known, _Defs, _Found) ->
[].
-delete_subs([Conf | Confs], All) ->
+delete_subs([{conf, _,_,_,_} = Conf | Confs], All) ->
All1 = delete_conf(Conf, All),
case is_sub(Conf, All1) of
true ->
@@ -795,7 +874,8 @@ delete_subs([Conf | Confs], All) ->
false ->
delete_subs(Confs, All)
end;
-
+delete_subs([_Else | Confs], All) ->
+ delete_subs(Confs, All);
delete_subs([], All) ->
All.
@@ -887,7 +967,9 @@ make_all_conf(Mod) ->
[] ->
{error,{invalid_group_spec,Mod}};
ConfTests ->
- [{conf,Props,Init,all,End} || {conf,Props,Init,_,End} <- ConfTests]
+ [{conf,Props,Init,all,End} ||
+ {conf,Props,Init,_,End}
+ <- delete_subs(ConfTests, ConfTests)]
end
end.
@@ -933,31 +1015,11 @@ get_all(Mod, ConfTests) ->
[{?MODULE,error_in_suite,[[{error,What}]]}];
SeqsAndTCs ->
%% expand group references in all() using ConfTests
- Expand =
- fun({group,Name}) ->
- FindConf =
- fun({conf,Props,_,_,_}) ->
- case proplists:get_value(name, Props) of
- Name -> true;
- _ -> false
- end
- end,
- case lists:filter(FindConf, ConfTests) of
- [ConfTest|_] ->
- ConfTest;
- [] ->
- E = "Invalid reference to group "++
- atom_to_list(Name)++" in "++
- atom_to_list(Mod)++":all/0",
- throw({error,list_to_atom(E)})
- end;
- (SeqOrTC) -> SeqOrTC
- end,
- case catch lists:map(Expand, SeqsAndTCs) of
+ case catch expand_groups(SeqsAndTCs, ConfTests, Mod) of
{error,_} = Error ->
[{?MODULE,error_in_suite,[[Error]]}];
Tests ->
- Tests
+ delete_subs(Tests, Tests)
end
end;
Skip = {skip,_Reason} ->
@@ -968,6 +1030,30 @@ get_all(Mod, ConfTests) ->
[{?MODULE,error_in_suite,[[{error,Reason}]]}]
end.
+expand_groups([H | T], ConfTests, Mod) ->
+ [expand_groups(H, ConfTests, Mod) | expand_groups(T, ConfTests, Mod)];
+expand_groups([], _ConfTests, _Mod) ->
+ [];
+expand_groups({group,Name}, ConfTests, Mod) ->
+ FindConf =
+ fun({conf,Props,_,_,_}) ->
+ case proplists:get_value(name, Props) of
+ Name -> true;
+ _ -> false
+ end
+ end,
+ case lists:filter(FindConf, ConfTests) of
+ [ConfTest|_] ->
+ expand_groups(ConfTest, ConfTests, Mod);
+ [] ->
+ E = "Invalid reference to group "++
+ atom_to_list(Name)++" in "++
+ atom_to_list(Mod)++":all/0",
+ throw({error,list_to_atom(E)})
+ end;
+expand_groups(SeqOrTC, _ConfTests, _Mod) ->
+ SeqOrTC.
+
%%!============================================================
%%! The support for sequences by means of using sequences/0
@@ -1137,6 +1223,18 @@ report(What,Data) ->
ok;
tc_done ->
{_Suite,Case,Result} = Data,
+ case Result of
+ {failed, _} ->
+ ct_hooks:on_tc_fail(What, Data);
+ {skipped,{failed,{_,init_per_testcase,_}}} ->
+ ct_hooks:on_tc_skip(tc_auto_skip, Data);
+ {skipped,{require_failed,_}} ->
+ ct_hooks:on_tc_skip(tc_auto_skip, Data);
+ {skipped,_} ->
+ ct_hooks:on_tc_skip(tc_user_skip, Data);
+ _Else ->
+ ok
+ end,
case {Case,Result} of
{init_per_suite,_} ->
ok;
@@ -1154,8 +1252,8 @@ report(What,Data) ->
add_to_stats(auto_skipped);
{_,{skipped,_}} ->
add_to_stats(user_skipped);
- {_,{FailOrSkip,_Reason}} ->
- add_to_stats(FailOrSkip)
+ {_,{SkipOrFail,_Reason}} ->
+ add_to_stats(SkipOrFail)
end;
tc_user_skip ->
%% test case specified as skipped in testspec
@@ -1163,6 +1261,7 @@ report(What,Data) ->
ct_event:sync_notify(#event{name=tc_user_skip,
node=node(),
data=Data}),
+ ct_hooks:on_tc_skip(What, Data),
add_to_stats(user_skipped);
tc_auto_skip ->
%% test case skipped because of error in init_per_suite
@@ -1175,6 +1274,7 @@ report(What,Data) ->
ct_event:sync_notify(#event{name=tc_auto_skip,
node=node(),
data=Data}),
+ ct_hooks:on_tc_skip(What, Data),
if Case /= end_per_suite, Case /= end_per_group ->
add_to_stats(auto_skipped);
true ->
diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl
new file mode 100644
index 0000000000..77b7566d9e
--- /dev/null
+++ b/lib/common_test/src/ct_hooks.erl
@@ -0,0 +1,305 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2010. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%% @doc Common Test Framework test execution control module.
+%%%
+%%% <p>This module is a proxy for calling and handling common test hooks.</p>
+
+-module(ct_hooks).
+
+%% API Exports
+-export([init/1]).
+-export([init_tc/3]).
+-export([end_tc/5]).
+-export([terminate/1]).
+-export([on_tc_skip/2]).
+-export([on_tc_fail/2]).
+
+-type proplist() :: [{atom(),term()}].
+
+%% If you change this, remember to update ct_util:look -> stop clause as well.
+-define(config_name, ct_hooks).
+
+%% -------------------------------------------------------------------------
+%% API Functions
+%% -------------------------------------------------------------------------
+
+%% @doc Called before any suites are started
+-spec init(State :: term()) -> ok |
+ {error, Reason :: term()}.
+init(Opts) ->
+ call([{Hook, call_id, undefined} || Hook <- get_new_hooks(Opts)],
+ ok, init, []).
+
+
+%% @doc Called after all suites are done.
+-spec terminate(Hooks :: term()) ->
+ ok.
+terminate(Hooks) ->
+ call([{HookId, fun call_terminate/3} || {HookId,_,_} <- Hooks],
+ ct_hooks_terminate_dummy, terminate, Hooks),
+ ok.
+
+%% @doc Called as each test case is started. This includes all configuration
+%% tests.
+-spec init_tc(Mod :: atom(), Func :: atom(), Args :: list()) ->
+ NewConfig :: proplist() |
+ {skip, Reason :: term()} |
+ {auto_skip, Reason :: term()} |
+ {fail, Reason :: term()}.
+init_tc(ct_framework, _Func, Args) ->
+ Args;
+init_tc(Mod, init_per_suite, Config) ->
+ Info = case catch proplists:get_value(ct_hooks, Mod:suite()) of
+ List when is_list(List) ->
+ [{ct_hooks,List}];
+ _Else ->
+ []
+ end,
+ call(fun call_generic/3, Config ++ Info, [pre_init_per_suite, Mod]);
+init_tc(Mod, end_per_suite, Config) ->
+ call(fun call_generic/3, Config, [pre_end_per_suite, Mod]);
+init_tc(Mod, {init_per_group, GroupName, Opts}, Config) ->
+ maybe_start_locker(Mod, GroupName, Opts),
+ call(fun call_generic/3, Config, [pre_init_per_group, GroupName]);
+init_tc(_Mod, {end_per_group, GroupName, _}, Config) ->
+ call(fun call_generic/3, Config, [pre_end_per_group, GroupName]);
+init_tc(_Mod, TC, Config) ->
+ call(fun call_generic/3, Config, [pre_init_per_testcase, TC]).
+
+%% @doc Called as each test case is completed. This includes all configuration
+%% tests.
+-spec end_tc(Mod :: atom(),
+ Func :: atom(),
+ Args :: list(),
+ Result :: term(),
+ Resturn :: term()) ->
+ NewConfig :: proplist() |
+ {skip, Reason :: term()} |
+ {auto_skip, Reason :: term()} |
+ {fail, Reason :: term()} |
+ ok | '$ct_no_change'.
+end_tc(ct_framework, _Func, _Args, Result, _Return) ->
+ Result;
+
+end_tc(Mod, init_per_suite, Config, _Result, Return) ->
+ call(fun call_generic/3, Return, [post_init_per_suite, Mod, Config],
+ '$ct_no_change');
+
+end_tc(Mod, end_per_suite, Config, Result, _Return) ->
+ call(fun call_generic/3, Result, [post_end_per_suite, Mod, Config],
+ '$ct_no_change');
+
+end_tc(_Mod, {init_per_group, GroupName, _}, Config, _Result, Return) ->
+ call(fun call_generic/3, Return, [post_init_per_group, GroupName, Config],
+ '$ct_no_change');
+
+end_tc(Mod, {end_per_group, GroupName, Opts}, Config, Result, _Return) ->
+ Res = call(fun call_generic/3, Result,
+ [post_end_per_group, GroupName, Config], '$ct_no_change'),
+ maybe_stop_locker(Mod, GroupName,Opts),
+ Res;
+
+end_tc(_Mod, TC, Config, Result, _Return) ->
+ call(fun call_generic/3, Result, [post_end_per_testcase, TC, Config],
+ '$ct_no_change').
+
+on_tc_skip(How, {_Suite, Case, Reason}) ->
+ call(fun call_cleanup/3, {How, Reason}, [on_tc_skip, Case]).
+
+on_tc_fail(_How, {_Suite, Case, Reason}) ->
+ call(fun call_cleanup/3, Reason, [on_tc_fail, Case]).
+
+%% -------------------------------------------------------------------------
+%% Internal Functions
+%% -------------------------------------------------------------------------
+call_id(Mod, Config, Meta) when is_atom(Mod) ->
+ call_id({Mod, []}, Config, Meta);
+call_id({Mod, Opts}, Config, Scope) ->
+ Id = catch_apply(Mod,id,[Opts], make_ref()),
+ {Config, {Id, scope(Scope), {Mod, {Id,Opts}}}}.
+
+call_init({Mod,{Id,Opts}},Config,_Meta) ->
+ NewState = Mod:init(Id, Opts),
+ {Config, {Mod, NewState}}.
+
+call_terminate({Mod, State}, _, _) ->
+ catch_apply(Mod,terminate,[State], ok),
+ {[],{Mod,State}}.
+
+call_cleanup({Mod, State}, Reason, [Function | Args]) ->
+ NewState = catch_apply(Mod,Function, Args ++ [Reason, State],
+ State),
+ {Reason, {Mod, NewState}}.
+
+call_generic({Mod, State}, Value, [Function | Args]) ->
+ {NewValue, NewState} = catch_apply(Mod, Function, Args ++ [Value, State],
+ {Value,State}),
+ {NewValue, {Mod, NewState}}.
+
+%% Generic call function
+call(Fun, Config, Meta) ->
+ maybe_lock(),
+ Hooks = get_hooks(),
+ Res = call([{HookId,Fun} || {HookId,_, _} <- Hooks] ++
+ get_new_hooks(Config, Fun),
+ remove(?config_name,Config), Meta, Hooks),
+ maybe_unlock(),
+ Res.
+
+call(Fun, Config, Meta, NoChangeRet) when is_function(Fun) ->
+ case call(Fun,Config,Meta) of
+ Config -> NoChangeRet;
+ NewReturn -> NewReturn
+ end;
+
+call([{Hook, call_id, NextFun} | Rest], Config, Meta, Hooks) ->
+ try
+ {Config, {NewId, _, _} = NewHook} = call_id(Hook, Config, Meta),
+ {NewHooks, NewRest} =
+ case lists:keyfind(NewId, 1, Hooks) of
+ false when NextFun =:= undefined ->
+ {Hooks ++ [NewHook],
+ [{NewId, fun call_init/3} | Rest]};
+ ExistingHook when is_tuple(ExistingHook) ->
+ {Hooks, Rest};
+ _ ->
+ {Hooks ++ [NewHook],
+ [{NewId, fun call_init/3},{NewId,NextFun} | Rest]}
+ end,
+ call(NewRest, Config, Meta, NewHooks)
+ catch Error:Reason ->
+ Trace = erlang:get_stacktrace(),
+ ct_logs:log("Suite Hook","Failed to start a CTH: ~p:~p",
+ [Error,{Reason,Trace}]),
+ call([], {fail,"Failed to start CTH"
+ ", see the CT Log for details"}, Meta, Hooks)
+ end;
+call([{HookId, Fun} | Rest], Config, Meta, Hooks) ->
+ try
+ {_,Scope,ModState} = lists:keyfind(HookId, 1, Hooks),
+ {NewConf, NewHookInfo} = Fun(ModState, Config, Meta),
+ NewCalls = get_new_hooks(NewConf, Fun),
+ NewHooks = lists:keyreplace(HookId, 1, Hooks, {HookId, Scope, NewHookInfo}),
+ call(NewCalls ++ Rest, remove(?config_name, NewConf), Meta,
+ terminate_if_scope_ends(HookId, Meta, NewHooks))
+ catch throw:{error_in_cth_call,Reason} ->
+ call(Rest, {fail, Reason}, Meta,
+ terminate_if_scope_ends(HookId, Meta, Hooks))
+ end;
+call([], Config, _Meta, Hooks) ->
+ save_suite_data_async(Hooks),
+ Config.
+
+remove(Key,List) when is_list(List) ->
+ [Conf || Conf <- List, is_tuple(Conf) =:= false
+ orelse element(1, Conf) =/= Key];
+remove(_, Else) ->
+ Else.
+
+%% Translate scopes, i.e. init_per_group,group1 -> end_per_group,group1 etc
+scope([pre_init_per_testcase, TC|_]) ->
+ [post_end_per_testcase, TC];
+scope([pre_init_per_group, GroupName|_]) ->
+ [post_end_per_group, GroupName];
+scope([post_init_per_group, GroupName|_]) ->
+ [post_end_per_group, GroupName];
+scope([pre_init_per_suite, SuiteName|_]) ->
+ [post_end_per_suite, SuiteName];
+scope([post_init_per_suite, SuiteName|_]) ->
+ [post_end_per_suite, SuiteName];
+scope(init) ->
+ none.
+
+terminate_if_scope_ends(HookId, [Function,Tag|T], Hooks) when T =/= [] ->
+ terminate_if_scope_ends(HookId,[Function,Tag],Hooks);
+terminate_if_scope_ends(HookId, Function, Hooks) ->
+ case lists:keyfind(HookId, 1, Hooks) of
+ {HookId, Function, _ModState} = Hook ->
+ terminate([Hook]),
+ lists:keydelete(HookId, 1, Hooks);
+ _ ->
+ Hooks
+ end.
+
+%% Fetch hook functions
+get_new_hooks(Config, Fun) ->
+ lists:foldl(fun(NewHook, Acc) ->
+ [{NewHook, call_id, Fun} | Acc]
+ end, [], get_new_hooks(Config)).
+
+get_new_hooks(Config) when is_list(Config) ->
+ lists:flatmap(fun({?config_name, HookConfigs}) ->
+ HookConfigs;
+ (_) ->
+ []
+ end, Config);
+get_new_hooks(_Config) ->
+ [].
+
+save_suite_data_async(Hooks) ->
+ ct_util:save_suite_data_async(?config_name, Hooks).
+
+get_hooks() ->
+ ct_util:read_suite_data(?config_name).
+
+catch_apply(M,F,A, Default) ->
+ try
+ apply(M,F,A)
+ catch error:Reason ->
+ case erlang:get_stacktrace() of
+ %% Return the default if it was the CTH module which did not have the function.
+ [{M,F,A}|_] when Reason == undef ->
+ Default;
+ Trace ->
+ ct_logs:log("Suite Hook","Call to CTH failed: ~p:~p",
+ [error,{Reason,Trace}]),
+ throw({error_in_cth_call,
+ lists:flatten(
+ io_lib:format("~p:~p/~p CTH call failed",
+ [M,F,length(A)]))})
+ end
+ end.
+
+
+%% We need to lock around the state for parallel groups only. This is because
+%% we will get several processes reading and writing the state for a single
+%% cth at the same time.
+maybe_start_locker(Mod,GroupName,Opts) ->
+ case lists:member(parallel,Opts) of
+ true ->
+ {ok, _Pid} = ct_hooks_lock:start({Mod,GroupName});
+ false ->
+ ok
+ end.
+
+maybe_stop_locker(Mod,GroupName,Opts) ->
+ case lists:member(parallel,Opts) of
+ true ->
+ stopped = ct_hooks_lock:stop({Mod,GroupName});
+ false ->
+ ok
+ end.
+
+
+maybe_lock() ->
+ locked = ct_hooks_lock:request().
+
+maybe_unlock() ->
+ unlocked = ct_hooks_lock:release().
diff --git a/lib/common_test/src/ct_hooks_lock.erl b/lib/common_test/src/ct_hooks_lock.erl
new file mode 100644
index 0000000000..98794201bb
--- /dev/null
+++ b/lib/common_test/src/ct_hooks_lock.erl
@@ -0,0 +1,132 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2010. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%% @doc Common Test Framework test execution control module.
+%%%
+%%% <p>This module is a proxy for calling and handling locks in
+%%% common test hooks.</p>
+
+-module(ct_hooks_lock).
+
+-behaviour(gen_server).
+
+%% API
+-export([start/1, stop/1, request/0, release/0]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+-define(SERVER, ?MODULE).
+
+-record(state, { id, locked = false, requests = [] }).
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+
+%% @doc Starts the server
+start(Id) ->
+ case gen_server:start({local, ?SERVER}, ?MODULE, Id, []) of
+ {error,{already_started, Pid}} ->
+ {ok,Pid};
+ Else ->
+ Else
+ end.
+
+stop(Id) ->
+ try
+ gen_server:call(?SERVER, {stop,Id})
+ catch exit:{noproc,_} ->
+ stopped
+ end.
+
+request() ->
+ try
+ gen_server:call(?SERVER,{request,self()},infinity)
+ catch exit:{noproc,_} ->
+ locked
+ end.
+
+release() ->
+ try
+ gen_server:call(?SERVER,{release,self()})
+ catch exit:{noproc,_} ->
+ unlocked
+ end.
+
+%%%===================================================================
+%%% gen_server callbacks
+%%%===================================================================
+
+%% @doc Initiates the server
+init(Id) ->
+ {ok, #state{ id = Id }}.
+
+%% @doc Handling call messages
+handle_call({stop,Id}, _From, #state{ id = Id, requests = Reqs } = State) ->
+ [gen_server:reply(Req, locker_stopped) || {Req,_ReqId} <- Reqs],
+ {stop, normal, stopped, State};
+handle_call({stop,_Id}, _From, State) ->
+ {reply, stopped, State};
+handle_call({request, Pid}, _From, #state{ locked = false,
+ requests = [] } = State) ->
+ Ref = monitor(process, Pid),
+ {reply, locked, State#state{ locked = {true, Pid, Ref}} };
+handle_call({request, Pid}, From, #state{ requests = Reqs } = State) ->
+ {noreply, State#state{ requests = Reqs ++ [{From,Pid}] }};
+handle_call({release, Pid}, _From, #state{ locked = {true, Pid, Ref},
+ requests = []} = State) ->
+ demonitor(Ref,[flush]),
+ {reply, unlocked, State#state{ locked = false }};
+handle_call({release, Pid}, _From,
+ #state{ locked = {true, Pid, Ref},
+ requests = [{NextFrom,NextPid}|Rest]} = State) ->
+ demonitor(Ref,[flush]),
+ gen_server:reply(NextFrom,locked),
+ NextRef = monitor(process, NextPid),
+ {reply,unlocked,State#state{ locked = {true, NextPid, NextRef},
+ requests = Rest } };
+handle_call({release, _Pid}, _From, State) ->
+ {reply, not_locked, State}.
+
+%% @doc Handling cast messages
+handle_cast(_Msg, State) ->
+ {noreply, State}.
+
+%% @doc Handling all non call/cast messages
+handle_info({'DOWN',Ref,process,Pid,_},
+ #state{ locked = {true, Pid, Ref},
+ requests = [{NextFrom,NextPid}|Rest] } = State) ->
+ gen_server:reply(NextFrom, locked),
+ NextRef = monitor(process, NextPid),
+ {noreply,State#state{ locked = {true, NextPid, NextRef},
+ requests = Rest } }.
+
+%% @doc This function is called by a gen_server when it is about to terminate.
+terminate(_Reason, _State) ->
+ ok.
+
+%% @doc Convert process state when code is changed
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%% -------------------------------------------------------------------------
+%% Internal Functions
+%% -------------------------------------------------------------------------
diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl
index d0e6ba5fa6..f50a46a241 100644
--- a/lib/common_test/src/ct_run.erl
+++ b/lib/common_test/src/ct_run.erl
@@ -54,6 +54,7 @@
logdir,
config = [],
event_handlers = [],
+ ct_hooks = [],
include = [],
silent_connections,
stylesheet,
@@ -171,6 +172,7 @@ script_start1(Parent, Args) ->
([]) -> true
end, false, Args),
EvHandlers = event_handler_args2opts(Args),
+ CTHooks = ct_hooks_args2opts(Args),
%% check flags and set corresponding application env variables
@@ -234,6 +236,7 @@ script_start1(Parent, Args) ->
StartOpts = #opts{label = Label, vts = Vts, shell = Shell, cover = Cover,
logdir = LogDir, event_handlers = EvHandlers,
+ ct_hooks = CTHooks,
include = IncludeDirs,
silent_connections = SilentConns,
stylesheet = Stylesheet,
@@ -305,6 +308,10 @@ script_start2(StartOpts = #opts{vts = undefined,
SpecStartOpts#opts.scale_timetraps),
AllEvHs = merge_vals([StartOpts#opts.event_handlers,
SpecStartOpts#opts.event_handlers]),
+ AllCTHooks = merge_vals(
+ [StartOpts#opts.ct_hooks,
+ SpecStartOpts#opts.ct_hooks]),
+
AllInclude = merge_vals([StartOpts#opts.include,
SpecStartOpts#opts.include]),
application:set_env(common_test, include, AllInclude),
@@ -315,6 +322,7 @@ script_start2(StartOpts = #opts{vts = undefined,
logdir = LogDir,
config = SpecStartOpts#opts.config,
event_handlers = AllEvHs,
+ ct_hooks = AllCTHooks,
include = AllInclude,
multiply_timetraps = MultTT,
scale_timetraps = ScaleTT}}
@@ -332,7 +340,8 @@ script_start2(StartOpts = #opts{vts = undefined,
{error,no_testspec_specified};
{undefined,_} -> % no testspec used
case check_and_install_configfiles(InitConfig, TheLogDir,
- Opts#opts.event_handlers) of
+ Opts#opts.event_handlers,
+ Opts#opts.ct_hooks) of
ok -> % go on read tests from start flags
script_start3(Opts#opts{config=InitConfig,
logdir=TheLogDir}, Args);
@@ -343,7 +352,8 @@ script_start2(StartOpts = #opts{vts = undefined,
%% merge config from start flags with config from testspec
AllConfig = merge_vals([InitConfig, Opts#opts.config]),
case check_and_install_configfiles(AllConfig, TheLogDir,
- Opts#opts.event_handlers) of
+ Opts#opts.event_handlers,
+ Opts#opts.ct_hooks) of
ok -> % read tests from spec
{Run,Skip} = ct_testspec:prepare_tests(Terms, node()),
do_run(Run, Skip, Opts#opts{config=AllConfig,
@@ -358,7 +368,8 @@ script_start2(StartOpts, Args) ->
InitConfig = ct_config:prepare_config_list(Args),
LogDir = which(logdir, StartOpts#opts.logdir),
case check_and_install_configfiles(InitConfig, LogDir,
- StartOpts#opts.event_handlers) of
+ StartOpts#opts.event_handlers,
+ StartOpts#opts.ct_hooks) of
ok -> % go on read tests from start flags
script_start3(StartOpts#opts{config=InitConfig,
logdir=LogDir}, Args);
@@ -366,11 +377,12 @@ script_start2(StartOpts, Args) ->
Error
end.
-check_and_install_configfiles(Configs, LogDir, EvHandlers) ->
+check_and_install_configfiles(Configs, LogDir, EvHandlers, CTHooks) ->
case ct_config:check_config_files(Configs) of
false ->
install([{config,Configs},
- {event_handler,EvHandlers}], LogDir);
+ {event_handler,EvHandlers},
+ {ct_hooks,CTHooks}], LogDir);
{value,{error,{nofile,File}}} ->
{error,{cant_read_config_file,File}};
{value,{error,{wrong_config,Message}}}->
@@ -438,11 +450,13 @@ script_start4(#opts{vts = true, config = Config, event_handlers = EvHandlers,
script_start4(#opts{label = Label, shell = true, config = Config,
event_handlers = EvHandlers,
+ ct_hooks = CTHooks,
logdir = LogDir, testspecs = Specs}, _Args) ->
%% label - used by ct_logs
application:set_env(common_test, test_label, Label),
- InstallOpts = [{config,Config},{event_handler,EvHandlers}],
+ InstallOpts = [{config,Config},{event_handler,EvHandlers},
+ {ct_hooks, CTHooks}],
if Config == [] ->
ok;
true ->
@@ -508,6 +522,7 @@ script_usage() ->
"\n\t[-stylesheet CSSFile]"
"\n\t[-cover CoverCfgFile]"
"\n\t[-event_handler EvHandler1 EvHandler2 .. EvHandlerN]"
+ "\n\t[-ct_hooks CTHook1 CTHook2 .. CTHookN]"
"\n\t[-include InclDir1 InclDir2 .. InclDirN]"
"\n\t[-no_auto_compile]"
"\n\t[-multiply_timetraps N]"
@@ -526,6 +541,7 @@ script_usage() ->
"\n\t[-stylesheet CSSFile]"
"\n\t[-cover CoverCfgFile]"
"\n\t[-event_handler EvHandler1 EvHandler2 .. EvHandlerN]"
+ "\n\t[-ct_hooks CTHook1 CTHook2 .. CTHookN]"
"\n\t[-include InclDir1 InclDir2 .. InclDirN]"
"\n\t[-no_auto_compile]"
"\n\t[-multiply_timetraps N]"
@@ -664,6 +680,9 @@ run_test1(StartOpts) ->
end, Hs))
end,
+ %% CT Hooks
+ CTHooks = get_start_opt(ct_hooks, value, [], StartOpts),
+
%% silent connections
SilentConns = get_start_opt(silent_connections,
fun(all) -> [];
@@ -733,7 +752,9 @@ run_test1(StartOpts) ->
Opts = #opts{label = Label,
cover = Cover, step = Step, logdir = LogDir, config = CfgFiles,
- event_handlers = EvHandlers, include = Include,
+ event_handlers = EvHandlers,
+ ct_hooks = CTHooks,
+ include = Include,
silent_connections = SilentConns,
stylesheet = Stylesheet,
multiply_timetraps = MultiplyTT,
@@ -784,11 +805,16 @@ run_spec_file(Relaxed,
SpecOpts#opts.event_handlers]),
AllInclude = merge_vals([Opts#opts.include,
SpecOpts#opts.include]),
+
+ AllCTHooks = merge_vals([Opts#opts.ct_hooks,
+ SpecOpts#opts.ct_hooks]),
+
application:set_env(common_test, include, AllInclude),
case check_and_install_configfiles(AllConfig,
which(logdir,LogDir),
- AllEvHs) of
+ AllEvHs,
+ AllCTHooks) of
ok ->
Opts1 = Opts#opts{label = Label,
cover = Cover,
@@ -798,7 +824,8 @@ run_spec_file(Relaxed,
include = AllInclude,
testspecs = AbsSpecs,
multiply_timetraps = MultTT,
- scale_timetraps = ScaleTT},
+ scale_timetraps = ScaleTT,
+ ct_hooks = AllCTHooks},
{Run,Skip} = ct_testspec:prepare_tests(TS, node()),
reformat_result(catch do_run(Run, Skip, Opts1, StartOpts));
{error,GCFReason} ->
@@ -808,10 +835,12 @@ run_spec_file(Relaxed,
run_prepared(Run, Skip, Opts = #opts{logdir = LogDir,
config = CfgFiles,
- event_handlers = EvHandlers},
+ event_handlers = EvHandlers,
+ ct_hooks = CTHooks},
StartOpts) ->
LogDir1 = which(logdir, LogDir),
- case check_and_install_configfiles(CfgFiles, LogDir1, EvHandlers) of
+ case check_and_install_configfiles(CfgFiles, LogDir1,
+ EvHandlers, CTHooks) of
ok ->
reformat_result(catch do_run(Run, Skip, Opts#opts{logdir = LogDir1},
StartOpts));
@@ -842,7 +871,8 @@ check_config_file(Callback, File)->
run_dir(Opts = #opts{logdir = LogDir,
config = CfgFiles,
- event_handlers = EvHandlers}, StartOpts) ->
+ event_handlers = EvHandlers,
+ ct_hooks = CTHook }, StartOpts) ->
LogDir1 = which(logdir, LogDir),
Opts1 = Opts#opts{logdir = LogDir1},
AbsCfgFiles =
@@ -863,7 +893,9 @@ run_dir(Opts = #opts{logdir = LogDir,
check_config_file(Callback, File)
end, FileList)}
end, CfgFiles),
- case install([{config,AbsCfgFiles},{event_handler,EvHandlers}], LogDir1) of
+ case install([{config,AbsCfgFiles},
+ {event_handler,EvHandlers},
+ {ct_hooks, CTHook}], LogDir1) of
ok -> ok;
{error,IReason} -> exit(IReason)
end,
@@ -968,7 +1000,8 @@ run_testspec1(TestSpec) ->
application:set_env(common_test, include, AllInclude),
LogDir1 = which(logdir,Opts#opts.logdir),
case check_and_install_configfiles(Opts#opts.config, LogDir1,
- Opts#opts.event_handlers) of
+ Opts#opts.event_handlers,
+ Opts#opts.ct_hooks) of
ok ->
Opts1 = Opts#opts{testspecs = [],
logdir = LogDir1,
@@ -986,6 +1019,7 @@ get_data_for_node(#testspec{label = Labels,
config = Cfgs,
userconfig = UsrCfgs,
event_handler = EvHs,
+ ct_hooks = CTHooks,
include = Incl,
multiply_timetraps = MTs,
scale_timetraps = STs}, Node) ->
@@ -1000,12 +1034,14 @@ get_data_for_node(#testspec{label = Labels,
ConfigFiles = [{?ct_config_txt,F} || {N,F} <- Cfgs, N==Node] ++
[CBF || {N,CBF} <- UsrCfgs, N==Node],
EvHandlers = [{H,A} || {N,H,A} <- EvHs, N==Node],
+ FiltCTHooks = [Hook || {N,Hook} <- CTHooks, N==Node],
Include = [I || {N,I} <- Incl, N==Node],
#opts{label = Label,
logdir = LogDir,
cover = Cover,
config = ConfigFiles,
event_handlers = EvHandlers,
+ ct_hooks = FiltCTHooks,
include = Include,
multiply_timetraps = MT,
scale_timetraps = ST}.
@@ -1036,15 +1072,7 @@ refresh_logs(LogDir) ->
which(logdir, undefined) ->
".";
which(logdir, Dir) ->
- Dir;
-which(multiply_timetraps, undefined) ->
- 1;
-which(multiply_timetraps, MT) ->
- MT;
-which(scale_timetraps, undefined) ->
- false;
-which(scale_timetraps, ST) ->
- ST.
+ Dir.
choose_val(undefined, V1) ->
V1;
@@ -2032,12 +2060,37 @@ get_start_opt(Key, IfExists, IfNotExists, Args) ->
Val;
{value,{Key,_Val}} ->
IfExists;
- _ when is_function(IfNotExists) ->
- IfNotExists();
_ ->
IfNotExists
end.
+ct_hooks_args2opts(Args) ->
+ ct_hooks_args2opts(
+ proplists:get_value(ct_hooks, Args, []),[]).
+
+ct_hooks_args2opts([CTH,Arg,"and"| Rest],Acc) ->
+ ct_hooks_args2opts(Rest,[{list_to_atom(CTH),
+ parse_cth_args(Arg)}|Acc]);
+ct_hooks_args2opts([CTH], Acc) ->
+ ct_hooks_args2opts([CTH,"and"],Acc);
+ct_hooks_args2opts([CTH, "and" | Rest], Acc) ->
+ ct_hooks_args2opts(Rest,[list_to_atom(CTH)|Acc]);
+ct_hooks_args2opts([CTH, Args], Acc) ->
+ ct_hooks_args2opts([CTH, Args, "and"],Acc);
+ct_hooks_args2opts([],Acc) ->
+ lists:reverse(Acc).
+
+parse_cth_args(String) ->
+ try
+ true = io_lib:printable_list(String),
+ {ok,Toks,_} = erl_scan:string(String++"."),
+ {ok, Args} = erl_parse:parse_term(Toks),
+ Args
+ catch _:_ ->
+ String
+ end.
+
+
event_handler_args2opts(Args) ->
case proplists:get_value(event_handler, Args) of
undefined ->
@@ -2165,6 +2218,22 @@ opts2args(EnvStartOpts) ->
end, EHs),
[_LastAnd|StrsR] = lists:reverse(lists:flatten(Strs)),
[{event_handler_init,lists:reverse(StrsR)}];
+ ({ct_hooks,[]}) ->
+ [];
+ ({ct_hooks,CTHs}) when is_list(CTHs) ->
+ io:format(user,"ct_hooks: ~p",[CTHs]),
+ Strs = lists:flatmap(
+ fun({CTH,Arg}) ->
+ [atom_to_list(CTH),
+ lists:flatten(
+ io_lib:format("~p",[Arg])),
+ "and"];
+ (CTH) when is_atom(CTH) ->
+ [atom_to_list(CTH),"and"]
+ end,CTHs),
+ [_LastAnd|StrsR] = lists:reverse(Strs),
+ io:format(user,"return: ~p",[lists:reverse(StrsR)]),
+ [{ct_hooks,lists:reverse(StrsR)}];
({Opt,As=[A|_]}) when is_atom(A) ->
[{Opt,[atom_to_list(Atom) || Atom <- As]}];
({Opt,Strs=[S|_]}) when is_list(S) ->
@@ -2263,12 +2332,19 @@ do_trace(Terms) ->
dbg:tracer(),
dbg:p(self(), [sos,call]),
lists:foreach(fun({m,M}) ->
- case dbg:tpl(M,[{'_',[],[{return_trace}]}]) of
+ case dbg:tpl(M,x) of
+ {error,What} -> exit({error,{tracing_failed,What}});
+ _ -> ok
+ end;
+ ({me,M}) ->
+ case dbg:tp(M,[{'_',[],[{exception_trace},
+ {message,{caller}}]}]) of
{error,What} -> exit({error,{tracing_failed,What}});
_ -> ok
end;
({f,M,F}) ->
- case dbg:tpl(M,F,[{'_',[],[{return_trace}]}]) of
+ case dbg:tpl(M,F,[{'_',[],[{exception_trace},
+ {message,{caller}}]}]) of
{error,What} -> exit({error,{tracing_failed,What}});
_ -> ok
end;
diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl
index bf9282900b..2c7cd3577c 100644
--- a/lib/common_test/src/ct_testspec.erl
+++ b/lib/common_test/src/ct_testspec.erl
@@ -403,8 +403,6 @@ filter_init_terms([Term|Ts], NewTerms, Spec)->
filter_init_terms([], NewTerms, Spec)->
{lists:reverse(NewTerms), Spec}.
-add_option([], _, List, _)->
- List;
add_option({Key, Value}, Node, List, WarnIfExists) when is_list(Value)->
OldOptions = case lists:keyfind(Node, 1, List) of
{Node, Options}->
@@ -634,6 +632,20 @@ add_tests([{event_handler,Node,H,Args}|Ts],Spec) when is_atom(H) ->
Node1 = ref2node(Node,Spec#testspec.nodes),
add_tests(Ts,Spec#testspec{event_handler=[{Node1,H,Args}|EvHs]});
+%% --- ct_hooks --
+add_tests([{ct_hooks, all_nodes, Hooks} | Ts], Spec) ->
+ Tests = [{ct_hooks,N,Hooks} || N <- list_nodes(Spec)],
+ add_tests(Tests ++ Ts, Spec);
+add_tests([{ct_hooks, Node, [Hook|Hooks]}|Ts], Spec) ->
+ SuiteCbs = Spec#testspec.ct_hooks,
+ Node1 = ref2node(Node,Spec#testspec.nodes),
+ add_tests([{ct_hooks, Node, Hooks} | Ts],
+ Spec#testspec{ct_hooks = [{Node1,Hook} | SuiteCbs]});
+add_tests([{ct_hooks, _Node, []}|Ts], Spec) ->
+ add_tests(Ts, Spec);
+add_tests([{ct_hooks, Hooks}|Ts], Spec) ->
+ add_tests([{ct_hooks, all_nodes, Hooks}|Ts], Spec);
+
%% --- include ---
add_tests([{include,all_nodes,InclDirs}|Ts],Spec) ->
Tests = lists:map(fun(N) -> {include,N,InclDirs} end, list_nodes(Spec)),
@@ -1090,6 +1102,8 @@ valid_terms() ->
{event_handler,2},
{event_handler,3},
{event_handler,4},
+ {ct_hooks,2},
+ {ct_hooks,3},
{multiply_timetraps,2},
{multiply_timetraps,3},
{scale_timetraps,2},
diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl
index b5ab4cbb6e..0476e1599f 100644
--- a/lib/common_test/src/ct_util.erl
+++ b/lib/common_test/src/ct_util.erl
@@ -32,7 +32,9 @@
-export([close_connections/0]).
--export([save_suite_data/3, save_suite_data/2, read_suite_data/1,
+-export([save_suite_data/3, save_suite_data/2,
+ save_suite_data_async/3, save_suite_data_async/2,
+ read_suite_data/1,
delete_suite_data/0, delete_suite_data/1, match_delete_suite_data/1,
delete_testdata/0, delete_testdata/1, set_testdata/1, get_testdata/1,
update_testdata/2]).
@@ -159,6 +161,17 @@ do_start(Parent,Mode,LogDir) ->
ok
end,
{StartTime,TestLogDir} = ct_logs:init(Mode),
+
+ %% Initiate ct_hooks
+ case catch ct_hooks:init(Opts) of
+ ok ->
+ ok;
+ {_,CTHReason} ->
+ ct_logs:tc_print('Suite Callback',CTHReason,[]),
+ Parent ! {self(), CTHReason},
+ self() ! {{stop,normal},{self(),make_ref()}}
+ end,
+
ct_event:notify(#event{name=test_start,
node=node(),
data={StartTime,
@@ -182,12 +195,19 @@ read_opts() ->
{error,{bad_installation,Error}}
end.
+
save_suite_data(Key, Value) ->
call({save_suite_data, {Key, undefined, Value}}).
save_suite_data(Key, Name, Value) ->
call({save_suite_data, {Key, Name, Value}}).
+save_suite_data_async(Key, Value) ->
+ save_suite_data_async(Key, undefined, Value).
+
+save_suite_data_async(Key, Name, Value) ->
+ cast({save_suite_data, {Key, Name, Value}}).
+
read_suite_data(Key) ->
call({read_suite_data, Key}).
@@ -268,6 +288,9 @@ loop(Mode,TestData,StartDir) ->
TestData1 = lists:keydelete(Key,1,TestData),
return(From,ok),
loop(Mode,[New|TestData1],StartDir);
+ {{get_testdata, all}, From} ->
+ return(From, TestData),
+ loop(From, TestData, StartDir);
{{get_testdata,Key},From} ->
case lists:keysearch(Key,1,TestData) of
{value,{Key,Val}} ->
@@ -299,6 +322,10 @@ loop(Mode,TestData,StartDir) ->
ct_event:sync_notify(#event{name=test_done,
node=node(),
data=Time}),
+ Callbacks = ets:lookup_element(?suite_table,
+ ct_hooks,
+ #suite_data.value),
+ ct_hooks:terminate(Callbacks),
close_connections(ets:tab2list(?conn_table)),
ets:delete(?conn_table),
ets:delete(?board_table),
@@ -308,6 +335,9 @@ loop(Mode,TestData,StartDir) ->
ct_config:stop(),
file:set_cwd(StartDir),
return(From,ok);
+ {Ref, _Msg} when is_reference(Ref) ->
+ %% This clause is used when doing cast operations.
+ loop(Mode,TestData,StartDir);
{get_mode,From} ->
return(From,Mode),
loop(Mode,TestData,StartDir);
@@ -713,6 +743,9 @@ call(Msg) ->
return({To,Ref},Result) ->
To ! {Ref, Result}.
+cast(Msg) ->
+ ct_util_server ! {Msg, {ct_util_server, make_ref()}}.
+
seconds(T) ->
test_server:seconds(T).
diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl
index 66021ae99b..f0255c533c 100644
--- a/lib/common_test/src/ct_util.hrl
+++ b/lib/common_test/src/ct_util.hrl
@@ -36,6 +36,7 @@
config=[],
userconfig=[],
event_handler=[],
+ ct_hooks=[],
include=[],
multiply_timetraps=[],
scale_timetraps=[],