%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%%
%% %CopyrightEnd%
%%
%%%-------------------------------------------------------------------
%%% File : long_timer_test.erl
%%% Author : Rickard Green <[email protected]>
%%% Description :
%%%
%%% Created : 21 Aug 2006 by Rickard Green <[email protected]>
%%%-------------------------------------------------------------------
-define(MAX_TIMEOUT, 60). % Minutes
-define(MAX_LATE, 10*1000). % Milliseconds
-define(REG_NAME, '___LONG___TIMERS___TEST___SERVER___').
-define(DRV_NAME, timer_driver).
% First byte in communication with the timer driver
-define(START_TIMER, 0).
-define(CANCEL_TIMER, 1).
-define(DELAY_START_TIMER, 2).
-define(TIMER, 3).
-define(CANCELLED, 4).
-module(long_timers_test).
-export([start/1, check_result/0]).
-record(timeout_rec,{pid, type, timeout, timeout_diff}).
start(DrvDir) when is_list(DrvDir) ->
Starter = self(),
StartDone = make_ref(),
stop_node(full_node_name(?REG_NAME)),
Node = start_node(?REG_NAME),
Test = spawn(Node, fun () -> test(Starter, DrvDir, StartDone) end),
Mon = erlang:monitor(process, Test),
receive
StartDone ->
erlang:demonitor(Mon),
net_kernel:disconnect(Node),
receive {'DOWN',Mon,_,_,_} -> ok after 0 -> ok end;
{'DOWN',Mon,_,_,Reason} ->
stop_node(full_node_name(?REG_NAME)),
{error, Reason}
end.
check_result() ->
Node = full_node_name(?REG_NAME),
LTTS = {?REG_NAME, Node},
Mon = erlang:monitor(process, LTTS),
(catch LTTS ! {get_result, ?REG_NAME, self()}),
receive
{'DOWN', Mon, process, _, Reason} ->
{?REG_NAME, 'DOWN', Reason};
{result, ?REG_NAME, TORs, Start, End} ->
erlang:demonitor(Mon),
receive {'DOWN', Mon, _, _, _} -> ok after 0 -> ok end,
stop_node(Node),
check(TORs, (timer:now_diff(End, Start) div 1000) - ?MAX_LATE, ok)
end.
check([#timeout_rec{timeout = Timeout,
type = Type,
timeout_diff = undefined} | TORs],
NeedRes,
_Ok) when Timeout < NeedRes ->
io:format("~p timeout = ~p failed! No timeout.~n",
[Type, Timeout]),
check(TORs, NeedRes, failed);
check([#timeout_rec{timeout_diff = undefined} | TORs],
NeedRes,
Ok) ->
check(TORs, NeedRes, Ok);
check([#timeout_rec{timeout = Timeout,
type = Type,
timeout_diff = {error, Reason}} | TORs],
NeedRes,
_Ok) ->
io:format("~p timeout = ~p failed! exit reason ~p~n",
[Type, Timeout, Reason]),
check(TORs, NeedRes, failed);
check([#timeout_rec{timeout = Timeout,
type = Type,
timeout_diff = TimeoutDiff} | TORs],
NeedRes,
Ok) ->
case (0 =< TimeoutDiff) and (TimeoutDiff =< ?MAX_LATE) of
true ->
io:format("~p timeout = ~p succeded! timeout diff = ~p.~n",
[Type, Timeout, TimeoutDiff]),
check(TORs, NeedRes, Ok);
false ->
io:format("~p timeout = ~p failed! timeout diff = ~p.~n",
[Type, Timeout, TimeoutDiff]),
check(TORs, NeedRes, failed)
end;
check([], _NeedRes, Ok) ->
Ok.
receive_after(Timeout) ->
Start = now(),
receive
{get_result, ?REG_NAME} ->
?REG_NAME ! #timeout_rec{pid = self(),
type = receive_after,
timeout = Timeout}
after Timeout ->
Stop = now(),
receive
{get_result, ?REG_NAME} ->
TimeoutDiff = ((timer:now_diff(Stop, Start) div 1000)
- Timeout),
?REG_NAME ! #timeout_rec{pid = self(),
type = receive_after,
timeout = Timeout,
timeout_diff = TimeoutDiff}
end
end.
driver(Timeout) ->
Port = open_port({spawn, ?DRV_NAME},[]),
link(Port),
Start = now(),
erlang:port_command(Port, <<?START_TIMER, Timeout:32>>),
receive
{get_result, ?REG_NAME} ->
?REG_NAME ! #timeout_rec{pid = self(),
type = driver,
timeout = Timeout};
{Port,{data,[?TIMER]}} ->
Stop = now(),
unlink(Port),
true = erlang:port_close(Port),
receive
{get_result, ?REG_NAME} ->
TimeoutDiff = ((timer:now_diff(Stop, Start) div 1000)
- Timeout),
?REG_NAME ! #timeout_rec{pid = self(),
type = driver,
timeout = Timeout,
timeout_diff = TimeoutDiff}
end
end.
bif_timer(Timeout) ->
Tmr = erlang:start_timer(Timeout, self(), ok),
Start = now(),
receive
{get_result, ?REG_NAME} ->
?REG_NAME ! #timeout_rec{pid = self(),
type = bif_timer,
timeout = Timeout};
{timeout, Tmr, ok} ->
Stop = now(),
receive
{get_result, ?REG_NAME} ->
TimeoutDiff = ((timer:now_diff(Stop, Start) div 1000)
- Timeout),
?REG_NAME ! #timeout_rec{pid = self(),
type = bif_timer,
timeout = Timeout,
timeout_diff = TimeoutDiff}
end
end.
test(Starter, DrvDir, StartDone) ->
erl_ddll:start(),
ok = load_driver(DrvDir, ?DRV_NAME),
process_flag(trap_exit, true),
register(?REG_NAME, self()),
{group_leader, GL} = process_info(whereis(net_kernel),group_leader),
group_leader(GL, self()),
Start = now(),
TORs = lists:map(fun (Min) ->
TO = Min*60*1000,
[#timeout_rec{pid = spawn_opt(
fun () ->
receive_after(TO)
end,
[link, {priority, high}]),
type = receive_after,
timeout = TO},
#timeout_rec{pid = spawn_opt(
fun () ->
driver(TO)
end,
[link, {priority, high}]),
type = driver,
timeout = TO},
#timeout_rec{pid = spawn_opt(
fun () ->
bif_timer(TO)
end,
[link, {priority, high}]),
type = bif_timer,
timeout = TO}]
end,
lists:seq(1, ?MAX_TIMEOUT)),
FlatTORs = lists:flatten(TORs),
Starter ! StartDone,
test_loop(FlatTORs, Start).
test_loop(TORs, Start) ->
receive
{get_result, ?REG_NAME, Pid} ->
End = now(),
Pid ! {result, ?REG_NAME, get_test_results(TORs), Start, End},
erl_ddll:unload_driver(?DRV_NAME),
erl_ddll:stop(),
exit(bye)
end.
get_test_results(TORs) ->
lists:foreach(fun (#timeout_rec{pid = Pid}) ->
Pid ! {get_result, ?REG_NAME}
end,
TORs),
get_test_results(TORs, []).
get_test_results([#timeout_rec{pid = Pid,
timeout = Timeout} = TOR | TORs], NewTORs) ->
receive
#timeout_rec{pid = Pid, timeout = Timeout} = NewTOR ->
get_test_results(TORs, [NewTOR | NewTORs]);
#timeout_rec{pid = Pid} = NewTOR ->
exit({timeout_mismatch, TOR, NewTOR});
{'EXIT', Pid, Reason} ->
get_test_results(TORs,
[TOR#timeout_rec{timeout_diff = {error, Reason}}
| NewTORs])
end;
get_test_results([], NewTORs) ->
lists:reverse(NewTORs).
mk_node_cmdline(Name) ->
Static = "-detached -noinput",
Pa = filename:dirname(code:which(?MODULE)),
Prog = case catch init:get_argument(progname) of
{ok,[[P]]} -> P;
_ -> exit(no_progname_argument_found)
end,
NameSw = case net_kernel:longnames() of
false -> "-sname ";
true -> "-name ";
_ -> exit(not_distributed_node)
end,
{ok, Pwd} = file:get_cwd(),
NameStr = atom_to_list(Name),
Prog ++ " "
++ Static ++ " "
++ NameSw ++ " " ++ NameStr ++ " "
++ "-pa " ++ Pa ++ " "
++ "-env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ NameStr ++ " "
++ "-setcookie " ++ atom_to_list(erlang:get_cookie()).
full_node_name(PreName) ->
HostSuffix = lists:dropwhile(fun ($@) -> false; (_) -> true end,
atom_to_list(node())),
list_to_atom(atom_to_list(PreName) ++ HostSuffix).
ping_node(_Node, 0) ->
pang;
ping_node(Node, N) when is_integer(N), N > 0 ->
case catch net_adm:ping(Node) of
pong -> pong;
_ ->
receive after 100 -> ok end,
ping_node(Node, N-1)
end.
start_node(Name) ->
FullName = full_node_name(Name),
CmdLine = mk_node_cmdline(Name),
io:format("Starting node ~p: ~s~n", [FullName, CmdLine]),
case open_port({spawn, CmdLine}, []) of
Port when is_port(Port) ->
unlink(Port),
erlang:port_close(Port),
case ping_node(FullName, 50) of
pong -> FullName;
Other -> exit({failed_to_start_node, FullName, Other})
end;
Error ->
exit({failed_to_start_node, FullName, Error})
end.
stop_node(Node) ->
monitor_node(Node, true),
spawn(Node, fun () -> halt() end),
receive {nodedown, Node} -> ok end.
load_driver(Dir, Driver) ->
case erl_ddll:load_driver(Dir, Driver) of
ok -> ok;
{error, Error} = Res ->
io:format("~s\n", [erl_ddll:format_error(Error)]),
Res
end.
