1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2006-2017. 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
22%%%-------------------------------------------------------------------
23%%% File    : long_timer_test.erl
24%%% Author  : Rickard Green <rickard.s.green@ericsson.com>
25%%% Description :
26%%%
27%%% Created : 21 Aug 2006 by Rickard Green <rickard.s.green@ericsson.com>
28%%%-------------------------------------------------------------------
29
30-define(HIGH_CPU_INFO, "Ignored due to high CPU utilization.").
31-define(MISSING_CPU_INFO, "Ignored due to missing CPU utilization information.").
32
33-define(MAX_TIMEOUT, 60). % Minutes
34-define(MAX_LATE_MS, 1000). % Milliseconds
35-define(REG_NAME, '___LONG___TIMERS___TEST___SERVER___').
36
37-define(HIGH_UTIL, 96.0).
38-define(UTIL_INTERVAL, 10000).
39
40-define(DRV_NAME, timer_driver).
41
42% First byte in communication with the timer driver
43-define(START_TIMER, 0).
44-define(CANCEL_TIMER, 1).
45-define(DELAY_START_TIMER, 2).
46-define(TIMER, 3).
47-define(CANCELLED, 4).
48
49-module(long_timers_test).
50
51-export([start/1, check_result/0]).
52
53-record(timeout_rec,{pid, type, timeout, timeout_diff}).
54
55start(DrvDir) when is_list(DrvDir) ->
56    Starter = self(),
57    StartDone = make_ref(),
58    stop_node(full_node_name(?REG_NAME)),
59    Node = start_node(?REG_NAME),
60    Test = spawn(Node, fun () -> test(Starter, DrvDir, StartDone) end),
61    Mon = erlang:monitor(process, Test),
62    receive
63	StartDone ->
64	    erlang:demonitor(Mon),
65	    net_kernel:disconnect(Node),
66	    receive {'DOWN',Mon,_,_,_} -> ok after 0 -> ok end;
67	{'DOWN',Mon,_,_,Reason} ->
68	    stop_node(full_node_name(?REG_NAME)),
69	    {error, Reason}
70    end.
71
72check_result() ->
73    Node = full_node_name(?REG_NAME),
74    LTTS = {?REG_NAME, Node},
75    Mon = erlang:monitor(process, LTTS),
76    (catch LTTS ! {get_result, ?REG_NAME, self()}),
77    receive
78	{'DOWN', Mon, process, _, Reason} ->
79	    {?REG_NAME, 'DOWN', Reason};
80	{result, ?REG_NAME, TORs, Start, End, UtilData} ->
81	    erlang:demonitor(Mon),
82	    receive {'DOWN', Mon, _, _, _} -> ok after 0 -> ok end,
83	    stop_node(Node),
84	    Res = check(TORs, Start, End, UtilData, ms((End - Start) - max_late()), ok),
85	    io:format("Start = ~p~n End = ~p~n UtilData = ~p~n", [Start, End, UtilData]),
86	    Res
87    end.
88
89res(New, Old) when New == failed; Old == failed ->
90    failed;
91res(New, Old) when New == missing_cpu_info; Old == missing_cpu_info ->
92    missing_cpu_info;
93res(New, Old) when New == high_cpu; Old == high_cpu ->
94    high_cpu;
95res(New, _Old) ->
96    New.
97
98check([#timeout_rec{timeout = Timeout,
99		    type = Type,
100		    timeout_diff = undefined} | TORs],
101      Start,
102      End,
103      UtilData,
104      NeedRes,
105      Ok) when Timeout < NeedRes ->
106    {NewOk, HCPU} = case had_high_cpu_util(Start,
107					   Timeout,
108					   End - Timeout*1000,
109					   UtilData) of
110			yes -> {res(high_cpu, Ok), ?HIGH_CPU_INFO};
111			no -> {res(failed, Ok), ""};
112			missing -> {res(missing_cpu_info, Ok), "FAILED", ?MISSING_CPU_INFO}
113		    end,
114    io:format("~p timeout = ~p ms FAILED! No timeout. ~s~n",
115	      [Type, Timeout, HCPU]),
116    check(TORs, Start, End, UtilData, NeedRes, NewOk);
117check([#timeout_rec{timeout_diff = undefined} | TORs],
118      Start,
119      End,
120      UtilData,
121      NeedRes,
122      Ok) ->
123    check(TORs, Start, End, UtilData, NeedRes, Ok);
124check([#timeout_rec{timeout = Timeout,
125		    type = Type,
126		    timeout_diff = {error, Reason}} | TORs],
127      Start,
128      End,
129      UtilData,
130      NeedRes,
131      _Ok) ->
132    io:format("~p timeout = ~p ms FAILED! exit reason ~p~n",
133	      [Type, Timeout, Reason]),
134    check(TORs, Start, End, UtilData, NeedRes, failed);
135check([#timeout_rec{timeout = Timeout,
136		    type = Type,
137		    timeout_diff = TimeoutDiff} | TORs],
138      Start,
139      End,
140      UtilData,
141      NeedRes,
142      Ok) ->
143    {NewOk, SuccessStr, HCPU} = case {(0 =< TimeoutDiff),
144				     (TimeoutDiff =< max_late())} of
145				    {true, true} ->
146					{res(ok, Ok), "succeeded", ""};
147				    {false, _} ->
148					{res(failed, Ok), "FAILED", ""};
149				    _ ->
150					case had_high_cpu_util(Start,
151							       Timeout,
152							       TimeoutDiff,
153							       UtilData) of
154					    yes -> {res(high_cpu, Ok), "FAILED", ?HIGH_CPU_INFO};
155					    no -> {res(failed, Ok), "FAILED", ""};
156					    missing -> {res(missing_cpu_info, Ok), "FAILED", ?MISSING_CPU_INFO}
157					end
158			  end,
159    io:format("~s timeout = ~s ms ~s! timeout diff = ~s. ~s~n",
160	      [type_str(Type),
161	       time_str(Timeout),
162	       SuccessStr,
163	       time_str(TimeoutDiff, 1000000),
164	       HCPU]),
165    check(TORs, Start, End, UtilData, NeedRes, NewOk);
166check([],_Start,_End,_UtilData,_NeedRes, Ok) ->
167    Ok.
168
169% TargetTimeout in ms, other in us.
170had_high_cpu_util(StartTime,
171		  TargetTimeout,
172		  TimeoutDiff,
173		  UtilData) ->
174    TargetTo = StartTime + TargetTimeout*1000,
175    ActTo = TargetTo + TimeoutDiff,
176    hcpu(ActTo, TargetTo, UtilData).
177
178hcpu(_ActTo, _TargetTo, [{_UT, 0} | _]) ->
179    missing; %% Util is the integer zero when not supported...
180%% UT2 =:= UT1
181hcpu(ActTo, TargetTo, [{UT, _}, {UT, _} | _] = UD) ->
182    hcpu(ActTo, TargetTo, tl(UD));
183%% UT2 > UT1 > ActTo > TargetTo
184hcpu(ActTo, TargetTo, [{_UT2, _}, {UT1, _} | _] = UD) when UT1 > ActTo ->
185    hcpu(ActTo, TargetTo, tl(UD));
186%% UT2 >= ActTo > TargetTo >= UT1
187hcpu(ActTo, TargetTo,
188     [{UT2, U}, {UT1, _} | _]) when UT2 >= ActTo,
189				    TargetTo >= UT1 ->
190    case U >= (((ActTo - TargetTo) / (UT2 - UT1))
191	       * (?HIGH_UTIL/100.0)) of
192	true -> yes;
193	false -> no
194    end;
195%% UT2 >= ActTo >= UT1 > TargetTo
196hcpu(ActTo, TargetTo,
197     [{UT2, U}, {UT1, _} | _] = UD) when UT2 >= ActTo,
198					 ActTo >= UT1,
199					 UT1 > TargetTo ->
200    case U >= (((ActTo - UT1) / (UT2 - UT1))
201	       * (?HIGH_UTIL/100.0)) of
202	true -> hcpu(ActTo, TargetTo, tl(UD));
203	false -> no
204    end;
205%% ActTo > UT2 >= TargetTo >= UT1
206hcpu(ActTo, TargetTo,
207     [{UT2, U}, {UT1, _} | _]) when ActTo > UT2,
208				    TargetTo >= UT1 ->
209    case U >= (((UT2 - TargetTo) / (UT2 - UT1))
210	       * (?HIGH_UTIL/100.0)) of
211	true -> yes;
212	false -> no
213    end;
214%% ActTo > UT2 > UT1 > TargetTo
215hcpu(ActTo, TargetTo,
216     [{UT2, U}, {UT1, _} | _] = UD) when ActTo > UT2,
217					 UT1 > TargetTo ->
218    case U >= ?HIGH_UTIL of
219	true -> hcpu(ActTo, TargetTo, tl(UD));
220	false -> no
221    end.
222
223type_str(receive_after) -> "receive ... after";
224type_str(bif_timer) -> "BIF timer";
225type_str(driver) -> "driver".
226
227time_str(Time, Unit) ->
228    lists:flatten([time_str(Time), " ", unit_str(Unit)]).
229
230time_str(Time) ->
231    lists:reverse(conv_time_str(lists:reverse(integer_to_list(Time)))).
232
233conv_time_str([X,Y,Z,C|Cs]) when C /= $- ->
234    [X,Y,Z,$`|conv_time_str([C|Cs])];
235conv_time_str(Cs) ->
236    Cs.
237
238unit_str(1) -> "s";
239unit_str(1000) -> "ms";
240unit_str(1000000) -> "us";
241unit_str(1000000000) -> "ns";
242unit_str(Res) when is_integer(Res) -> ["/ ", integer_to_list(Res), " s"];
243unit_str(Res) -> Res.
244
245to_diff(Timeout, Start, Stop) ->
246    %% 'Timeout' in milli seconds
247    %% 'Start', 'Stop', and result in micro seconds
248    (Stop - Start) - Timeout*1000.
249
250ms(Time) ->
251    erlang:convert_time_unit(Time, microsecond, millisecond).
252
253max_late() ->
254    erlang:convert_time_unit(?MAX_LATE_MS, millisecond, microsecond).
255
256receive_after(Timeout) ->
257    Start = erlang:monotonic_time(microsecond),
258    receive
259	{get_result, ?REG_NAME} ->
260	    ?REG_NAME ! #timeout_rec{pid = self(),
261				     type = receive_after,
262				     timeout = Timeout}
263    after Timeout ->
264	    Stop = erlang:monotonic_time(microsecond),
265	    receive
266		{get_result, ?REG_NAME} ->
267		    ?REG_NAME ! #timeout_rec{pid = self(),
268					     type = receive_after,
269					     timeout = Timeout,
270					     timeout_diff = to_diff(Timeout,
271								    Start,
272								    Stop)}
273	    end
274    end.
275
276driver(Timeout) ->
277    Port = open_port({spawn, ?DRV_NAME},[]),
278    link(Port),
279    Start = erlang:monotonic_time(microsecond),
280    erlang:port_command(Port, <<?START_TIMER, Timeout:32>>),
281    receive
282	{get_result, ?REG_NAME} ->
283	    ?REG_NAME ! #timeout_rec{pid = self(),
284				     type = driver,
285				     timeout = Timeout};
286	{Port,{data,[?TIMER]}} ->
287	    Stop = erlang:monotonic_time(microsecond),
288	    unlink(Port),
289	    true = erlang:port_close(Port),
290	    receive
291		{get_result, ?REG_NAME} ->
292		    ?REG_NAME ! #timeout_rec{pid = self(),
293					     type = driver,
294					     timeout = Timeout,
295					     timeout_diff = to_diff(Timeout,
296								    Start,
297								    Stop)}
298	    end
299    end.
300
301bif_timer(Timeout) ->
302    Start = erlang:monotonic_time(microsecond),
303    Tmr = erlang:start_timer(Timeout, self(), ok),
304    receive
305	{get_result, ?REG_NAME} ->
306	    ?REG_NAME ! #timeout_rec{pid = self(),
307				     type = bif_timer,
308				     timeout = Timeout};
309	{timeout, Tmr, ok} ->
310	    Stop = erlang:monotonic_time(microsecond),
311	    receive
312		{get_result, ?REG_NAME} ->
313		    ?REG_NAME ! #timeout_rec{pid = self(),
314					     type = bif_timer,
315					     timeout = Timeout,
316					     timeout_diff = to_diff(Timeout,
317								    Start,
318								    Stop)}
319	    end
320    end.
321
322test(Starter, DrvDir, StartDone) ->
323    process_flag(priority, high),
324    erl_ddll:start(),
325    ok = load_driver(DrvDir, ?DRV_NAME),
326    process_flag(trap_exit, true),
327    register(?REG_NAME, self()),
328    {group_leader, GL} = process_info(whereis(net_kernel),group_leader),
329    group_leader(GL, self()),
330    try
331	application:start(sasl),
332	application:start(os_mon)
333    catch
334	_ : _ ->
335	    ok
336    end,
337    UtilData = new_util(),
338    Start = erlang:monotonic_time(microsecond),
339    TORs = lists:map(fun (Min) ->
340			     TO = Min*60*1000,
341			     [#timeout_rec{pid = spawn_opt(
342						   fun () ->
343							   receive_after(TO)
344						   end,
345						   [link, {priority, high}]),
346					   type = receive_after,
347					   timeout = TO},
348			      #timeout_rec{pid = spawn_opt(
349						   fun () ->
350							   driver(TO)
351						   end,
352						   [link, {priority, high}]),
353					   type = driver,
354					   timeout = TO},
355			      #timeout_rec{pid = spawn_opt(
356						   fun () ->
357							   bif_timer(TO)
358						   end,
359						   [link, {priority, high}]),
360					   type = bif_timer,
361					   timeout = TO}]
362		     end,
363		     lists:seq(1, ?MAX_TIMEOUT)),
364    FlatTORs = lists:flatten(TORs),
365    Starter ! StartDone,
366    test_loop(FlatTORs, Start, UtilData).
367
368new_util() ->
369    new_util([]).
370
371new_util(UtilData) ->
372    Util = cpu_sup:util(),
373    Time = erlang:monotonic_time(microsecond),
374    [{Time, Util} | UtilData].
375
376test_loop(TORs, Start, UtilData) ->
377    receive
378	{get_result, ?REG_NAME, Pid} ->
379	    End = erlang:monotonic_time(microsecond),
380	    EndUtilData = new_util(UtilData),
381	    Pid ! {result, ?REG_NAME, get_test_results(TORs), Start, End, EndUtilData},
382	    erl_ddll:unload_driver(?DRV_NAME),
383	    erl_ddll:stop(),
384	    exit(bye)
385    after ?UTIL_INTERVAL ->
386	    test_loop(TORs, Start, new_util(UtilData))
387    end.
388
389get_test_results(TORs) ->
390    lists:foreach(fun (#timeout_rec{pid = Pid}) ->
391			  Pid ! {get_result, ?REG_NAME}
392		  end,
393		  TORs),
394    get_test_results(TORs, []).
395
396get_test_results([#timeout_rec{pid = Pid,
397			       timeout = Timeout} = TOR | TORs], NewTORs) ->
398    receive
399	#timeout_rec{pid = Pid, timeout = Timeout} = NewTOR ->
400	    get_test_results(TORs, [NewTOR | NewTORs]);
401	#timeout_rec{pid = Pid} = NewTOR ->
402	    exit({timeout_mismatch, TOR, NewTOR});
403	{'EXIT', Pid, Reason} ->
404	    get_test_results(TORs,
405			     [TOR#timeout_rec{timeout_diff = {error, Reason}}
406			      | NewTORs])
407	end;
408get_test_results([], NewTORs) ->
409    lists:reverse(NewTORs).
410
411mk_node_cmdline(Name) ->
412    Static = "-detached -noinput",
413    Pa = filename:dirname(code:which(?MODULE)),
414    Prog = case catch init:get_argument(progname) of
415	       {ok,[[P]]} -> P;
416	       _ -> exit(no_progname_argument_found)
417	   end,
418    NameSw = case net_kernel:longnames() of
419		 false -> "-sname ";
420		 true -> "-name ";
421		 _ -> exit(not_distributed_node)
422	     end,
423    {ok, Pwd} = file:get_cwd(),
424    NameStr = atom_to_list(Name),
425    Prog ++ " "
426	++ Static ++ " "
427	++ NameSw ++ " " ++ NameStr ++ " "
428	++ "-pa " ++ Pa ++ " "
429	++ "-env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ NameStr ++ " "
430	++ "-setcookie " ++ atom_to_list(erlang:get_cookie()).
431
432full_node_name(PreName) ->
433    HostSuffix = lists:dropwhile(fun ($@) -> false; (_) -> true end,
434				 atom_to_list(node())),
435    list_to_atom(atom_to_list(PreName) ++ HostSuffix).
436
437ping_node(_Node, 0) ->
438    pang;
439ping_node(Node, N) when is_integer(N), N > 0 ->
440    case catch net_adm:ping(Node) of
441	pong -> pong;
442	_ ->
443	    receive after 100 -> ok end,
444	    ping_node(Node, N-1)
445    end.
446
447start_node(Name) ->
448    FullName = full_node_name(Name),
449    CmdLine = mk_node_cmdline(Name),
450    io:format("Starting node ~p: ~s~n", [FullName, CmdLine]),
451    case open_port({spawn, CmdLine}, []) of
452	Port when is_port(Port) ->
453	    unlink(Port),
454	    erlang:port_close(Port),
455	    case ping_node(FullName, 50) of
456		pong -> FullName;
457		Other -> exit({failed_to_start_node, FullName, Other})
458	    end;
459	Error ->
460	    exit({failed_to_start_node, FullName, Error})
461    end.
462
463stop_node(Node) ->
464    monitor_node(Node, true),
465    spawn(Node, fun () -> halt() end),
466    receive {nodedown, Node} -> ok end.
467
468load_driver(Dir, Driver) ->
469    case erl_ddll:load_driver(Dir, Driver) of
470	ok -> ok;
471	{error, Error} = Res ->
472	    io:format("~s\n", [erl_ddll:format_error(Error)]),
473	    Res
474    end.
475