%% %% %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 <rickard.s.green@ericsson.com> %%% Description : %%% %%% Created : 21 Aug 2006 by Rickard Green <rickard.s.green@ericsson.com> %%%------------------------------------------------------------------- -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.