%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 2006-2010. 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 %%% Description : %%% %%% Created : 21 Aug 2006 by Rickard Green %%%------------------------------------------------------------------- -define(MAX_TIMEOUT, 60). % Minutes -define(MAX_LATE_MS, 15*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, ms((End - Start) - 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 ms 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 ms 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) -> {NewOk, SuccessStr} = case ((0 =< TimeoutDiff) andalso (TimeoutDiff =< max_late())) of true -> {Ok, "succeeded"}; false -> {failed, "FAILED"} end, io:format("~s timeout = ~s ms ~s! timeout diff = ~s.~n", [type_str(Type), time_str(Timeout), SuccessStr, time_str(TimeoutDiff, erlang:convert_time_unit(1, seconds, native))]), check(TORs, NeedRes, NewOk); check([], _NeedRes, Ok) -> Ok. type_str(receive_after) -> "receive ... after"; type_str(bif_timer) -> "BIF timer"; type_str(driver) -> "driver". time_str(Time, Unit) -> lists:flatten([time_str(Time), " ", unit_str(Unit)]). time_str(Time) -> lists:reverse(conv_time_str(lists:reverse(integer_to_list(Time)))). conv_time_str([X,Y,Z,C|Cs]) when C /= $- -> [X,Y,Z,$`|conv_time_str([C|Cs])]; conv_time_str(Cs) -> Cs. unit_str(1) -> "s"; unit_str(1000) -> "ms"; unit_str(1000000) -> "us"; unit_str(1000000000) -> "ns"; unit_str(Res) when is_integer(Res) -> ["/ ", integer_to_list(Res), " s"]; unit_str(Res) -> Res. to_diff(Timeout, Start, Stop) -> %% 'Timeout' in milli seconds %% 'Start', 'Stop', and result in native unit (Stop - Start) - erlang:convert_time_unit(Timeout, milli_seconds, native). ms(Time) -> erlang:convert_time_unit(Time, native, milli_seconds). max_late() -> erlang:convert_time_unit(?MAX_LATE_MS, milli_seconds, native). receive_after(Timeout) -> Start = erlang:monotonic_time(), receive {get_result, ?REG_NAME} -> ?REG_NAME ! #timeout_rec{pid = self(), type = receive_after, timeout = Timeout} after Timeout -> Stop = erlang:monotonic_time(), receive {get_result, ?REG_NAME} -> ?REG_NAME ! #timeout_rec{pid = self(), type = receive_after, timeout = Timeout, timeout_diff = to_diff(Timeout, Start, Stop)} end end. driver(Timeout) -> Port = open_port({spawn, ?DRV_NAME},[]), link(Port), Start = erlang:monotonic_time(), erlang:port_command(Port, <>), receive {get_result, ?REG_NAME} -> ?REG_NAME ! #timeout_rec{pid = self(), type = driver, timeout = Timeout}; {Port,{data,[?TIMER]}} -> Stop = erlang:monotonic_time(), unlink(Port), true = erlang:port_close(Port), receive {get_result, ?REG_NAME} -> ?REG_NAME ! #timeout_rec{pid = self(), type = driver, timeout = Timeout, timeout_diff = to_diff(Timeout, Start, Stop)} end end. bif_timer(Timeout) -> Start = erlang:monotonic_time(), Tmr = erlang:start_timer(Timeout, self(), ok), receive {get_result, ?REG_NAME} -> ?REG_NAME ! #timeout_rec{pid = self(), type = bif_timer, timeout = Timeout}; {timeout, Tmr, ok} -> Stop = erlang:monotonic_time(), receive {get_result, ?REG_NAME} -> ?REG_NAME ! #timeout_rec{pid = self(), type = bif_timer, timeout = Timeout, timeout_diff = to_diff(Timeout, Start, Stop)} 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 = erlang:monotonic_time(), 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 = erlang:monotonic_time(), 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.