diff options
Diffstat (limited to 'lib/common_test/src')
| -rw-r--r-- | lib/common_test/src/Makefile | 4 | ||||
| -rw-r--r-- | lib/common_test/src/ct.erl | 6 | ||||
| -rw-r--r-- | lib/common_test/src/ct_framework.erl | 224 | ||||
| -rw-r--r-- | lib/common_test/src/ct_hooks.erl | 305 | ||||
| -rw-r--r-- | lib/common_test/src/ct_hooks_lock.erl | 132 | ||||
| -rw-r--r-- | lib/common_test/src/ct_run.erl | 130 | ||||
| -rw-r--r-- | lib/common_test/src/ct_testspec.erl | 151 | ||||
| -rw-r--r-- | lib/common_test/src/ct_util.erl | 35 | ||||
| -rw-r--r-- | lib/common_test/src/ct_util.hrl | 4 |
9 files changed, 849 insertions, 142 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 f5069427a2..2c7cd3577c 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -68,7 +68,8 @@ prepare_tests(TestSpec) when is_record(TestSpec,testspec) -> %% Create initial list of {Node,{Run,Skip}} tuples NodeList = lists:map(fun(N) -> {N,{[],[]}} end, list_nodes(TestSpec)), %% Get all Run tests sorted per node basis. - NodeList1 = run_per_node(Run,NodeList), + NodeList1 = run_per_node(Run,NodeList, + TestSpec#testspec.merge_tests), %% Get all Skip entries sorted per node basis. NodeList2 = skip_per_node(Skip,NodeList1), %% Change representation. @@ -89,11 +90,17 @@ prepare_tests(TestSpec) when is_record(TestSpec,testspec) -> %% run_per_node/2 takes the Run list as input and returns a list %% of {Node,RunPerNode,[]} tuples where the tests have been sorted %% on a per node basis. -run_per_node([{{Node,Dir},Test}|Ts],Result) -> +run_per_node([{{Node,Dir},Test}|Ts],Result, MergeTests) -> {value,{Node,{Run,Skip}}} = lists:keysearch(Node,1,Result), - Run1 = merge_tests(Dir,Test,Run), - run_per_node(Ts,insert_in_order({Node,{Run1,Skip}},Result)); -run_per_node([],Result) -> + Run1 = case MergeTests of + false -> + append({Dir, Test}, Run); + true -> + merge_tests(Dir,Test,Run) + end, + run_per_node(Ts,insert_in_order({Node,{Run1,Skip}},Result), + MergeTests); +run_per_node([],Result,_) -> Result. merge_tests(Dir,Test={all,_},TestDirs) -> @@ -281,6 +288,8 @@ collect_tests(Terms,TestSpec,Relaxed) -> {Terms2, TestSpec3} = filter_init_terms(Terms, [], TestSpec2), add_tests(Terms2,TestSpec3). +get_global([{merge_tests, Bool} | Ts], Spec) -> + get_global(Ts,Spec#testspec{ merge_tests = Bool }); get_global([{alias,Ref,Dir}|Ts],Spec=#testspec{alias=Refs}) -> get_global(Ts,Spec#testspec{alias=[{Ref,get_absdir(Dir,Spec)}|Refs]}); get_global([{node,Ref,Node}|Ts],Spec=#testspec{nodes=Refs}) -> @@ -394,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}-> @@ -625,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)), @@ -656,7 +677,7 @@ add_tests([{suites,Node,Dir,Ss}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = insert_suites(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Ss,Tests), + Ss,Tests, Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); %% --- groups --- @@ -682,13 +703,15 @@ add_tests([{groups,Node,Dir,Suite,Gs}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = insert_groups(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Suite,Gs,all,Tests), + Suite,Gs,all,Tests, + Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); add_tests([{groups,Node,Dir,Suite,Gs,{cases,TCs}}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = insert_groups(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Suite,Gs,TCs,Tests), + Suite,Gs,TCs,Tests, + Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); %% --- cases --- @@ -703,7 +726,7 @@ add_tests([{cases,Node,Dir,Suite,Cs}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = insert_cases(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Suite,Cs,Tests), + Suite,Cs,Tests, Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); %% --- skip_suites --- @@ -718,7 +741,8 @@ add_tests([{skip_suites,Node,Dir,Ss,Cmt}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = skip_suites(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Ss,Cmt,Tests), + Ss,Cmt,Tests, + Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); %% --- skip_groups --- @@ -740,13 +764,15 @@ add_tests([{skip_groups,Node,Dir,Suite,Gs,Cmt}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = skip_groups(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Suite,Gs,all,Cmt,Tests), + Suite,Gs,all,Cmt,Tests, + Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); add_tests([{skip_groups,Node,Dir,Suite,Gs,{cases,TCs},Cmt}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = skip_groups(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Suite,Gs,TCs,Cmt,Tests), + Suite,Gs,TCs,Cmt,Tests, + Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); %% --- skip_cases --- @@ -761,7 +787,7 @@ add_tests([{skip_cases,Node,Dir,Suite,Cs,Cmt}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = skip_cases(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Suite,Cs,Cmt,Tests), + Suite,Cs,Cmt,Tests,Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); %% --- handled/errors --- @@ -771,6 +797,9 @@ add_tests([{alias,_,_}|Ts],Spec) -> % handled add_tests([{node,_,_}|Ts],Spec) -> % handled add_tests(Ts,Spec); +add_tests([{merge_tests, _} | Ts], Spec) -> % handled + add_tests(Ts,Spec); + %% check if it's a CT term that has bad format or if the user seems to %% have added something of his/her own, which we'll let pass if relaxed %% mode is enabled. @@ -823,17 +852,22 @@ separate([],_,_,_) -> %% {Suite2,[{GrOrCase21,{skip,Cmt}},GrOrCase22,...]},...]} %% GrOrCase = {GroupName,[Case1,Case2,...]} | Case -insert_suites(Node,Dir,[S|Ss],Tests) -> - Tests1 = insert_cases(Node,Dir,S,all,Tests), - insert_suites(Node,Dir,Ss,Tests1); -insert_suites(_Node,_Dir,[],Tests) -> +insert_suites(Node,Dir,[S|Ss],Tests, MergeTests) -> + Tests1 = insert_cases(Node,Dir,S,all,Tests,MergeTests), + insert_suites(Node,Dir,Ss,Tests1,MergeTests); +insert_suites(_Node,_Dir,[],Tests,_MergeTests) -> Tests; -insert_suites(Node,Dir,S,Tests) -> - insert_suites(Node,Dir,[S],Tests). +insert_suites(Node,Dir,S,Tests,MergeTests) -> + insert_suites(Node,Dir,[S],Tests,MergeTests). -insert_groups(Node,Dir,Suite,Group,Cases,Tests) when is_atom(Group) -> - insert_groups(Node,Dir,Suite,[Group],Cases,Tests); -insert_groups(Node,Dir,Suite,Groups,Cases,Tests) when +insert_groups(Node,Dir,Suite,Group,Cases,Tests,MergeTests) + when is_atom(Group) -> + insert_groups(Node,Dir,Suite,[Group],Cases,Tests,MergeTests); +insert_groups(Node,Dir,Suite,Groups,Cases,Tests,false) when + ((Cases == all) or is_list(Cases)) and is_list(Groups) -> + Groups1 = [{Gr,Cases} || Gr <- Groups], + append({{Node,Dir},[{Suite,Groups1}]},Tests); +insert_groups(Node,Dir,Suite,Groups,Cases,Tests,true) when ((Cases == all) or is_list(Cases)) and is_list(Groups) -> case lists:keysearch({Node,Dir},1,Tests) of {value,{{Node,Dir},[{all,_}]}} -> @@ -847,9 +881,10 @@ insert_groups(Node,Dir,Suite,Groups,Cases,Tests) when Groups1 = [{Gr,Cases} || Gr <- Groups], insert_in_order({{Node,Dir},[{Suite,Groups1}]},Tests) end; -insert_groups(Node,Dir,Suite,Groups,Case,Tests) when is_atom(Case) -> +insert_groups(Node,Dir,Suite,Groups,Case,Tests, MergeTests) + when is_atom(Case) -> Cases = if Case == all -> all; true -> [Case] end, - insert_groups(Node,Dir,Suite,Groups,Cases,Tests). + insert_groups(Node,Dir,Suite,Groups,Cases,Tests, MergeTests). insert_groups1(_Suite,_Groups,all) -> all; @@ -879,7 +914,9 @@ insert_groups2([Group={GrName,Cases}|Groups],GrAndCases) -> insert_groups2([],GrAndCases) -> GrAndCases. -insert_cases(Node,Dir,Suite,Cases,Tests) when is_list(Cases) -> +insert_cases(Node,Dir,Suite,Cases,Tests,false) when is_list(Cases) -> + append({{Node,Dir},[{Suite,Cases}]},Tests); +insert_cases(Node,Dir,Suite,Cases,Tests,true) when is_list(Cases) -> case lists:keysearch({Node,Dir},1,Tests) of {value,{{Node,Dir},[{all,_}]}} -> Tests; @@ -889,8 +926,8 @@ insert_cases(Node,Dir,Suite,Cases,Tests) when is_list(Cases) -> false -> insert_in_order({{Node,Dir},[{Suite,Cases}]},Tests) end; -insert_cases(Node,Dir,Suite,Case,Tests) when is_atom(Case) -> - insert_cases(Node,Dir,Suite,[Case],Tests). +insert_cases(Node,Dir,Suite,Case,Tests,MergeTests) when is_atom(Case) -> + insert_cases(Node,Dir,Suite,[Case],Tests,MergeTests). insert_cases1(_Suite,_Cases,all) -> all; @@ -905,22 +942,28 @@ insert_cases1(Suite,Cases,Suites0) -> insert_in_order({Suite,Cases},Suites0) end. -skip_suites(Node,Dir,[S|Ss],Cmt,Tests) -> - Tests1 = skip_cases(Node,Dir,S,all,Cmt,Tests), - skip_suites(Node,Dir,Ss,Cmt,Tests1); -skip_suites(_Node,_Dir,[],_Cmt,Tests) -> +skip_suites(Node,Dir,[S|Ss],Cmt,Tests,MergeTests) -> + Tests1 = skip_cases(Node,Dir,S,all,Cmt,Tests,MergeTests), + skip_suites(Node,Dir,Ss,Cmt,Tests1,MergeTests); +skip_suites(_Node,_Dir,[],_Cmt,Tests,_MergeTests) -> Tests; -skip_suites(Node,Dir,S,Cmt,Tests) -> - skip_suites(Node,Dir,[S],Cmt,Tests). - -skip_groups(Node,Dir,Suite,Group,all,Cmt,Tests) when is_atom(Group) -> - skip_groups(Node,Dir,Suite,[Group],all,Cmt,Tests); -skip_groups(Node,Dir,Suite,Group,Cases,Cmt,Tests) when is_atom(Group) -> - skip_groups(Node,Dir,Suite,[Group],Cases,Cmt,Tests); -skip_groups(Node,Dir,Suite,Groups,Case,Cmt,Tests) when is_atom(Case), - Case =/= all -> - skip_groups(Node,Dir,Suite,Groups,[Case],Cmt,Tests); -skip_groups(Node,Dir,Suite,Groups,Cases,Cmt,Tests) when +skip_suites(Node,Dir,S,Cmt,Tests,MergeTests) -> + skip_suites(Node,Dir,[S],Cmt,Tests,MergeTests). + +skip_groups(Node,Dir,Suite,Group,all,Cmt,Tests,MergeTests) + when is_atom(Group) -> + skip_groups(Node,Dir,Suite,[Group],all,Cmt,Tests,MergeTests); +skip_groups(Node,Dir,Suite,Group,Cases,Cmt,Tests,MergeTests) + when is_atom(Group) -> + skip_groups(Node,Dir,Suite,[Group],Cases,Cmt,Tests,MergeTests); +skip_groups(Node,Dir,Suite,Groups,Case,Cmt,Tests,MergeTests) + when is_atom(Case),Case =/= all -> + skip_groups(Node,Dir,Suite,Groups,[Case],Cmt,Tests,MergeTests); +skip_groups(Node,Dir,Suite,Groups,Cases,Cmt,Tests,false) when + ((Cases == all) or is_list(Cases)) and is_list(Groups) -> + Suites1 = skip_groups1(Suite,[{Gr,Cases} || Gr <- Groups],Cmt,[]), + append({{Node,Dir},Suites1},Tests); +skip_groups(Node,Dir,Suite,Groups,Cases,Cmt,Tests,true) when ((Cases == all) or is_list(Cases)) and is_list(Groups) -> Suites = case lists:keysearch({Node,Dir},1,Tests) of @@ -931,9 +974,10 @@ skip_groups(Node,Dir,Suite,Groups,Cases,Cmt,Tests) when end, Suites1 = skip_groups1(Suite,[{Gr,Cases} || Gr <- Groups],Cmt,Suites), insert_in_order({{Node,Dir},Suites1},Tests); -skip_groups(Node,Dir,Suite,Groups,Case,Cmt,Tests) when is_atom(Case) -> +skip_groups(Node,Dir,Suite,Groups,Case,Cmt,Tests,MergeTests) + when is_atom(Case) -> Cases = if Case == all -> all; true -> [Case] end, - skip_groups(Node,Dir,Suite,Groups,Cases,Cmt,Tests). + skip_groups(Node,Dir,Suite,Groups,Cases,Cmt,Tests,MergeTests). skip_groups1(Suite,Groups,Cmt,Suites0) -> SkipGroups = lists:map(fun(Group) -> @@ -947,7 +991,10 @@ skip_groups1(Suite,Groups,Cmt,Suites0) -> insert_in_order({Suite,SkipGroups},Suites0) end. -skip_cases(Node,Dir,Suite,Cases,Cmt,Tests) when is_list(Cases) -> +skip_cases(Node,Dir,Suite,Cases,Cmt,Tests,false) when is_list(Cases) -> + Suites1 = skip_cases1(Suite,Cases,Cmt,[]), + append({{Node,Dir},Suites1},Tests); +skip_cases(Node,Dir,Suite,Cases,Cmt,Tests,true) when is_list(Cases) -> Suites = case lists:keysearch({Node,Dir},1,Tests) of {value,{{Node,Dir},Suites0}} -> @@ -957,8 +1004,8 @@ skip_cases(Node,Dir,Suite,Cases,Cmt,Tests) when is_list(Cases) -> end, Suites1 = skip_cases1(Suite,Cases,Cmt,Suites), insert_in_order({{Node,Dir},Suites1},Tests); -skip_cases(Node,Dir,Suite,Case,Cmt,Tests) when is_atom(Case) -> - skip_cases(Node,Dir,Suite,[Case],Cmt,Tests). +skip_cases(Node,Dir,Suite,Case,Cmt,Tests,MergeTests) when is_atom(Case) -> + skip_cases(Node,Dir,Suite,[Case],Cmt,Tests,MergeTests). skip_cases1(Suite,Cases,Cmt,Suites0) -> SkipCases = lists:map(fun(C) -> @@ -972,6 +1019,9 @@ skip_cases1(Suite,Cases,Cmt,Suites0) -> insert_in_order({Suite,SkipCases},Suites0) end. +append(Elem, List) -> + List ++ [Elem]. + insert_in_order([E|Es],List) -> List1 = insert_elem(E,List,[]), insert_in_order(Es,List1); @@ -1044,6 +1094,7 @@ valid_terms() -> {userconfig,2}, {userconfig,3}, {alias,3}, + {merge_tests,1}, {logdir,2}, {logdir,3}, {label,2}, @@ -1051,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 ee973f6220..f0255c533c 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -36,11 +36,13 @@ config=[], userconfig=[], event_handler=[], + ct_hooks=[], include=[], multiply_timetraps=[], scale_timetraps=[], alias=[], - tests=[]}). + tests=[], + merge_tests = true }). -record(cover, {app=none, level=details, |