aboutsummaryrefslogblamecommitdiffstats
path: root/erts/emulator/test/long_timers_test.erl
blob: 8dd960ffd49c2cfafcee44c2b9030fdbd4148d60 (plain) (tree)
1
2
3
4


                   
                                                        

























                                                                         
                                             













































                                                                       
                                                           






                                                      
                                                         










                                                            
                                                            






                                                        










                                                                                     


                          
































                                                                              
                         
                                    





                                                          
                                           

                                          


                                                                  


                                                                            





                                            
                                    






                                                            
                                           



                                           


                                                               


                                                                            



                     
                                    
                                                  





                                                        
                                           

                                          


                                                               


                                                                            









                                                                        
                                    































                                                                             
                                          



























































































                                                                                
%%
%% %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 <[email protected]>
%%% Description : 
%%%
%%% Created : 21 Aug 2006 by Rickard Green <[email protected]>
%%%-------------------------------------------------------------------


-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, <<?START_TIMER, Timeout:32>>),
    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.