1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2007-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
21%%% doc Common Test Framework module that handles repeated test runs
22%%%
23%%% This module exports functions for repeating tests. The following
24%%% start flags (or equivalent ct:run_test/1 options) are supported:
25%%% -until <StopTime>, StopTime = YYMoMoDDHHMMSS | HHMMSS
26%%% -duration <DurTime>, DurTime = HHMMSS
27%%% -force_stop [skip_rest]
28%%% -repeat <N>, N = integer()
29
30-module(ct_repeat).
31
32%% Script interface
33-export([loop_test/2]).
34-export([log_loop_info/1]).
35
36%%----------------------------------------------------------
37%% Flags:
38%%----------------------------------------------------------
39
40loop_test(If,Args) when is_list(Args) ->
41    {ok,Cwd} = file:get_cwd(),
42    case get_loop_info(Args) of
43	no_loop ->
44	    false;
45	E = {error,_} ->
46	    io:format("Common Test error: ~tp\n\n",[E]),
47	    ok = file:set_cwd(Cwd),
48	    E;
49	{repeat,N} ->
50	    io:format("\nCommon Test: Will repeat tests ~w times.\n\n",[N]),
51	    Args1 = [{loop_info,[{repeat,1,N}]} | Args],
52	    Result = loop(If,repeat,0,N,undefined,Args1,undefined,[]),
53	    ok = file:set_cwd(Cwd),
54	    Result;
55	{stop_time,StopTime} ->
56	    Result =
57		case remaining_time(StopTime) of
58		    0 ->
59			io:format("\nCommon Test: "
60				  "No time left to run tests.\n\n",[]),
61			{error,not_enough_time};
62		    Secs ->
63			io:format("\nCommon Test: "
64				  "Will repeat tests for ~s.\n\n",[ts(Secs)]),
65			TPid =
66			    case proplists:get_value(force_stop,Args) of
67				False when False==false; False==undefined ->
68				    undefined;
69				ForceStop ->
70				    CtrlPid = self(),
71				    spawn(
72				      fun() ->
73                                              ct_util:mark_process(),
74					      stop_after(CtrlPid,Secs,ForceStop)
75				      end)
76			    end,
77			Args1 = [{loop_info,[{stop_time,Secs,StopTime,1}]} | Args],
78			loop(If,stop_time,0,Secs,StopTime,Args1,TPid,[])
79		end,
80	    ok = file:set_cwd(Cwd),
81	    Result
82    end.
83
84loop(_,repeat,N,N,_,_Args,_,AccResult) ->
85    lists:reverse(AccResult);
86
87loop(If,Type,N,Data0,Data1,Args,TPid,AccResult) ->
88    Pid = spawn_tester(If,self(),Args),
89    receive
90	{'EXIT',Pid,Reason} ->
91	    case Reason of
92		{user_error,What} ->
93		    io:format("\nTest run failed!\nReason: ~tp\n\n\n", [What]),
94		    cancel(TPid),
95		    {error,What};
96		_ ->
97		    io:format("Test run crashed! This could be an internal error "
98			      "- please report!\n\n"
99			      "~tp\n\n\n",[Reason]),
100		    cancel(TPid),
101		    {error,Reason}
102	    end;
103	{Pid,{error,Reason}} ->
104	    io:format("\nTest run failed!\nReason: ~tp\n\n\n",[Reason]),
105	    cancel(TPid),
106	    {error,Reason};
107	{Pid,Result} ->
108	    if Type == repeat ->
109		    io:format("\nTest run ~w(~w) complete.\n\n\n",[N+1,Data0]),
110		    lists:keydelete(loop_info,1,Args),
111		    Args1 = [{loop_info,[{repeat,N+2,Data0}]} | Args],
112		    loop(If,repeat,N+1,Data0,Data1,Args1,TPid,[Result|AccResult]);
113	       Type == stop_time ->
114		    case remaining_time(Data1) of
115			0 ->
116			    io:format("\nTest time (~s) has run out.\n\n\n",
117				      [ts(Data0)]),
118			    cancel(TPid),
119			    lists:reverse([Result|AccResult]);
120			Secs ->
121			    io:format("\n~s of test time remaining, "
122				      "starting run #~w...\n\n\n",
123				      [ts(Secs),N+2]),
124			    lists:keydelete(loop_info,1,Args),
125			    ST = {stop_time,Data0,Data1,N+2},
126			    Args1 = [{loop_info,[ST]} | Args],
127			    loop(If,stop_time,N+1,Data0,Data1,Args1,TPid,
128				 [Result|AccResult])
129		    end
130	    end
131    end.
132
133spawn_tester(script,Ctrl,Args) ->
134    spawn_link(fun() -> ct_run:script_start1(Ctrl,Args) end);
135
136spawn_tester(func,Ctrl,Opts) ->
137    Tester = fun() ->
138                     ct_util:mark_process(),
139		     case catch ct_run:run_test2(Opts) of
140			 {'EXIT',Reason} ->
141			     exit(Reason);
142			 Result ->
143			     Ctrl ! {self(),Result}
144		     end
145	     end,
146    spawn_link(Tester).
147
148remaining_time(StopTime) ->
149    Now = calendar:datetime_to_gregorian_seconds(calendar:local_time()),
150    Diff = StopTime - Now,
151    if Diff > 0 ->
152	    Diff;
153       true ->
154	    0
155    end.
156
157get_loop_info(Args) when is_list(Args) ->
158    case lists:keysearch(until,1,Args) of
159	{value,{until,Time}} ->
160	    Time1 = delistify(Time),
161	    case catch get_stop_time(until,Time1) of
162		{'EXIT',_} ->
163		    {error,{bad_time_format,Time1}};
164		Stop ->
165		    {stop_time,Stop}
166	    end;
167	false ->
168	    case lists:keysearch(duration,1,Args) of
169		{value,{duration,Time}} ->
170		    Time1 = delistify(Time),
171		    case catch get_stop_time(duration,Time1) of
172			{'EXIT',_} ->
173			    {error,{bad_time_format,Time1}};
174			Stop ->
175			    {stop_time,Stop}
176		    end;
177		false ->
178		    case lists:keysearch(repeat,1,Args) of
179			{value,{repeat,R}} ->
180			    case R of
181				N when is_integer(N), N>0 ->
182				    {repeat,N};
183				[Str] ->
184				    case catch list_to_integer(Str) of
185					N when is_integer(N), N>0 ->
186					    {repeat,N};
187					_ ->
188					    {error,{invalid_repeat_value,Str}}
189				    end;
190				_ ->
191				    {error,{invalid_repeat_value,R}}
192			    end;
193			false ->
194			    no_loop
195		    end
196	    end
197    end.
198
199get_stop_time(until,[Y1,Y2,Mo1,Mo2,D1,D2,H1,H2,Mi1,Mi2,S1,S2]) ->
200    Date =
201	case [Mo1,Mo2] of
202	    "00" ->
203		date();
204	    _ ->
205		Y = list_to_integer([Y1,Y2]),
206		Mo = list_to_integer([Mo1,Mo2]),
207		D = list_to_integer([D1,D2]),
208		{YNow,_,_} = date(),
209		Dec = trunc(YNow/100),
210		Year =
211		    if Y < (YNow-Dec*100) -> (Dec+1)*100 + Y;
212		       true -> Dec*100 + Y
213		    end,
214		{Year,Mo,D}
215	end,
216    Time = {list_to_integer([H1,H2]),
217	    list_to_integer([Mi1,Mi2]),
218	    list_to_integer([S1,S2])},
219    calendar:datetime_to_gregorian_seconds({Date,Time});
220
221get_stop_time(until,Time=[_,_,_,_,_,_]) ->
222    get_stop_time(until,"000000"++Time);
223
224get_stop_time(duration,[H1,H2,Mi1,Mi2,S1,S2]) ->
225    Secs =
226	list_to_integer([H1,H2]) * 3600 +
227	list_to_integer([Mi1,Mi2]) * 60 +
228	list_to_integer([S1,S2]),
229    calendar:datetime_to_gregorian_seconds(calendar:local_time()) + Secs.
230
231cancel(Pid) ->
232    catch exit(Pid,kill).
233
234%% After Secs, abort will make the test_server finish the current
235%% job, then empty the job queue and stop.
236stop_after(_CtrlPid,Secs,ForceStop) ->
237    timer:sleep(Secs*1000),
238    case ForceStop of
239	SkipRest when SkipRest==skip_rest; SkipRest==["skip_rest"] ->
240	    ct_util:set_testdata({skip_rest,true});
241	_ ->
242	    ok
243    end,
244    test_server_ctrl:abort().
245
246
247%% Callback from ct_run to print loop info to system log.
248log_loop_info(Args) ->
249    case lists:keysearch(loop_info,1,Args) of
250	false ->
251	    ok;
252	{value,{_,[{repeat,C,N}]}} ->
253	    ct_logs:log("Test loop info","Test run ~w of ~w",[C,N]);
254	{value,{_,[{stop_time,Secs0,StopTime,N}]}} ->
255	    LogStr1 =
256		case lists:keysearch(duration,1,Args) of
257		    {value,{_,Dur}} ->
258			io_lib:format("Specified test duration: ~s (~w secs)\n",
259				      [delistify(Dur),Secs0]);
260		_ ->
261		    case lists:keysearch(until,1,Args) of
262			{value,{_,Until}} ->
263			    io_lib:format("Specified end time: ~s (duration ~w secs)\n",
264					  [delistify(Until),Secs0]);
265			_ ->
266			    ok
267		    end
268	    end,
269	    LogStr2 = io_lib:format("Test run #~w\n", [N]),
270	    Secs = remaining_time(StopTime),
271	    LogStr3 =
272		io_lib:format("Test time remaining: ~w secs (~w%)\n",
273			      [Secs,trunc((Secs/Secs0)*100)]),
274	    LogStr4 =
275		case proplists:get_value(force_stop,Args) of
276		    False when False==false; False==undefined ->
277			"";
278		    ForceStop ->
279			io_lib:format("force_stop is set to: ~w",[ForceStop])
280		end,
281	    ct_logs:log("Test loop info","~ts", [LogStr1++LogStr2++LogStr3++LogStr4])
282    end.
283
284ts(Secs) ->
285    integer_to_list(Secs) ++ " secs".
286
287delistify([X]) ->
288    X;
289delistify(X) ->
290    X.
291