1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2009-2018. 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-module(reltool_test_lib).
21-compile([export_all, nowarn_export_all]).
22
23-include("reltool_test_lib.hrl").
24-define(timeout, 20). % minutes
25
26%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
27
28init_per_suite(Config) when is_list(Config)->
29    global:register_name(reltool_global_logger, group_leader()),
30    incr_timetrap(Config, ?timeout).
31
32end_per_suite(Config) when is_list(Config)->
33    global:unregister_name(reltool_global_logger),
34    ok.
35
36incr_timetrap(Config, Times) ->
37    Key = tc_timeout,
38    KeyPos = 1,
39    NewTime =
40	case lists:keysearch(Key, KeyPos, Config) of
41	    {value, {Key, OldTime}} ->
42		(timer:minutes(1) + OldTime) * Times;
43	    false ->
44		timer:minutes(1) * Times
45	end,
46    lists:keystore(Key, KeyPos, Config, {Key, NewTime}).
47
48set_kill_timer(Config) ->
49    case init:get_argument(reltool_test_timeout) of
50	{ok, _} ->
51	    Config;
52	_ ->
53	    Time =
54		case lookup_config(tc_timeout, Config) of
55		    [] ->
56			timer:minutes(?timeout);
57		    ConfigTime when is_integer(ConfigTime) ->
58			ConfigTime
59		end,
60	    WatchDog = test_server:timetrap(Time),
61	    [{kill_timer, WatchDog} | Config]
62    end.
63
64reset_kill_timer(Config) ->
65    DogKiller =
66	case get(reltool_test_server) of
67	    true ->
68		fun(P) when is_pid(P) -> P ! stop;
69		   (_) -> ok
70		end;
71	    _ ->
72		fun(Ref) -> test_server:timetrap_cancel(Ref) end
73	end,
74    case lists:keysearch(kill_timer, 1, Config) of
75	{value, {kill_timer, WatchDog}} ->
76	    DogKiller(WatchDog),
77	    lists:keydelete(kill_timer, 1, Config);
78	_ ->
79	    Config
80    end.
81
82lookup_config(Key,Config) ->
83    case lists:keysearch(Key, 1, Config) of
84	{value,{Key,Val}} ->
85	    Val;
86	_ ->
87	    []
88    end.
89%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
90
91wx_init_per_suite(Config) ->
92    {_Pid, Ref} =
93	spawn_monitor(fun() ->
94			      %% Avoid test case crash if wx master process dies
95			      process_flag(trap_exit, true),
96			      try
97				  case os:type() of
98				      {unix,darwin} ->
99					  exit({skipped, "Can not test on MacOSX"});
100				      {unix, _} ->
101					  io:format("DISPLAY ~s~n", [os:getenv("DISPLAY")]),
102					  case ct:get_config(xserver, none) of
103					      none   -> ignore;
104					      Server -> os:putenv("DISPLAY", Server)
105					  end;
106				      _ ->
107					  ignore
108				  end,
109				  wx:new(),
110				  wx:destroy()
111			      catch
112				  error:undef ->
113				      exit({skipped, "No wx compiled for this platform"});
114				    _:Reason ->
115				      exit({skipped, lists:flatten(io_lib:format("Start wx failed: ~p", [Reason]))})
116			      end,
117			      exit(normal)
118		      end),
119    receive
120	{'DOWN', Ref, _, _, normal} ->
121	    init_per_suite(Config);
122	{'DOWN', Ref, _, _, {skipped, _} = Skipped} ->
123	    Skipped;
124	{'DOWN', Ref, _, _, Reason} ->
125	    exit({wx_init_per_suite, Reason})
126    after timer:minutes(1) ->
127	    exit({wx_init_per_suite, timeout})
128    end.
129
130wx_end_per_suite(Config) ->
131    end_per_suite(Config).
132
133%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
134
135init_per_testcase(_Func, Config) when is_list(Config) ->
136    set_kill_timer(Config),
137    Config.
138
139end_per_testcase(_Func, Config) when is_list(Config) ->
140    reset_kill_timer(Config),
141    Config.
142
143%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
144
145%% Use ?log(Format, Args) as wrapper
146log(Format, Args, LongFile, Line) ->
147    File = filename:basename(LongFile),
148    Format2 = lists:concat([File, "(", Line, ")", ": ", Format]),
149    log(Format2, Args).
150
151log(Format, Args) ->
152    case global:whereis_name(reltool_global_logger) of
153	undefined ->
154	    io:format(user, Format, Args);
155	Pid ->
156	    io:format(Pid, Format, Args)
157    end.
158
159verbose(Format, Args, File, Line) ->
160    Arg = reltool_test_verbose,
161    case get(Arg) of
162	false ->
163	    ok;
164	true ->
165	    log(Format, Args, File, Line);
166	undefined ->
167	    case init:get_argument(Arg) of
168		{ok, List} when is_list(List) ->
169		    case lists:last(List) of
170			["true"] ->
171			    put(Arg, true),
172			    log(Format, Args, File, Line);
173			_ ->
174			    put(Arg, false),
175			    ok
176		    end;
177		_ ->
178		    put(Arg, false),
179		    ok
180	    end
181    end.
182
183error(Format, Args, File, Line) ->
184    global:send(reltool_global_logger, {failed, File, Line}),
185    Fail = {filename:basename(File),Line,Args},
186    case global:whereis_name(reltool_test_case_sup) of
187	undefined -> ignore;
188	Pid -> Pid ! Fail
189	    %% 	    global:send(reltool_test_case_sup, Fail),
190    end,
191    log("<ERROR>~n" ++ Format, Args, File, Line).
192
193
194pick_msg() ->
195    receive
196	Message -> Message
197    after 4000 -> timeout
198    end.
199
200%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
201%% Utility functions
202
203user_available(Config) ->
204    false /= proplists:get_value(user, Config, false).
205
206
207wx_destroy(Frame, Config) ->
208    case proplists:get_value(user, Config, false) of
209	false ->
210	    timer:sleep(100),
211	    ?m(ok, wxFrame:destroy(Frame)),
212	    ?m(ok, wx:destroy());
213	true ->
214	    timer:sleep(500),
215	    ?m(ok, wxFrame:destroy(Frame)),
216	    ?m(ok, wx:destroy());
217	step -> %% Wait for user to close window
218	    ?m(ok, wxEvtHandler:connect(Frame, close_window, [{skip,true}])),
219	    wait_for_close()
220    end.
221
222wait_for_close() ->
223    receive
224	#wx{event=#wxClose{}} ->
225	    ?log("Got close~n",[]),
226	    ?m(ok, wx:destroy());
227	#wx{obj=Obj, event=Event} ->
228	    try
229		Name = wxTopLevelWindow:getTitle(Obj),
230		?log("~p Event: ~p~n", [Name, Event])
231	    catch _:_ ->
232		?log("Event: ~p~n", [Event])
233	    end,
234	    wait_for_close();
235	Other ->
236	    ?log("Unexpected: ~p~n", [Other]),
237	    wait_for_close()
238    end.
239
240erl_libs() ->
241    lists:sort([filename:absname(P) || P<-reltool_utils:erl_libs()]).
242
243%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
244%% A small test server, which can be run standalone in a shell
245
246run_test(Test = {_,_},Config) ->
247    run_test([Test],Config);
248run_test([{Module, TC} | Rest], Config) ->
249    log("\n\n=== Eval test suite: ~w ===~n", [Module]),
250    case catch Module:init_per_suite(Config) of
251	{skipped, Reason} ->
252	    log("Test suite skipped: ~s~n", [Reason]),
253	    [{skipped, Reason}];
254	NewConfig when is_list(NewConfig) ->
255	    Res =
256		if
257		    TC =:= all ->
258			[do_run_test(Module, Test, NewConfig) || Test <- Module:all()];
259		    is_list(TC) ->
260			[do_run_test(Module, Test, NewConfig) || Test <- TC];
261		    true ->
262			[do_run_test(Module, TC, NewConfig)]
263		end,
264            CommonTestRes = worst_res(Res),
265	    Res ++ run_test(Rest, [{tc_status,CommonTestRes}|NewConfig]);
266	Error ->
267	    ?error("Test suite skipped: ~w~n", [Error]),
268	    [{skipped, Error}]
269    end;
270run_test([], _Config) ->
271    [].
272
273worst_res(Res) ->
274    NewRes = [{dummy, {ok,dummy, dummy}} | Res],
275    [{_,WorstRes}|_] = lists:sort(fun compare_res/2, NewRes),
276    common_test_res(WorstRes).
277
278common_test_res(ok) ->
279    ok;
280common_test_res({Res,_,Reason}) ->
281    common_test_res({Res,Reason});
282common_test_res({Res,Reason}) ->
283    case Res of
284        ok      -> ok;
285        skip    -> {skipped, Reason};
286        skipped -> {skipped, Reason};
287        failed  -> {failed, Reason};
288        crash   -> {failed, Reason}
289    end.
290
291% crash < failed < skip < ok
292compare_res({_,{ResA,_,_}},{_,{ResB,_,_}}) ->
293    res_to_int(ResA) < res_to_int(ResB).
294
295res_to_int(Res) ->
296    case Res of
297        ok     -> 4;
298        skip   -> 3;
299        failed -> 2;
300        crash  -> 1
301    end.
302
303do_run_test(Module, all, Config) ->
304    All = [{Module, Test} || Test <- Module:all()],
305    run_test(All, Config);
306do_run_test(Module, TestCase, Config) ->
307    log("Eval test case: ~w~n", [{Module, TestCase}]),
308    Sec = timer:seconds(1) * 1000,
309    {T, Res} =
310	timer:tc(?MODULE, eval_test_case, [Module, TestCase, Config]),
311    log("Tested ~w in ~w sec~n", [TestCase, T div Sec]),
312    {T div Sec, Res}.
313
314eval_test_case(Mod, Fun, Config) ->
315    flush(),
316    global:register_name(reltool_test_case_sup, self()),
317    Flag = process_flag(trap_exit, true),
318    Pid = spawn_link(?MODULE, test_case_evaluator, [Mod, Fun, [Config]]),
319    R = wait_for_evaluator(Pid, Mod, Fun, Config),
320    global:unregister_name(reltool_test_case_sup),
321    process_flag(trap_exit, Flag),
322    R.
323
324test_case_evaluator(Mod, Fun, [Config]) ->
325    NewConfig = Mod:init_per_testcase(Fun, Config),
326    Res = apply(Mod, Fun, [NewConfig]),
327    CommonTestRes = common_test_res(Res),
328    Mod:end_per_testcase(Fun, [{tc_status,CommonTestRes}|NewConfig]),
329    exit({test_case_ok, Res}).
330
331wait_for_evaluator(Pid, Mod, Fun, Config) ->
332    receive
333	{'EXIT', Pid, {test_case_ok, _PidRes}} ->
334	    Errors = flush(),
335	    Res =
336		case Errors of
337		    [] -> ok;
338		    Errors -> failed
339		end,
340	    {Res, {Mod, Fun}, Errors};
341	{'EXIT', Pid, {skipped, Reason}} ->
342	    log("<WARNING> Test case ~w skipped, because ~p~n",
343		[{Mod, Fun}, Reason]),
344            Res = {skipped, {Mod, Fun}, Reason},
345            CommonTestRes = common_test_res(Res),
346	    Mod:end_per_testcase(Fun, [{tc_status,CommonTestRes}|Config]),
347	    Res;
348	{'EXIT', Pid, Reason} ->
349	    log("<ERROR> Eval process ~w exited, because\n\t~p~n",
350		[{Mod, Fun}, Reason]),
351            Res = {crash, {Mod, Fun}, Reason},
352            CommonTestRes = common_test_res(Res),
353            Mod:end_per_testcase(Fun, [{tc_status,CommonTestRes}|Config]),
354	    Res
355    end.
356
357flush() ->
358    receive Msg -> [Msg | flush()]
359    after 0 -> []
360    end.
361
362
363%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
364