1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2004-2020. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21-module(ct_hooks).
22
23%% API Exports
24-export([init/1]).
25-export([groups/2]).
26-export([all/2]).
27-export([init_tc/3]).
28-export([end_tc/5]).
29-export([terminate/1]).
30-export([on_tc_skip/2]).
31-export([on_tc_fail/2]).
32
33%% If you change this, remember to update ct_util:look -> stop clause as well.
34-define(config_name, ct_hooks).
35
36%% All of the hooks which are to be started by default. Remove by issuing
37%% -enable_builtin_hooks false to when starting common test.
38-define(BUILTIN_HOOKS,[#ct_hook_config{ module = cth_log_redirect,
39					opts = [],
40					prio = ctfirst }]).
41
42-record(ct_hook_config, {id, module, prio, scope, opts = [],
43                         state = [], groups = []}).
44
45%% -------------------------------------------------------------------------
46%% API Functions
47%% -------------------------------------------------------------------------
48
49-spec init(State :: term()) -> ok |
50			       {fail, Reason :: term()}.
51init(Opts) ->
52    call(get_builtin_hooks(Opts) ++ get_new_hooks(Opts, undefined),
53	 ok, init, []).
54
55%% Call the post_groups/2 hook callback
56groups(Mod, Groups) ->
57    Info = try proplists:get_value(ct_hooks, Mod:suite(), []) of
58               CTHooks when is_list(CTHooks) ->
59                   [{?config_name,CTHooks}];
60               CTHook when is_atom(CTHook) ->
61                   [{?config_name,[CTHook]}]
62           catch _:_ ->
63                   %% since this might be the first time Mod:suite()
64                   %% is called, and it might just fail or return
65                   %% something bad, we allow any failure here - it
66                   %% will be catched later if there is something
67                   %% really wrong.
68                   [{?config_name,[]}]
69           end,
70    case call(fun call_generic/3, Info ++ [{'$ct_groups',Groups}], [post_groups, Mod]) of
71        [{'$ct_groups',NewGroups}] ->
72            NewGroups;
73        Other ->
74            Other
75    end.
76
77%% Call the post_all/3 hook callback
78all(Mod, Tests) ->
79    Info = try proplists:get_value(ct_hooks, Mod:suite(), []) of
80               CTHooks when is_list(CTHooks) ->
81                   [{?config_name,CTHooks}];
82               CTHook when is_atom(CTHook) ->
83                   [{?config_name,[CTHook]}]
84           catch _:_ ->
85                   %% just allow any failure here - it will be catched
86                   %% later if there is something really wrong.
87                   [{?config_name,[]}]
88           end,
89    case call(fun call_generic/3, Info ++ [{'$ct_all',Tests}], [post_all, Mod]) of
90        [{'$ct_all',NewTests}] ->
91            NewTests;
92        Other ->
93            Other
94    end.
95
96%% Called after all suites are done.
97-spec terminate(Hooks :: term()) ->
98    ok.
99terminate(Hooks) ->
100    call([{HookId, fun call_terminate/3}
101	  || #ct_hook_config{id = HookId} <- Hooks],
102	 ct_hooks_terminate_dummy, terminate, Hooks),
103    ok.
104
105-spec init_tc(Mod :: atom(),
106	      FuncSpec :: atom() |
107			  {ConfigFunc :: init_per_testcase | end_per_testcase,
108			   TestCase :: atom()} |
109			  {ConfigFunc :: init_per_group | end_per_group,
110			   GroupName :: atom(),
111			   Properties :: list()},
112	      Args :: list()) ->
113    NewConfig :: proplists:proplist() |
114		 {skip, Reason :: term()} |
115		 {auto_skip, Reason :: term()} |
116		 {fail, Reason :: term()}.
117
118init_tc(Mod, init_per_suite, Config) ->
119    Info = try proplists:get_value(ct_hooks, Mod:suite(),[]) of
120	       List when is_list(List) ->
121		   [{?config_name,List}];
122	       CTHook when is_atom(CTHook) ->
123		   [{?config_name,[CTHook]}]
124	   catch error:undef ->
125		   [{?config_name,[]}]
126	   end,
127    call(fun call_generic/3, Config ++ Info, [pre_init_per_suite, Mod]);
128
129init_tc(Mod, end_per_suite, Config) ->
130    call(fun call_generic/3, Config, [pre_end_per_suite, Mod]);
131init_tc(Mod, {init_per_group, GroupName, Properties}, Config) ->
132    maybe_start_locker(Mod, GroupName, Properties),
133    call(fun call_generic_fallback/3, Config,
134         [pre_init_per_group, Mod, GroupName]);
135init_tc(Mod, {end_per_group, GroupName, _}, Config) ->
136    call(fun call_generic_fallback/3, Config,
137         [pre_end_per_group, Mod, GroupName]);
138init_tc(Mod, {init_per_testcase,TC}, Config) ->
139    call(fun call_generic_fallback/3, Config, [pre_init_per_testcase, Mod, TC]);
140init_tc(Mod, {end_per_testcase,TC}, Config) ->
141    call(fun call_generic_fallback/3, Config, [pre_end_per_testcase, Mod, TC]);
142init_tc(Mod, TC = error_in_suite, Config) ->
143    call(fun call_generic_fallback/3, Config, [pre_init_per_testcase, Mod, TC]).
144
145-spec end_tc(Mod :: atom(),
146	     FuncSpec :: atom() |
147			 {ConfigFunc :: init_per_testcase | end_per_testcase,
148			  TestCase :: atom()} |
149			 {ConfigFunc :: init_per_group | end_per_group,
150			  GroupName :: atom(),
151			  Properties :: list()},
152	     Args :: list(),
153	     Result :: term(),
154	     Return :: term()) ->
155    NewConfig :: proplists:proplist() |
156		 {skip, Reason :: term()} |
157		 {auto_skip, Reason :: term()} |
158		 {fail, Reason :: term()} |
159		 ok | '$ct_no_change'.
160
161end_tc(Mod, init_per_suite, Config, _Result, Return) ->
162    call(fun call_generic/3, Return, [post_init_per_suite, Mod, Config],
163	 '$ct_no_change');
164end_tc(Mod, end_per_suite, Config, Result, _Return) ->
165    call(fun call_generic/3, Result, [post_end_per_suite, Mod, Config],
166	'$ct_no_change');
167end_tc(Mod, {init_per_group, GroupName, _}, Config, _Result, Return) ->
168    call(fun call_generic_fallback/3, Return,
169         [post_init_per_group, Mod, GroupName, Config], '$ct_no_change');
170end_tc(Mod, {end_per_group, GroupName, Properties}, Config, Result, _Return) ->
171    Res = call(fun call_generic_fallback/3, Result,
172	       [post_end_per_group, Mod, GroupName, Config], '$ct_no_change'),
173    maybe_stop_locker(Mod, GroupName, Properties),
174    Res;
175end_tc(Mod, {init_per_testcase,TC}, Config, Result, _Return) ->
176    call(fun call_generic_fallback/3, Result,
177         [post_init_per_testcase, Mod, TC, Config], '$ct_no_change');
178end_tc(Mod, {end_per_testcase,TC}, Config, Result, _Return) ->
179    call(fun call_generic_fallback/3, Result,
180         [post_end_per_testcase, Mod, TC, Config], '$ct_no_change');
181end_tc(Mod, TC = error_in_suite, Config, Result, _Return) ->
182    call(fun call_generic_fallback/3, Result,
183         [post_end_per_testcase, Mod, TC, Config], '$ct_no_change').
184
185
186%% Case = TestCase | {TestCase,GroupName}
187on_tc_skip(How, {Suite, Case, Reason}) ->
188    call(fun call_cleanup/3, {How, Reason}, [on_tc_skip, Suite, Case]).
189
190%% Case = TestCase | {TestCase,GroupName}
191on_tc_fail(_How, {Suite, Case, Reason}) ->
192    call(fun call_cleanup/3, Reason, [on_tc_fail, Suite, Case]).
193
194%% -------------------------------------------------------------------------
195%% Internal Functions
196%% -------------------------------------------------------------------------
197call_id(#ct_hook_config{ module = Mod, opts = Opts} = Hook, Config, Scope) ->
198    Id = catch_apply(Mod,id,[Opts], make_ref()),
199    {Config, Hook#ct_hook_config{ id = Id, scope = scope(Scope)}}.
200
201call_init(#ct_hook_config{ module = Mod, opts = Opts, id = Id, prio = P} = Hook,
202	  Config, _Meta) ->
203    case Mod:init(Id, Opts) of
204	{ok, NewState} when P =:= undefined ->
205	    {Config, Hook#ct_hook_config{ state = NewState, prio = 0 } };
206	{ok, NewState} ->
207	    {Config, Hook#ct_hook_config{ state = NewState } };
208	{ok, NewState, Prio} when P =:= undefined ->
209	    %% Only set prio if not already set when installing hook
210	    {Config, Hook#ct_hook_config{ state = NewState, prio = Prio } };
211	{ok, NewState, _} ->
212	    {Config, Hook#ct_hook_config{ state = NewState } };
213	NewState -> %% Keep for backward compatability reasons
214	    {Config, Hook#ct_hook_config{ state = NewState } }
215    end.
216
217call_terminate(#ct_hook_config{ module = Mod, state = State} = Hook, _, _) ->
218    catch_apply(Mod,terminate,[State], ok),
219    {[],Hook}.
220
221call_cleanup(#ct_hook_config{ module = Mod, state = State} = Hook,
222	     Reason, [Function | Args]) ->
223    NewState = catch_apply(Mod,Function, Args ++ [Reason, State],
224			   State, true),
225    {Reason, Hook#ct_hook_config{ state = NewState } }.
226
227call_generic(Hook, Value, Meta) ->
228    do_call_generic(Hook, Value, Meta, false).
229
230call_generic_fallback(Hook, Value, Meta) ->
231    do_call_generic(Hook, Value, Meta, true).
232
233do_call_generic(#ct_hook_config{ module = Mod} = Hook,
234                [{'$ct_groups',Groups}], [post_groups | Args], Fallback) ->
235    NewGroups = catch_apply(Mod, post_groups, Args ++ [Groups],
236                            Groups, Fallback),
237    {[{'$ct_groups',NewGroups}], Hook#ct_hook_config{ groups = NewGroups } };
238
239do_call_generic(#ct_hook_config{ module = Mod, groups = Groups} = Hook,
240                [{'$ct_all',Tests}], [post_all | Args], Fallback) ->
241    NewTests = catch_apply(Mod, post_all, Args ++ [Tests, Groups],
242                           Tests, Fallback),
243    {[{'$ct_all',NewTests}], Hook};
244
245do_call_generic(#ct_hook_config{ module = Mod, state = State} = Hook,
246                Value, [Function | Args], Fallback) ->
247    {NewValue, NewState} = catch_apply(Mod, Function, Args ++ [Value, State],
248				       {Value,State}, Fallback),
249    {NewValue, Hook#ct_hook_config{ state = NewState } }.
250
251%% Generic call function
252call(Fun, Config, Meta) ->
253    maybe_lock(),
254    Hooks = get_hooks(),
255    Calls = get_new_hooks(Config, Fun) ++
256	[{HookId,Fun} || #ct_hook_config{id = HookId} <- Hooks],
257    Res = call(resort(Calls,Hooks,Meta),
258	       remove(?config_name,Config), Meta, Hooks),
259    maybe_unlock(),
260    Res.
261
262call(Fun, Config, Meta, NoChangeRet) when is_function(Fun) ->
263    case call(Fun,Config,Meta) of
264	Config -> NoChangeRet;
265	NewReturn -> NewReturn
266    end;
267
268call([{Hook, call_id, NextFun} | Rest], Config, Meta, Hooks) ->
269    try
270	{Config, #ct_hook_config{ id = NewId } = NewHook} =
271	    call_id(Hook, Config, Meta),
272	{NewHooks, NewRest} =
273	    case lists:keyfind(NewId, #ct_hook_config.id, Hooks) of
274		false when NextFun =:= undefined ->
275		    {Hooks ++ [NewHook],
276		     Rest ++ [{NewId, call_init}]};
277		ExistingHook when is_tuple(ExistingHook) ->
278		    {Hooks, Rest};
279                _ when hd(Meta)=:=post_groups; hd(Meta)=:=post_all ->
280                    %% If CTH is started because of a call from
281                    %% groups/2 or all/2, CTH:init/1 must not be
282                    %% called (the suite scope should be used).
283                    {Hooks ++ [NewHook],
284		     Rest ++ [{NewId,NextFun}]};
285		_ ->
286		    {Hooks ++ [NewHook],
287		     Rest ++ [{NewId, call_init}, {NewId,NextFun}]}
288	    end,
289	call(resort(NewRest,NewHooks,Meta), Config, Meta, NewHooks)
290    catch Error:Reason:Trace ->
291	    ct_logs:log("Suite Hook","Failed to start a CTH: ~tp:~tp",
292			[Error,{Reason,Trace}]),
293	    call([], {fail,"Failed to start CTH, "
294		      "see the CT Log for details"}, Meta, Hooks)
295    end;
296call([{HookId, call_init} | Rest], Config, Meta, Hooks) ->
297    call([{HookId, fun call_init/3} | Rest], Config, Meta, Hooks);
298call([{HookId, Fun} | Rest], Config, Meta, Hooks) ->
299    try
300        Hook = lists:keyfind(HookId, #ct_hook_config.id, Hooks),
301        {NewConf, NewHook} =  Fun(Hook, Config, Meta),
302        NewCalls = get_new_hooks(NewConf, Fun),
303        NewHooks = lists:keyreplace(HookId, #ct_hook_config.id, Hooks, NewHook),
304        call(resort(NewCalls ++ Rest,NewHooks,Meta), %% Resort if call_init changed prio
305	     remove(?config_name, NewConf), Meta,
306             terminate_if_scope_ends(HookId, Meta, NewHooks))
307    catch throw:{error_in_cth_call,Reason} ->
308            call(Rest, {fail, Reason}, Meta,
309                 terminate_if_scope_ends(HookId, Meta, Hooks))
310    end;
311call([], Config, _Meta, Hooks) ->
312    save_suite_data_async(Hooks),
313    Config.
314
315remove(Key,List) when is_list(List) ->
316    [Conf || Conf <- List, is_tuple(Conf) =:= false
317		 orelse element(1, Conf) =/= Key];
318remove(_, Else) ->
319    Else.
320
321%% Translate scopes, i.e. is_tuplenit_per_group,group1 -> end_per_group,group1 etc
322scope([pre_init_per_testcase, SuiteName, TC|_]) ->
323    [post_init_per_testcase, SuiteName, TC];
324scope([pre_end_per_testcase, SuiteName, TC|_]) ->
325    [post_end_per_testcase, SuiteName, TC];
326scope([pre_init_per_group, SuiteName, GroupName|_]) ->
327    [post_end_per_group, SuiteName, GroupName];
328scope([post_init_per_group, SuiteName, GroupName|_]) ->
329    [post_end_per_group, SuiteName, GroupName];
330scope([pre_init_per_suite, SuiteName|_]) ->
331    [post_end_per_suite, SuiteName];
332scope([post_init_per_suite, SuiteName|_]) ->
333    [post_end_per_suite, SuiteName];
334scope([post_groups, SuiteName|_]) ->
335    [post_groups, SuiteName];
336scope([post_all, SuiteName|_]) ->
337    [post_all, SuiteName];
338scope(init) ->
339    none.
340
341strip_config([post_init_per_testcase, SuiteName, TC|_]) ->
342    [post_init_per_testcase, SuiteName, TC];
343strip_config([post_end_per_testcase, SuiteName, TC|_]) ->
344    [post_end_per_testcase, SuiteName, TC];
345strip_config([post_init_per_group, SuiteName, GroupName|_]) ->
346    [post_init_per_group, SuiteName, GroupName];
347strip_config([post_end_per_group, SuiteName, GroupName|_]) ->
348    [post_end_per_group, SuiteName, GroupName];
349strip_config([post_init_per_suite, SuiteName|_]) ->
350    [post_init_per_suite, SuiteName];
351strip_config([post_end_per_suite, SuiteName|_]) ->
352    [post_end_per_suite, SuiteName];
353strip_config(Other) ->
354    Other.
355
356
357terminate_if_scope_ends(HookId, [on_tc_skip,Suite,{end_per_group,Name}],
358			Hooks) ->
359    terminate_if_scope_ends(HookId, [post_end_per_group, Suite, Name], Hooks);
360terminate_if_scope_ends(HookId, [on_tc_skip,Suite,end_per_suite], Hooks) ->
361    terminate_if_scope_ends(HookId, [post_end_per_suite, Suite], Hooks);
362terminate_if_scope_ends(HookId, Function0, Hooks) ->
363    Function = strip_config(Function0),
364    case lists:keyfind(HookId, #ct_hook_config.id, Hooks) of
365        #ct_hook_config{ id = HookId, scope = Function} = Hook ->
366            case Function of
367                [AllOrGroup,_] when AllOrGroup=:=post_all;
368                                    AllOrGroup=:=post_groups ->
369                    %% The scope only contains one function (post_all
370                    %% or post_groups), and init has not been called,
371                    %% so skip terminate as well.
372                    ok;
373                _ ->
374                    terminate([Hook])
375            end,
376            lists:keydelete(HookId, #ct_hook_config.id, Hooks);
377        _ ->
378            Hooks
379    end.
380
381%% Fetch hook functions
382get_new_hooks(Config, Fun) ->
383    lists:map(fun(NewHook) when is_atom(NewHook) ->
384		      {#ct_hook_config{ module = NewHook }, call_id, Fun};
385		 ({NewHook,Opts}) ->
386		      {#ct_hook_config{ module = NewHook,
387					opts = Opts}, call_id, Fun};
388		 ({NewHook,Opts,Prio}) ->
389		      {#ct_hook_config{ module = NewHook,
390					opts = Opts,
391					prio = Prio }, call_id, Fun}
392		end, get_new_hooks(Config)).
393
394get_new_hooks(Config) when is_list(Config) ->
395    lists:flatmap(fun({?config_name, HookConfigs}) when is_list(HookConfigs) ->
396			  HookConfigs;
397		     ({?config_name, HookConfig}) when is_atom(HookConfig) ->
398			  [HookConfig];
399		     (_) ->
400			  []
401		  end, Config);
402get_new_hooks(_Config) ->
403    [].
404
405get_builtin_hooks(Opts) ->
406    case proplists:get_value(enable_builtin_hooks,Opts) of
407	false ->
408	    [];
409	_Else ->
410	    [{HookConf, call_id, undefined} || HookConf <- ?BUILTIN_HOOKS]
411    end.
412
413save_suite_data_async(Hooks) ->
414    ct_util:save_suite_data_async(?config_name, Hooks).
415
416get_hooks() ->
417    lists:keysort(#ct_hook_config.prio,ct_util:read_suite_data(?config_name)).
418
419%% Sort all calls in this order:
420%% call_id < call_init < ctfirst < Priority 1 < .. < Priority N < ctlast
421%% If Hook Priority is equal, check when it has been installed and
422%% sort on that instead.
423%% If we are doing a cleanup call i.e. {post,pre}_end_per_*, all priorities
424%% are reversed. Probably want to make this sorting algorithm pluginable
425%% as some point...
426resort(Calls,Hooks,[F|_R]) when F == pre_end_per_testcase;
427				F == post_end_per_testcase;
428				F == pre_end_per_group;
429				F == post_end_per_group;
430				F == pre_end_per_suite;
431				F == post_end_per_suite ->
432    lists:reverse(resort(Calls,Hooks));
433
434resort(Calls,Hooks,_Meta) ->
435    resort(Calls,Hooks).
436
437resort(Calls, Hooks) ->
438    lists:sort(
439      fun({_,_,_},_) ->
440	      true;
441	 (_,{_,_,_}) ->
442	      false;
443	 ({_,call_init},_) ->
444	      true;
445	 (_,{_,call_init}) ->
446	      false;
447	 ({Id1,_},{Id2,_}) ->
448	      P1 = (lists:keyfind(Id1, #ct_hook_config.id, Hooks))#ct_hook_config.prio,
449	      P2 = (lists:keyfind(Id2, #ct_hook_config.id, Hooks))#ct_hook_config.prio,
450	      if
451		  P1 == P2 ->
452		      %% If priorities are equal, we check the position in the
453		      %% hooks list
454		      pos(Id1,Hooks) < pos(Id2,Hooks);
455		  P1 == ctfirst ->
456		      true;
457		  P2 == ctfirst ->
458		      false;
459		  P1 == ctlast ->
460		      false;
461		  P2 == ctlast ->
462		      true;
463		  true ->
464		      P1 < P2
465	      end
466      end,Calls).
467
468pos(Id,Hooks) ->
469    pos(Id,Hooks,0).
470pos(Id,[#ct_hook_config{ id = Id}|_],Num) ->
471    Num;
472pos(Id,[_|Rest],Num) ->
473    pos(Id,Rest,Num+1).
474
475
476catch_apply(M,F,A, Default) ->
477    catch_apply(M,F,A,Default,false).
478catch_apply(M,F,A, Default, Fallback) ->
479    not erlang:module_loaded(M) andalso (catch M:module_info()),
480    case erlang:function_exported(M,F,length(A)) of
481        false when Fallback ->
482            catch_apply(M,F,tl(A),Default,false);
483        false ->
484            Default;
485        true ->
486            catch_apply(M,F,A)
487    end.
488
489catch_apply(M,F,A) ->
490    try
491        erlang:apply(M,F,A)
492    catch _:Reason:Trace ->
493            ct_logs:log("Suite Hook","Call to CTH failed: ~w:~tp",
494                            [error,{Reason,Trace}]),
495            throw({error_in_cth_call,
496                   lists:flatten(
497                     io_lib:format("~w:~tw/~w CTH call failed",
498                                   [M,F,length(A)]))})
499    end.
500
501
502%% We need to lock around the state for parallel groups only. This is because
503%% we will get several processes reading and writing the state for a single
504%% cth at the same time.
505maybe_start_locker(Mod,GroupName,Opts) ->
506    case lists:member(parallel,Opts) of
507	true ->
508	    {ok, _Pid} = ct_hooks_lock:start({Mod,GroupName}),
509	    ok;
510	false ->
511	    ok
512    end.
513
514maybe_stop_locker(Mod,GroupName,Opts) ->
515    case lists:member(parallel,Opts) of
516	true ->
517	    stopped = ct_hooks_lock:stop({Mod,GroupName});
518	false ->
519	    ok
520    end.
521
522
523maybe_lock() ->
524    locked = ct_hooks_lock:request().
525
526maybe_unlock() ->
527    unlocked = ct_hooks_lock:release().
528