%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2004-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%% http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
%% %CopyrightEnd%
%%
-module(ct_hooks).
%% API Exports
-export([init/1]).
-export([groups/2]).
-export([all/2]).
-export([init_tc/3]).
-export([end_tc/5]).
-export([terminate/1]).
-export([on_tc_skip/2]).
-export([on_tc_fail/2]).
%% If you change this, remember to update ct_util:look -> stop clause as well.
-define(config_name, ct_hooks).
%% All of the hooks which are to be started by default. Remove by issuing
%% -enable_builtin_hooks false to when starting common test.
-define(BUILTIN_HOOKS,[#ct_hook_config{ module = cth_log_redirect,
opts = [],
prio = ctfirst }]).
-record(ct_hook_config, {id, module, prio, scope, opts = [],
state = [], groups = []}).
%% -------------------------------------------------------------------------
%% API Functions
%% -------------------------------------------------------------------------
-spec init(State :: term()) -> ok |
{fail, Reason :: term()}.
init(Opts) ->
call(get_builtin_hooks(Opts) ++ get_new_hooks(Opts, undefined),
ok, init, []).
%% Call the post_groups/2 hook callback
groups(Mod, Groups) ->
Info = try proplists:get_value(ct_hooks, Mod:suite(), []) of
CTHooks when is_list(CTHooks) ->
[{?config_name,CTHooks}];
CTHook when is_atom(CTHook) ->
[{?config_name,[CTHook]}]
catch _:_ ->
%% since this might be the first time Mod:suite()
%% is called, and it might just fail or return
%% something bad, we allow any failure here - it
%% will be catched later if there is something
%% really wrong.
[{?config_name,[]}]
end,
case call(fun call_generic/3, Info ++ [{'$ct_groups',Groups}], [post_groups, Mod]) of
[{'$ct_groups',NewGroups}] ->
NewGroups;
Other ->
Other
end.
%% Call the post_all/3 hook callback
all(Mod, Tests) ->
Info = try proplists:get_value(ct_hooks, Mod:suite(), []) of
CTHooks when is_list(CTHooks) ->
[{?config_name,CTHooks}];
CTHook when is_atom(CTHook) ->
[{?config_name,[CTHook]}]
catch _:_ ->
%% just allow any failure here - it will be catched
%% later if there is something really wrong.
[{?config_name,[]}]
end,
case call(fun call_generic/3, Info ++ [{'$ct_all',Tests}], [post_all, Mod]) of
[{'$ct_all',NewTests}] ->
NewTests;
Other ->
Other
end.
%% Called after all suites are done.
-spec terminate(Hooks :: term()) ->
ok.
terminate(Hooks) ->
call([{HookId, fun call_terminate/3}
|| #ct_hook_config{id = HookId} <- Hooks],
ct_hooks_terminate_dummy, terminate, Hooks),
ok.
-spec init_tc(Mod :: atom(),
FuncSpec :: atom() |
{ConfigFunc :: init_per_testcase | end_per_testcase,
TestCase :: atom()} |
{ConfigFunc :: init_per_group | end_per_group,
GroupName :: atom(),
Properties :: list()},
Args :: list()) ->
NewConfig :: proplists:proplist() |
{skip, Reason :: term()} |
{auto_skip, Reason :: term()} |
{fail, Reason :: term()}.
init_tc(Mod, init_per_suite, Config) ->
Info = try proplists:get_value(ct_hooks, Mod:suite(),[]) of
List when is_list(List) ->
[{?config_name,List}];
CTHook when is_atom(CTHook) ->
[{?config_name,[CTHook]}]
catch error:undef ->
[{?config_name,[]}]
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, Properties}, Config) ->
maybe_start_locker(Mod, GroupName, Properties),
call(fun call_generic_fallback/3, Config,
[pre_init_per_group, Mod, GroupName]);
init_tc(Mod, {end_per_group, GroupName, _}, Config) ->
call(fun call_generic_fallback/3, Config,
[pre_end_per_group, Mod, GroupName]);
init_tc(Mod, {init_per_testcase,TC}, Config) ->
call(fun call_generic_fallback/3, Config, [pre_init_per_testcase, Mod, TC]);
init_tc(Mod, {end_per_testcase,TC}, Config) ->
call(fun call_generic_fallback/3, Config, [pre_end_per_testcase, Mod, TC]);
init_tc(Mod, TC = error_in_suite, Config) ->
call(fun call_generic_fallback/3, Config, [pre_init_per_testcase, Mod, TC]).
-spec end_tc(Mod :: atom(),
FuncSpec :: atom() |
{ConfigFunc :: init_per_testcase | end_per_testcase,
TestCase :: atom()} |
{ConfigFunc :: init_per_group | end_per_group,
GroupName :: atom(),
Properties :: list()},
Args :: list(),
Result :: term(),
Return :: term()) ->
NewConfig :: proplists:proplist() |
{skip, Reason :: term()} |
{auto_skip, Reason :: term()} |
{fail, Reason :: term()} |
ok | '$ct_no_change'.
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_fallback/3, Return,
[post_init_per_group, Mod, GroupName, Config], '$ct_no_change');
end_tc(Mod, {end_per_group, GroupName, Properties}, Config, Result, _Return) ->
Res = call(fun call_generic_fallback/3, Result,
[post_end_per_group, Mod, GroupName, Config], '$ct_no_change'),
maybe_stop_locker(Mod, GroupName, Properties),
Res;
end_tc(Mod, {init_per_testcase,TC}, Config, Result, _Return) ->
call(fun call_generic_fallback/3, Result,
[post_init_per_testcase, Mod, TC, Config], '$ct_no_change');
end_tc(Mod, {end_per_testcase,TC}, Config, Result, _Return) ->
call(fun call_generic_fallback/3, Result,
[post_end_per_testcase, Mod, TC, Config], '$ct_no_change');
end_tc(Mod, TC = error_in_suite, Config, Result, _Return) ->
call(fun call_generic_fallback/3, Result,
[post_end_per_testcase, Mod, TC, Config], '$ct_no_change').
%% Case = TestCase | {TestCase,GroupName}
on_tc_skip(How, {Suite, Case, Reason}) ->
call(fun call_cleanup/3, {How, Reason}, [on_tc_skip, Suite, Case]).
%% Case = TestCase | {TestCase,GroupName}
on_tc_fail(_How, {Suite, Case, Reason}) ->
call(fun call_cleanup/3, Reason, [on_tc_fail, Suite, Case]).
%% -------------------------------------------------------------------------
%% Internal Functions
%% -------------------------------------------------------------------------
call_id(#ct_hook_config{ module = Mod, opts = Opts} = Hook, Config, Scope) ->
Id = catch_apply(Mod,id,[Opts], make_ref()),
{Config, Hook#ct_hook_config{ id = Id, scope = scope(Scope)}}.
call_init(#ct_hook_config{ module = Mod, opts = Opts, id = Id, prio = P} = Hook,
Config, _Meta) ->
case Mod:init(Id, Opts) of
{ok, NewState} when P =:= undefined ->
{Config, Hook#ct_hook_config{ state = NewState, prio = 0 } };
{ok, NewState} ->
{Config, Hook#ct_hook_config{ state = NewState } };
{ok, NewState, Prio} when P =:= undefined ->
%% Only set prio if not already set when installing hook
{Config, Hook#ct_hook_config{ state = NewState, prio = Prio } };
{ok, NewState, _} ->
{Config, Hook#ct_hook_config{ state = NewState } };
NewState -> %% Keep for backward compatability reasons
{Config, Hook#ct_hook_config{ state = NewState } }
end.
call_terminate(#ct_hook_config{ module = Mod, state = State} = Hook, _, _) ->
catch_apply(Mod,terminate,[State], ok),
{[],Hook}.
call_cleanup(#ct_hook_config{ module = Mod, state = State} = Hook,
Reason, [Function | Args]) ->
NewState = catch_apply(Mod,Function, Args ++ [Reason, State],
State, true),
{Reason, Hook#ct_hook_config{ state = NewState } }.
call_generic(Hook, Value, Meta) ->
do_call_generic(Hook, Value, Meta, false).
call_generic_fallback(Hook, Value, Meta) ->
do_call_generic(Hook, Value, Meta, true).
do_call_generic(#ct_hook_config{ module = Mod} = Hook,
[{'$ct_groups',Groups}], [post_groups | Args], Fallback) ->
NewGroups = catch_apply(Mod, post_groups, Args ++ [Groups],
Groups, Fallback),
{[{'$ct_groups',NewGroups}], Hook#ct_hook_config{ groups = NewGroups } };
do_call_generic(#ct_hook_config{ module = Mod, groups = Groups} = Hook,
[{'$ct_all',Tests}], [post_all | Args], Fallback) ->
NewTests = catch_apply(Mod, post_all, Args ++ [Tests, Groups],
Tests, Fallback),
{[{'$ct_all',NewTests}], Hook};
do_call_generic(#ct_hook_config{ module = Mod, state = State} = Hook,
Value, [Function | Args], Fallback) ->
{NewValue, NewState} = catch_apply(Mod, Function, Args ++ [Value, State],
{Value,State}, Fallback),
{NewValue, Hook#ct_hook_config{ state = NewState } }.
%% Generic call function
call(Fun, Config, Meta) ->
maybe_lock(),
Hooks = get_hooks(),
Calls = get_new_hooks(Config, Fun) ++
[{HookId,Fun} || #ct_hook_config{id = HookId} <- Hooks],
Res = call(resort(Calls,Hooks,Meta),
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, #ct_hook_config{ id = NewId } = NewHook} =
call_id(Hook, Config, Meta),
{NewHooks, NewRest} =
case lists:keyfind(NewId, #ct_hook_config.id, Hooks) of
false when NextFun =:= undefined ->
{Hooks ++ [NewHook],
Rest ++ [{NewId, call_init}]};
ExistingHook when is_tuple(ExistingHook) ->
{Hooks, Rest};
_ when hd(Meta)=:=post_groups; hd(Meta)=:=post_all ->
%% If CTH is started because of a call from
%% groups/2 or all/2, CTH:init/1 must not be
%% called (the suite scope should be used).
{Hooks ++ [NewHook],
Rest ++ [{NewId,NextFun}]};
_ ->
{Hooks ++ [NewHook],
Rest ++ [{NewId, call_init}, {NewId,NextFun}]}
end,
call(resort(NewRest,NewHooks,Meta), Config, Meta, NewHooks)
catch Error:Reason:Trace ->
ct_logs:log("Suite Hook","Failed to start a CTH: ~tp:~tp",
[Error,{Reason,Trace}]),
call([], {fail,"Failed to start CTH, "
"see the CT Log for details"}, Meta, Hooks)
end;
call([{HookId, call_init} | Rest], Config, Meta, Hooks) ->
call([{HookId, fun call_init/3} | Rest], Config, Meta, Hooks);
call([{HookId, Fun} | Rest], Config, Meta, Hooks) ->
try
Hook = lists:keyfind(HookId, #ct_hook_config.id, Hooks),
{NewConf, NewHook} = Fun(Hook, Config, Meta),
NewCalls = get_new_hooks(NewConf, Fun),
NewHooks = lists:keyreplace(HookId, #ct_hook_config.id, Hooks, NewHook),
call(resort(NewCalls ++ Rest,NewHooks,Meta), %% Resort if call_init changed prio
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. is_tuplenit_per_group,group1 -> end_per_group,group1 etc
scope([pre_init_per_testcase, SuiteName, TC|_]) ->
[post_init_per_testcase, SuiteName, TC];
scope([pre_end_per_testcase, SuiteName, TC|_]) ->
[post_end_per_testcase, SuiteName, TC];
scope([pre_init_per_group, SuiteName, GroupName|_]) ->
[post_end_per_group, SuiteName, GroupName];
scope([post_init_per_group, SuiteName, GroupName|_]) ->
[post_end_per_group, SuiteName, GroupName];
scope([pre_init_per_suite, SuiteName|_]) ->
[post_end_per_suite, SuiteName];
scope([post_init_per_suite, SuiteName|_]) ->
[post_end_per_suite, SuiteName];
scope([post_groups, SuiteName|_]) ->
[post_groups, SuiteName];
scope([post_all, SuiteName|_]) ->
[post_all, SuiteName];
scope(init) ->
none.
strip_config([post_init_per_testcase, SuiteName, TC|_]) ->
[post_init_per_testcase, SuiteName, TC];
strip_config([post_end_per_testcase, SuiteName, TC|_]) ->
[post_end_per_testcase, SuiteName, TC];
strip_config([post_init_per_group, SuiteName, GroupName|_]) ->
[post_init_per_group, SuiteName, GroupName];
strip_config([post_end_per_group, SuiteName, GroupName|_]) ->
[post_end_per_group, SuiteName, GroupName];
strip_config([post_init_per_suite, SuiteName|_]) ->
[post_init_per_suite, SuiteName];
strip_config([post_end_per_suite, SuiteName|_]) ->
[post_end_per_suite, SuiteName];
strip_config(Other) ->
Other.
terminate_if_scope_ends(HookId, [on_tc_skip,Suite,{end_per_group,Name}],
Hooks) ->
terminate_if_scope_ends(HookId, [post_end_per_group, Suite, Name], Hooks);
terminate_if_scope_ends(HookId, [on_tc_skip,Suite,end_per_suite], Hooks) ->
terminate_if_scope_ends(HookId, [post_end_per_suite, Suite], Hooks);
terminate_if_scope_ends(HookId, Function0, Hooks) ->
Function = strip_config(Function0),
case lists:keyfind(HookId, #ct_hook_config.id, Hooks) of
#ct_hook_config{ id = HookId, scope = Function} = Hook ->
case Function of
[AllOrGroup,_] when AllOrGroup=:=post_all;
AllOrGroup=:=post_groups ->
%% The scope only contains one function (post_all
%% or post_groups), and init has not been called,
%% so skip terminate as well.
ok;
_ ->
terminate([Hook])
end,
lists:keydelete(HookId, #ct_hook_config.id, Hooks);
_ ->
Hooks
end.
%% Fetch hook functions
get_new_hooks(Config, Fun) ->
lists:map(fun(NewHook) when is_atom(NewHook) ->
{#ct_hook_config{ module = NewHook }, call_id, Fun};
({NewHook,Opts}) ->
{#ct_hook_config{ module = NewHook,
opts = Opts}, call_id, Fun};
({NewHook,Opts,Prio}) ->
{#ct_hook_config{ module = NewHook,
opts = Opts,
prio = Prio }, call_id, Fun}
end, get_new_hooks(Config)).
get_new_hooks(Config) when is_list(Config) ->
lists:flatmap(fun({?config_name, HookConfigs}) when is_list(HookConfigs) ->
HookConfigs;
({?config_name, HookConfig}) when is_atom(HookConfig) ->
[HookConfig];
(_) ->
[]
end, Config);
get_new_hooks(_Config) ->
[].
get_builtin_hooks(Opts) ->
case proplists:get_value(enable_builtin_hooks,Opts) of
false ->
[];
_Else ->
[{HookConf, call_id, undefined} || HookConf <- ?BUILTIN_HOOKS]
end.
save_suite_data_async(Hooks) ->
ct_util:save_suite_data_async(?config_name, Hooks).
get_hooks() ->
lists:keysort(#ct_hook_config.prio,ct_util:read_suite_data(?config_name)).
%% Sort all calls in this order:
%% call_id < call_init < ctfirst < Priority 1 < .. < Priority N < ctlast
%% If Hook Priority is equal, check when it has been installed and
%% sort on that instead.
%% If we are doing a cleanup call i.e. {post,pre}_end_per_*, all priorities
%% are reversed. Probably want to make this sorting algorithm pluginable
%% as some point...
resort(Calls,Hooks,[F|_R]) when F == pre_end_per_testcase;
F == post_end_per_testcase;
F == pre_end_per_group;
F == post_end_per_group;
F == pre_end_per_suite;
F == post_end_per_suite ->
lists:reverse(resort(Calls,Hooks));
resort(Calls,Hooks,_Meta) ->
resort(Calls,Hooks).
resort(Calls, Hooks) ->
lists:sort(
fun({_,_,_},_) ->
true;
(_,{_,_,_}) ->
false;
({_,call_init},_) ->
true;
(_,{_,call_init}) ->
false;
({Id1,_},{Id2,_}) ->
P1 = (lists:keyfind(Id1, #ct_hook_config.id, Hooks))#ct_hook_config.prio,
P2 = (lists:keyfind(Id2, #ct_hook_config.id, Hooks))#ct_hook_config.prio,
if
P1 == P2 ->
%% If priorities are equal, we check the position in the
%% hooks list
pos(Id1,Hooks) < pos(Id2,Hooks);
P1 == ctfirst ->
true;
P2 == ctfirst ->
false;
P1 == ctlast ->
false;
P2 == ctlast ->
true;
true ->
P1 < P2
end
end,Calls).
pos(Id,Hooks) ->
pos(Id,Hooks,0).
pos(Id,[#ct_hook_config{ id = Id}|_],Num) ->
Num;
pos(Id,[_|Rest],Num) ->
pos(Id,Rest,Num+1).
catch_apply(M,F,A, Default) ->
catch_apply(M,F,A,Default,false).
catch_apply(M,F,A, Default, Fallback) ->
not erlang:module_loaded(M) andalso (catch M:module_info()),
case erlang:function_exported(M,F,length(A)) of
false when Fallback ->
catch_apply(M,F,tl(A),Default,false);
false ->
Default;
true ->
catch_apply(M,F,A)
end.
catch_apply(M,F,A) ->
try
erlang:apply(M,F,A)
catch _:Reason:Trace ->
ct_logs:log("Suite Hook","Call to CTH failed: ~w:~tp",
[error,{Reason,Trace}]),
throw({error_in_cth_call,
lists:flatten(
io_lib:format("~w:~tw/~w CTH call failed",
[M,F,length(A)]))})
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}),
ok;
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().
