path: root/lib/test_server/src/test_server.erl

%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1996-2012. 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%
%%
-module(test_server).

-define(DEFAULT_TIMETRAP_SECS, 60).

%%% START %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([start/1,start/2]).

%%% TEST_SERVER_CTRL INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([run_test_case_apply/1,init_target_info/0,init_purify/0]).
-export([cover_compile/1,cover_analyse/3]).

%%% TEST_SERVER_SUP INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([get_loc/1]).

%%% TEST SUITE INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([lookup_config/2]).
-export([fail/0,fail/1,format/1,format/2,format/3]).
-export([capture_start/0,capture_stop/0,capture_get/0]).
-export([messages_get/0]).
-export([permit_io/2]).
-export([hours/1,minutes/1,seconds/1,sleep/1,adjusted_sleep/1,timecall/3]).
-export([timetrap_scale_factor/0,timetrap/1,get_timetrap_info/0,
	 timetrap_cancel/1,timetrap_cancel/0]).
-export([m_out_of_n/3,do_times/4,do_times/2]).
-export([call_crash/3,call_crash/4,call_crash/5]).
-export([temp_name/1]).
-export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]).
-export([app_test/1, app_test/2]).
-export([is_native/1]).
-export([comment/1, make_priv_dir/0]).
-export([os_type/0]).
-export([run_on_shielded_node/2]).
-export([is_cover/0,is_debug/0,is_commercial/0]).

-export([break/1,break/2,break/3,continue/0,continue/1]).

%%% DEBUGGER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([purify_new_leaks/0, purify_format/2, purify_new_fds_inuse/0,
	 purify_is_running/0]).

%%% PRIVATE EXPORTED %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-record(state,{controller,jobs=[]}).

-include("test_server_internal.hrl").
-include_lib("kernel/include/file.hrl").

-define(pl2a(M), test_server_sup:package_atom(M)).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% **** START *** CODE FOR REMOTE TARGET ONLY ***
%%
%% test_server
%% This process is started only if the test is to be run on a remote target
%% The process is then started on target
%% A socket connection is established with the test_server_ctrl process
%% on host, and information about target is sent to host.
start([ControllerHost]) when is_atom(ControllerHost) ->
    start(atom_to_list(ControllerHost));
start(ControllerHost) when is_list(ControllerHost) ->
    start(ControllerHost,?MAIN_PORT).
start(ControllerHost,ControllerPort) ->
    S = self(),
    Pid = spawn(fun() -> init(ControllerHost,ControllerPort,S) end),
    receive {Pid,started} -> {ok,Pid};
	    {Pid,Error} -> Error
    end.

init(Host,Port,Starter) ->
    global:register_name(?MODULE,self()),
    process_flag(trap_exit,true),
    test_server_sup:cleanup_crash_dumps(),
    case gen_tcp:connect(Host,Port, [binary,
				     {reuseaddr,true},
				     {packet,2}]) of
	{ok,MainSock} ->
	    Starter ! {self(),started},
	    request(MainSock,{target_info,init_target_info()}),
	    loop(#state{controller={Host,MainSock}});
	Error ->
	    Starter ! {self(),{error,
			       {could_not_contact_controller,Error}}}
    end.

init_target_info() ->
    [$.|Emu] = code:objfile_extension(),
    {_, OTPRel} = init:script_id(),
    TestServerDir = filename:absname(filename:dirname(code:which(?MODULE))),
    #target_info{os_family=test_server_sup:get_os_family(),
		 os_type=os:type(),
		 version=erlang:system_info(version),
		 system_version=erlang:system_info(system_version),
		 root_dir=code:root_dir(),
		 test_server_dir=TestServerDir,
		 emulator=Emu,
		 otp_release=OTPRel,
		 username=test_server_sup:get_username(),
		 cookie=atom_to_list(erlang:get_cookie())}.


loop(#state{controller={_,MainSock}} = State) ->
    receive
	{tcp, MainSock, <<1,Request/binary>>} ->
	    State1 = decode_main(binary_to_term(Request),State),
	    loop(State1);
	{tcp_closed, MainSock} ->
	    gen_tcp:close(MainSock),
	    halt();
	{'EXIT',Pid,Reason} ->
	    case lists:keysearch(Pid,1,State#state.jobs) of
		{value,{Pid,Name}} ->
		    case Reason of
			normal -> ignore;
			_other -> request(MainSock,{job_proc_killed,Name,Reason})
		    end,
		    NewJobs = lists:keydelete(Pid,1,State#state.jobs),
		    loop(State#state{jobs = NewJobs});
		false ->
		    loop(State)
	    end
    end.

%% Decode request on main socket
decode_main({job,Port,Name},#state{controller={Host,_},jobs=Jobs}=State) ->
    S = self(),
    NewJob = spawn_link(fun() -> job(Host,Port,S) end),
    receive {NewJob,started} -> State#state{jobs=[{NewJob,Name}|Jobs]};
	    {NewJob,_Error} -> State
    end.

init_purify() ->
    purify_new_leaks().


%% Temporary job process on target
%% This process will live while all test cases in the job are executed.
%% A socket connection is established with the job process on host.
job(Host,Port,Starter) ->
    process_flag(trap_exit,true),
    init_purify(),
    case gen_tcp:connect(Host,Port, [binary,
				     {reuseaddr,true},
				     {packet,4},
				     {active,false}]) of
	{ok,JobSock} ->
	    Starter ! {self(),started},
	    job(JobSock);
	Error ->
	    Starter ! {self(),{error,
			       {could_not_contact_controller,Error}}}
    end.

job(JobSock) ->
    JobDir = get_jobdir(),
    ok = file:make_dir(JobDir),
    ok = file:make_dir(filename:join(JobDir,?priv_dir)),
    put(test_server_job_sock,JobSock),
    put(test_server_job_dir,JobDir),
    {ok,Cwd} = file:get_cwd(),
    job_loop(JobSock),
    ok = file:set_cwd(Cwd),
    send_privdir(JobDir,JobSock), % also recursively removes jobdir
    ok.


get_jobdir() ->
    Now = now(),
    {{Y,M,D},{H,Mi,S}} = calendar:now_to_local_time(Now),
    Basename = io_lib:format("~w-~2.2.0w-~2.2.0w_~2.2.0w.~2.2.0w.~2.2.0w_~w",
			     [Y,M,D,H,Mi,S,element(3,Now)]),
    %% if target has a file master, don't use prim_file to look up cwd
    case lists:keymember(master,1,init:get_arguments()) of
	true ->
	    {ok,Cwd} = file:get_cwd(),
	    Cwd ++ "/" ++ Basename;
	false ->
	    filename:absname(Basename)
    end.

send_privdir(JobDir,JobSock) ->
    LocalPrivDir = filename:join(JobDir,?priv_dir),
    case file:list_dir(LocalPrivDir) of
	{ok,List} when List/=[] ->
	    Tarfile0 = ?priv_dir ++ ".tar.gz",
	    Tarfile = filename:join(JobDir,Tarfile0),
	    {ok,Tar} = erl_tar:open(Tarfile,[write,compressed,cooked]),
	    ok = erl_tar:add(Tar,LocalPrivDir,?priv_dir,[]),
	    ok = erl_tar:close(Tar),
	    {ok,TarBin} = file:read_file(Tarfile),
	    file:delete(Tarfile),
	    ok = del_dir(JobDir),
	    request(JobSock,{{privdir,Tarfile0},TarBin});
	_ ->
	    ok = del_dir(JobDir),
	    request(JobSock,{privdir,empty_priv_dir})
    end.

del_dir(Dir) ->
    case file:read_file_info(Dir) of
	{ok,#file_info{type=directory}} ->
	    {ok,Cont} = file:list_dir(Dir),
	    lists:foreach(fun(F) -> del_dir(filename:join(Dir,F)) end, Cont),
	    ok = file:del_dir(Dir);
	{ok,#file_info{}} ->
	    ok = file:delete(Dir);
	_r ->
	    %% This might be a symlink - let's try to delete it!
	    catch file:delete(Dir),
	    ok
    end.

%%
%% Receive and decode request on job socket
%%
job_loop(JobSock) ->
    Request = recv(JobSock),
    case decode_job(Request) of
	ok -> job_loop(JobSock);
	{stop,R} -> R
    end.

decode_job({{beam,Mod,Which},Beam}) ->
    % FIXME, shared directory structure on host and target required,
    % "Library beams" are not loaded from HOST... /Patrik
    code:add_patha(filename:dirname(Which)),
    % End of Patriks uglyness...
    {module,Mod} = code:load_binary(Mod,Which,Beam),
    ok;
decode_job({{datadir,Tarfile0},Archive}) ->
    JobDir = get(test_server_job_dir),
    Tarfile = filename:join(JobDir,Tarfile0),
    ok = file:write_file(Tarfile,Archive),
    % Cooked is temporary removed/broken
    % ok = erl_tar:extract(Tarfile,[compressed,{cwd,JobDir},cooked]),
    ok = erl_tar:extract(Tarfile,[compressed,{cwd,JobDir}]),
    ok = file:delete(Tarfile),
    ok;
decode_job({test_case,Case}) ->
    Result = run_test_case_apply(Case),
    JobSock = get(test_server_job_sock),
    request(JobSock,{test_case_result,Result}),
    case test_server_sup:tar_crash_dumps() of
	{error,no_crash_dumps} -> request(JobSock,{crash_dumps,no_crash_dumps});
	{ok,TarFile} ->
	    {ok,TarBin} = file:read_file(TarFile),
	    file:delete(TarFile),
	    request(JobSock,{{crash_dumps,filename:basename(TarFile)},TarBin})
    end,
    ok;
decode_job({sync_apply,{M,F,A}}) ->
    R = apply(M,F,A),
    request(get(test_server_job_sock),{sync_result,R}),
    ok;
decode_job(job_done) ->
    {stop,stopped}.

%%
%% **** STOP *** CODE FOR REMOTE TARGET ONLY ***
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%




%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% cover_compile({App,Include,Exclude,Cross}) ->
%%                                          {ok,AnalyseModules} | {error,Reason}
%%
%% App = atom() , name of application to be compiled
%% Exclude = [atom()], list of modules to exclude
%% Include = [atom()], list of modules outside of App that should be included
%%                 in the cover compilation
%% Cross = [atoms()], list of modules outside of App shat should be included
%%                 in the cover compilation, but that shall not be part of
%%                 the cover analysis for this application.
%%
%% Cover compile the given application. Return {ok,AnalyseMods} if application
%% is found, else {error,application_not_found}.

cover_compile({none,_Exclude,Include,Cross}) ->
    CompileMods = Include++Cross,
    case length(CompileMods) of
	0 ->
	    io:fwrite("WARNING: No modules to cover compile!\n\n",[]),
	    cover:start(),			% start cover server anyway
	    {ok,[]};
	N ->
	    io:fwrite("Cover compiling ~w modules - "
		      "this may take some time... ",[N]),
	    do_cover_compile(CompileMods),
	    io:fwrite("done\n\n",[]),
	    {ok,Include}
    end;
cover_compile({App,all,Include,Cross}) ->
    CompileMods = Include++Cross,
    case length(CompileMods) of
	0 ->
	    io:fwrite("WARNING: No modules to cover compile!\n\n",[]),
	    cover:start(),			% start cover server anyway
	    {ok,[]};
	N ->
	    io:fwrite("Cover compiling '~w' (~w files) - "
		      "this may take some time... ",[App,N]),
	    io:format("\nWARNING: All modules in \'~w\' are excluded\n"
		      "Only cover compiling modules in include list "
		      "and the modules\nin the cross cover file:\n"
		      "~p\n", [App,CompileMods]),
	    do_cover_compile(CompileMods),
	    io:fwrite("done\n\n",[]),
	    {ok,Include}
    end;
cover_compile({App,Exclude,Include,Cross}) ->
    case code:lib_dir(App) of
	{error,bad_name} ->
	    case Include++Cross of
		[] ->
		    io:format("\nWARNING: Can't find lib_dir for \'~w\'\n"
			      "Not cover compiling!\n\n",[App]),
		    {error,application_not_found};
		CompileMods ->
		    io:fwrite("Cover compiling '~w' (~w files) - "
			      "this may take some time... ",
			      [App,length(CompileMods)]),
		    io:format("\nWARNING: Can't find lib_dir for \'~w\'\n"
			      "Only cover compiling modules in include list: "
			      "~p\n", [App,Include]),
		    do_cover_compile(CompileMods),
		    io:fwrite("done\n\n",[]),
		    {ok,Include}
	    end;
	LibDir ->
	    EbinDir = filename:join([LibDir,"ebin"]),
	    WC = filename:join(EbinDir,"*.beam"),
	    AllMods = module_names(filelib:wildcard(WC)),
	    AnalyseMods = (AllMods ++ Include) -- Exclude,
	    CompileMods = AnalyseMods ++ Cross,
	    case length(CompileMods) of
		0 ->
		    io:fwrite("WARNING: No modules to cover compile!\n\n",[]),
		    cover:start(),		% start cover server anyway
		    {ok,[]};
		N ->
		    io:fwrite("Cover compiling '~w' (~w files) - "
			      "this may take some time... ",[App,N]),
		    do_cover_compile(CompileMods),
		    io:fwrite("done\n\n",[]),
		    {ok,AnalyseMods}
	    end
    end.


module_names(Beams) ->
    [list_to_atom(filename:basename(filename:rootname(Beam))) || Beam <- Beams].


do_cover_compile(Modules) ->
    do_cover_compile1(lists:usort(Modules)). % remove duplicates

do_cover_compile1([Dont|Rest]) when Dont=:=cover ->
    do_cover_compile1(Rest);
do_cover_compile1([M|Rest]) ->
    case {code:is_sticky(M),code:is_loaded(M)} of
	{true,_} ->
	    code:unstick_mod(M),
	    case cover:compile_beam(M) of
		{ok,_} ->
		    ok;
		Error ->
		    io:fwrite("\nWARNING: Could not cover compile ~w: ~p\n",
			      [M,Error])
	    end,
	    code:stick_mod(M),
	    do_cover_compile1(Rest);
	{false,false} ->
	    case code:load_file(M) of
		{module,_} ->
		    do_cover_compile1([M|Rest]);
		Error ->
		    io:fwrite("\nWARNING: Could not load ~w: ~p\n",[M,Error]),
		    do_cover_compile1(Rest)
	    end;
	{false,_} ->
	    case cover:compile_beam(M) of
		{ok,_} ->
		    ok;
		Error ->
		    io:fwrite("\nWARNING: Could not cover compile ~w: ~p\n",
			      [M,Error])
	    end,
	    do_cover_compile1(Rest)
    end;
do_cover_compile1([]) ->
    ok.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% cover_analyse(Analyse,Modules,Stop) -> [{M,{Cov,NotCov,Details}}]
%%
%% Analyse = {details,Dir} | details | {overview,void()} | overview
%% Modules = [atom()], the modules to analyse
%%
%% Cover analysis. If this is a remote target, analyse_to_file can not be used.
%% In that case the analyse level 'line' is used instead if Analyse==details.
%%
%% If this is a local target, the test directory is given
%% (Analyse=={details,Dir}) and analyse_to_file can be used directly.
%%
%% If Analyse==overview | {overview,Dir} analyse_to_file is not used, only
%% an overview containing the number of covered/not covered lines in each module.
%%
%% Also, if a Dir exists, cover data will be exported to a file called
%% all.coverdata in that directory.
%%
%% Finally, if Stop==true, then cover will be stopped after the
%% analysis is completed. Stopping cover causes the original (non
%% cover compiled) modules to be loaded back in. If a process at this
%% point is still running old code of any of the cover compiled
%% modules, meaning that is has not done any fully qualified function
%% call after the cover compilation, the process will now be
%% killed. To avoid this scenario, it is possible to set Stop=false,
%% which means that the modules will stay cover compiled. Note that
%% this is only recommended if the erlang node is being terminated
%% after the test is completed.
cover_analyse(Analyse,Modules,Stop) ->
    io:fwrite("Cover analysing...\n",[]),
    DetailsFun =
	case Analyse of
	    {details,Dir} ->
		case cover:export(filename:join(Dir,"all.coverdata")) of
		    ok ->
			fun(M) ->
				OutFile = filename:join(Dir,
							atom_to_list(M) ++
							".COVER.html"),
				case cover:analyse_to_file(M,OutFile,[html]) of
				    {ok,_} ->
					{file,OutFile};
				    Error ->
					Error
				end
			end;
		    Error ->
			fun(_) -> Error end
		end;
	    details ->
		fun(M) ->
			case cover:analyse(M,line) of
			    {ok,Lines} ->
				{lines,Lines};
			    Error ->
				Error
			end
		end;
	    {overview,Dir} ->
		case cover:export(filename:join(Dir,"all.coverdata")) of
		    ok ->
			fun(_) -> undefined end;
		    Error ->
			fun(_) -> Error end
		end;
	    overview ->
		fun(_) -> undefined end
	end,
    R = pmap(
	  fun(M) ->
		  case cover:analyse(M,module) of
		      {ok,{M,{Cov,NotCov}}} ->
			  {M,{Cov,NotCov,DetailsFun(M)}};
		      Err ->
			  io:fwrite("WARNING: Analysis failed for ~w. Reason: ~p\n",
				    [M,Err]),
			  {M,Err}
		  end
	  end, Modules),

    case Stop of
	true ->
	    Sticky = unstick_all_sticky(node()),
	    cover:stop(),
	    stick_all_sticky(node(),Sticky);
	false ->
	    ok
    end,
    R.

pmap(Fun,List) ->
    Collector = self(),
    Pids = lists:map(fun(E) ->
			     spawn(fun() ->
					   Collector ! {res,self(),Fun(E)} 
				   end) 
		     end, List),
    lists:map(fun(Pid) ->
		      receive
			  {res,Pid,Res} ->
			      Res
		      end
	      end, Pids).


do_cover_for_node(Node,CoverFunc) ->
    %% In case a slave node is starting another slave node! I.e. this
    %% function is executed on a slave node - then the cover function
    %% must be executed on the master node. This is for instance the
    %% case in test_server's own tests.
    MainCoverNode = cover:get_main_node(),
    Sticky = unstick_all_sticky(MainCoverNode,Node),
    rpc:call(MainCoverNode,cover,CoverFunc,[Node]),
    stick_all_sticky(Node,Sticky).

unstick_all_sticky(Node) ->
    unstick_all_sticky(node(),Node).
unstick_all_sticky(MainCoverNode,Node) ->
    lists:filter(
      fun(M) ->
	      case code:is_sticky(M) of
		  true ->
		      rpc:call(Node,code,unstick_mod,[M]),
		      true;
		  false ->
		      false
	      end
      end,
      rpc:call(MainCoverNode,cover,modules,[])).

stick_all_sticky(Node,Sticky) ->
    lists:foreach(
      fun(M) ->
	      rpc:call(Node,code,stick_mod,[M])
      end,
      Sticky).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% run_test_case_apply(Mod,Func,Args,Name,RunInit,TimetrapData) ->
%%               {Time,Value,Loc,Opts,Comment} | {died,Reason,unknown,Comment}
%%
%% Time = float()   (seconds)
%% Value = term()
%% Loc = term()
%% Comment = string()
%% Reason = term()
%%
%% Spawns off a process (case process) that actually runs the test suite.
%% The case process will have the job process as group leader, which makes
%% it possible to capture all it's output from io:format/2, etc.
%%
%% The job process then sits down and waits for news from the case process.
%%
%% Returns a tuple with the time spent (in seconds) in the test case,
%% the return value from the test case or an {'EXIT',Reason} if the case
%% failed, Loc points out where the test case crashed (if it did). Loc
%% is either the name of the function, or {<Module>,<Line>} of the last
%% line executed that had a ?line macro. If the test case did execute
%% erase/0 or similar, it may be empty. Comment is the last comment added
%% by test_server:comment/1, the reason if test_server:fail has been
%% called or the comment given by the return value {comment,Comment} from
%% a test case.
%%
%% {died,Reason,unknown,Comment} is returned if the test case was killed
%% by some other process. Reason is the kill reason provided.
%%
%% TimetrapData = {MultiplyTimetrap,ScaleTimetrap}, which indicates a
%% possible extension of all timetraps. Timetraps will be multiplied by
%% MultiplyTimetrap. If it is infinity, no timetraps will be started at all.
%% ScaleTimetrap indicates if test_server should attemp to automatically
%% compensate timetraps for runtime delays introduced by e.g. tools like
%% cover.

run_test_case_apply({CaseNum,Mod,Func,Args,Name,
		     RunInit,TimetrapData}) ->
    purify_format("Test case #~w ~w:~w/1", [CaseNum, Mod, Func]),
    case os:getenv("TS_RUN_VALGRIND") of
	false ->
	    ok;
	_ ->
	    os:putenv("VALGRIND_LOGFILE_INFIX",atom_to_list(Mod)++"."++
		      atom_to_list(Func)++"-")
    end,
    test_server_h:testcase({Mod,Func,1}),
    ProcBef = erlang:system_info(process_count),
    Result = run_test_case_apply(Mod, Func, Args, Name, RunInit,
				 TimetrapData),
    ProcAft = erlang:system_info(process_count),
    purify_new_leaks(),
    DetFail = get(test_server_detected_fail),
    {Result,DetFail,ProcBef,ProcAft}.

run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
    case get(test_server_job_dir) of
	undefined ->
	    %% i'm a local target
	    do_run_test_case_apply(Mod, Func, Args, Name, RunInit,
				   TimetrapData);
	JobDir ->
	    %% i'm a remote target
	    case Args of
		[Config] when is_list(Config) ->
		    {value,{data_dir,HostDataDir}} =
			lists:keysearch(data_dir, 1, Config),
		    DataBase = filename:basename(HostDataDir),
		    TargetDataDir = filename:join(JobDir, DataBase),
		    Config1 = lists:keyreplace(data_dir, 1, Config,
					       {data_dir,TargetDataDir}),
		    TargetPrivDir = filename:join(JobDir, ?priv_dir),
		    Config2 = lists:keyreplace(priv_dir, 1, Config1,
					       {priv_dir,TargetPrivDir}),
		    do_run_test_case_apply(Mod, Func, [Config2], Name, RunInit,
					   TimetrapData);
		_other ->
		    do_run_test_case_apply(Mod, Func, Args, Name, RunInit,
					   TimetrapData)
	    end
    end.

do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
    {ok,Cwd} = file:get_cwd(),
    Args2Print = case Args of
		     [Args1] when is_list(Args1) ->
			 lists:keydelete(tc_group_result, 1, Args1);
		     _ ->
			 Args
		 end,
    print(minor, "Test case started with:\n~s:~s(~p)\n", [Mod,Func,Args2Print]),
    print(minor, "Current directory is ~p\n", [Cwd]),
    print_timestamp(minor,"Started at "),
    print(minor, "", [], internal_raw),
    TCCallback = get(test_server_testcase_callback),
    LogOpts = get(test_server_logopts),
    Ref = make_ref(),
    Pid =
	spawn_link(
	  fun() ->
		  run_test_case_eval(Mod, Func, Args, Name, Ref,
				     RunInit, TimetrapData,
				     LogOpts, TCCallback)
	  end),
    put(test_server_detected_fail, []),
    run_test_case_msgloop(Ref, Pid, false, "",
			  undefined, starting).

%% Ugly bug (pre R5A):
%% If this process (group leader of the test case) terminates before
%% all messages have been replied back to the io server, the io server
%% hangs. Fixed by the 20 milli timeout check here, and by using monitor in
%% io.erl (livrem OCH hangslen mao :)
%%
%% A test case is known to have failed if it returns {'EXIT', _} tuple,
%% or sends a message {failed, File, Line} to it's group_leader
%%
run_test_case_msgloop(Ref, Pid, Terminate, Comment, CurrConf, Status) ->
    %% NOTE: Keep job_proxy_msgloop/0 up to date when changes
    %%       are made in this function!
    {Timeout,ReturnValue} =
	case Terminate of
	    {true, ReturnVal} ->
		%% stop any timetrap timers for the test case
		%% that have been started by this process
		timetrap_cancel_all(Pid, false),
		{20, ReturnVal};
	    false ->
		{infinity, should_never_appear}
	end,
    receive
	{test_case_initialized,Pid} ->
	    run_test_case_msgloop(Ref,Pid,Terminate,
				  Comment,CurrConf,running);
	Abort = {abort_current_testcase,_,_} when Status == starting ->
	    %% we're in init phase, must must postpone this operation
	    %% until test case execution is in progress (or FW:init_tc
	    %% gets killed)
	    self() ! Abort,
	    erlang:yield(),
	    run_test_case_msgloop(Ref,Pid,Terminate,
				  Comment,CurrConf,Status);
	{abort_current_testcase,Reason,From} ->
	    Line = case is_process_alive(Pid) of
		       true -> get_loc(Pid);
		       false -> unknown
		   end,
	    Mon = erlang:monitor(process, Pid),
	    exit(Pid,{testcase_aborted,Reason,Line}),
	    erlang:yield(),
	    From ! {self(),abort_current_testcase,ok},
	    NewComment =
		receive
		    {'DOWN', Mon, process, Pid, _} ->
			Comment
		    after 10000 ->
			    %% Pid is probably trapping exits, hit it harder...
			    exit(Pid, kill),
			    %% here's the only place we know Reason, so we save
			    %% it as a comment, potentially replacing user data
			    Error = lists:flatten(io_lib:format("Aborted: ~p",
								[Reason])),
			    Error1 = lists:flatten([string:strip(S,left) ||
						    S <- string:tokens(Error,
								       [$\n])]),
			    if length(Error1) > 63 ->
				    string:substr(Error1,1,60) ++ "...";
			       true ->
				    Error1
			    end
		    end,
	    run_test_case_msgloop(Ref,Pid,Terminate,
				  NewComment,CurrConf,Status);
	{sync_apply,From,MFA} ->
	    sync_local_or_remote_apply(false,From,MFA),
	    run_test_case_msgloop(Ref,Pid,Terminate,
				  Comment,CurrConf,Status);
	{sync_apply_proxy,Proxy,From,MFA} ->
	    sync_local_or_remote_apply(Proxy,From,MFA),
	    run_test_case_msgloop(Ref,Pid,Terminate,
				  Comment,CurrConf,Status);
	{comment,NewComment} ->
	    NewComment1 = test_server_ctrl:to_string(NewComment),
	    NewComment2 = test_server_sup:framework_call(format_comment,
							 [NewComment1],
							 NewComment1),
	    Terminate1 =
		case Terminate of
		    {true,{Time,Value,Loc,Opts,_OldComment}} ->
			{true,{Time,Value,mod_loc(Loc),Opts,NewComment2}};
		    Other ->
			Other
		end,
	    run_test_case_msgloop(Ref,Pid,Terminate1,
				  NewComment2,CurrConf,Status);
	{read_comment,From} ->
	    From ! {self(),read_comment,Comment},
	    run_test_case_msgloop(Ref,Pid,Terminate,
				  Comment,CurrConf,Status);
	{set_curr_conf,From,NewCurrConf} ->
	    From ! {self(),set_curr_conf,ok},
	    run_test_case_msgloop(Ref,Pid,Terminate,
				  Comment,NewCurrConf,Status);
	{make_priv_dir,From} when CurrConf == undefined ->
	    From ! {self(),make_priv_dir,{error,no_priv_dir_in_config}},
	    run_test_case_msgloop(Ref,Pid,Terminate,
				  Comment,CurrConf,Status);
	{make_priv_dir,From} ->
	    Result =
		case proplists:get_value(priv_dir, element(2, CurrConf)) of
		    undefined ->
			{error,no_priv_dir_in_config};
		    PrivDir ->
			case file:make_dir(PrivDir) of
			    ok ->
				ok;
			    {error, eexist} ->
				ok;
			    MkDirError ->
				{error,{MkDirError,PrivDir}}
			end
		end,
	    From ! {self(),make_priv_dir,Result},
	    run_test_case_msgloop(Ref,Pid,Terminate,
				  Comment,CurrConf,Status);
	{'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} ->
	    RetVal = {Time/1000000,Value,mod_loc(Loc),Opts,Comment},
	    run_test_case_msgloop(Ref,Pid,
				  {true,RetVal},Comment,undefined,Status);
	{'EXIT',Pid,Reason} ->
	    case Reason of
		{timetrap_timeout,TVal,Loc} ->
		    %% convert Loc to form that can be formatted
		    case mod_loc(Loc) of
			{FwMod,FwFunc,framework} ->
			    %% timout during framework call
			    spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
					  {framework_error,{timetrap,TVal}},
					  unknown,self()),
			    run_test_case_msgloop(Ref,Pid,
						  Terminate,Comment,
						  undefined,Status);
			Loc1 ->
			    %% call end_per_testcase on a separate process,
			    %% only so that the user has a chance to
			    %% clean up after init_per_testcase, even after
			    %% a timetrap timeout
			    NewCurrConf =
				case CurrConf of
				    {{Mod,Func},Conf} ->
					EndConfPid =
					    call_end_conf(
					      Mod,Func,Pid,
					      {timetrap_timeout,TVal},
					      Loc1,[{tc_status,
						     {failed,
						      timetrap_timeout}}|Conf],
					      TVal),
					{EndConfPid,{Mod,Func},Conf};
				    _ ->
					{Mod,Func} = get_mf(Loc1),
					%% The framework functions mustn't
					%% execute on this group leader process
					%% or io will cause deadlock, so we
					%% spawn a dedicated process for the
					%% operation and let the group leader
					%% go back to handle io.
					spawn_fw_call(Mod,Func,CurrConf,Pid,
						      {timetrap_timeout,TVal},
						      Loc1,self()),
					undefined
				end,
			    run_test_case_msgloop(Ref,Pid,
						  Terminate,Comment,
						  NewCurrConf,Status)
		    end;
		{timetrap_timeout,TVal,Loc,InitOrEnd} ->
		    case mod_loc(Loc) of
			{FwMod,FwFunc,framework} ->
			    %% timout during framework call
			    spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
					  {framework_error,{timetrap,TVal}},
					  unknown,self());
			Loc1 ->
			    {Mod,_Func} = get_mf(Loc1),
			    spawn_fw_call(Mod,InitOrEnd,CurrConf,Pid,
					  {timetrap_timeout,TVal},
					  Loc1,self())
		    end,
		    run_test_case_msgloop(Ref,Pid,
					  Terminate,Comment,CurrConf,Status);
		{testcase_aborted,ErrorMsg={user_timetrap_error,_},AbortLoc} ->
		    %% user timetrap function caused exit
		    %% during start of test case
		    {Mod,Func} = get_mf(mod_loc(AbortLoc)),
		    spawn_fw_call(Mod,Func,CurrConf,Pid,
				  ErrorMsg,unknown,self()),
		    run_test_case_msgloop(Ref,Pid,
					  Terminate,Comment,
					  undefined,Status);		
		{testcase_aborted,AbortReason,AbortLoc} ->
		    ErrorMsg = {testcase_aborted,AbortReason},
		    case mod_loc(AbortLoc) of
			{FwMod,FwFunc,framework} ->
			    %% abort during framework call
			    spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
					  {framework_error,ErrorMsg},
					  unknown,self()),
			    run_test_case_msgloop(Ref,Pid,
						  Terminate,Comment,
						  undefined,Status);
			Loc1 ->
			    %% call end_per_testcase on a separate process,
			    %% only so that the user has a chance to clean up
			    %% after init_per_testcase, even after abortion
			    NewCurrConf =
				case CurrConf of
				    {{Mod,Func},Conf} ->
					TVal =
					    case lists:keysearch(default_timeout,
								 1,
								 Conf) of
						{value,{default_timeout,Tmo}} ->
						    Tmo;
						_ ->
						    ?DEFAULT_TIMETRAP_SECS*1000
					    end,
					EndConfPid =
					    call_end_conf(
					      Mod,Func,Pid,
					      ErrorMsg,Loc1,
					      [{tc_status,
						{failed,ErrorMsg}}|Conf],TVal),
					{EndConfPid,{Mod,Func},Conf};
				    _ ->
					{Mod,Func} = get_mf(Loc1),
					spawn_fw_call(Mod,Func,CurrConf,Pid,
						      ErrorMsg,Loc1,self()),
					undefined
				end,
			    run_test_case_msgloop(Ref,Pid,
						  Terminate,Comment,
						  NewCurrConf,Status)
		    end;
		killed ->
		    %% result of an exit(TestCase,kill) call, which is the
		    %% only way to abort a testcase process that traps exits
		    %% (see abort_current_testcase)
		    {Mod,Func} = case CurrConf of
				     {MF,_} -> MF;
				     _      -> {undefined,undefined}
				 end,
		    spawn_fw_call(Mod,Func,CurrConf,Pid,
				  testcase_aborted_or_killed,
				  unknown,self()),
		    run_test_case_msgloop(Ref,Pid,
					  Terminate,Comment,CurrConf,Status);
		{fw_error,{FwMod,FwFunc,FwError}} ->
		    spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
				  {framework_error,FwError},
				  unknown,self()),
		    run_test_case_msgloop(Ref,Pid,
					  Terminate,Comment,CurrConf,Status);
		_Other ->
		    %% the testcase has terminated because of Reason (e.g. an exit
		    %% because a linked process failed)
		    {Mod,Func} = case CurrConf of
				     {MF,_} -> MF;
				     _      -> {undefined,undefined}
				 end,
		    spawn_fw_call(Mod,Func,CurrConf,Pid,
				  Reason,unknown,self()),
		    run_test_case_msgloop(Ref,Pid,
					  Terminate,Comment,CurrConf,Status)
	    end;
	{EndConfPid,{call_end_conf,Data,_Result}} ->
	    case CurrConf of
		{EndConfPid,{Mod,Func},_Conf} ->
		    {_Mod,_Func,TCPid,TCExitReason,Loc} = Data,
		    spawn_fw_call(Mod,Func,CurrConf,TCPid,
				  TCExitReason,Loc,self()),
		    run_test_case_msgloop(Ref,Pid,
					  Terminate,Comment,undefined,Status);
		_ ->
		    run_test_case_msgloop(Ref,Pid,
					  Terminate,Comment,CurrConf,Status)
	    end;
	{_FwCallPid,fw_notify_done,{T,Value,Loc,Opts,AddToComment}} ->
	    %% the framework has been notified, we're finished
	    RetVal =
		case AddToComment of
		    undefined ->
			{T,Value,Loc,Opts,Comment};
		    _ ->
			Comment1 =
			    if Comment == "" -> 
				    AddToComment;
			       true -> 
				    Comment ++
				    test_server_ctrl:xhtml("<br>",
							   "<br />") ++
				    AddToComment
			    end,
			{T,Value,Loc,Opts,Comment1}
		end,
	    run_test_case_msgloop(Ref,Pid,
				  {true,RetVal},Comment,undefined,Status);
 	{'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} ->
	    %% a framework function failed
	    CB = os:getenv("TEST_SERVER_FRAMEWORK"),
	    Loc = case CB of
		      FW when FW =:= false; FW =:= "undefined" ->
			  {test_server,Func};
		      _ ->
			  {list_to_atom(CB),Func}
		  end,
	    RetVal = {died,{framework_error,Loc,Error},Loc,"Framework error"},
	    run_test_case_msgloop(Ref,Pid,
				  {true,RetVal},Comment,undefined,Status);
	{failed,File,Line} ->
	    put(test_server_detected_fail,
		[{File, Line}| get(test_server_detected_fail)]),
	    run_test_case_msgloop(Ref,Pid,
				  Terminate,Comment,CurrConf,Status);

	{user_timetrap,Pid,_TrapTime,StartTime,E={user_timetrap_error,_},_} ->
	    case update_user_timetraps(Pid, StartTime) of
		proceed ->
		    self() ! {abort_current_testcase,E,Pid};
		ignore ->
		    ok
	    end,
	    run_test_case_msgloop(Ref,Pid,
				  Terminate,Comment,CurrConf,Status);
	{user_timetrap,Pid,TrapTime,StartTime,ElapsedTime,Scale} ->
	    %% a user timetrap is triggered, ignore it if new
	    %% timetrap has been started since
	    case update_user_timetraps(Pid, StartTime) of
		proceed ->
		    TotalTime = if is_integer(TrapTime) -> 
					TrapTime + ElapsedTime;
				   true -> 
					TrapTime
				end,
		    timetrap(TrapTime, TotalTime, Pid, Scale);
		ignore ->
		    ok
	    end,
	    run_test_case_msgloop(Ref,Pid,
				  Terminate,Comment,CurrConf,Status);
	{timetrap_cancel_one,Handle,_From} ->
	    timetrap_cancel_one(Handle, false),
	    run_test_case_msgloop(Ref,Pid,
				  Terminate,Comment,CurrConf,Status);
	{timetrap_cancel_all,TCPid,_From} ->
	    timetrap_cancel_all(TCPid, false),
	    run_test_case_msgloop(Ref,Pid,
				  Terminate,Comment,CurrConf,Status);
	{get_timetrap_info,From,TCPid} ->
	    Info = get_timetrap_info(TCPid, false),
	    From ! {self(),get_timetrap_info,Info},
	    run_test_case_msgloop(Ref,Pid,
				  Terminate,Comment,CurrConf,Status);
	_Other when not is_tuple(_Other) ->
	    %% ignore anything not generated by test server
	    run_test_case_msgloop(Ref,Pid,
				  Terminate,Comment,CurrConf,Status);
	_Other when element(1, _Other) /= 'EXIT',
		    element(1, _Other) /= started,
		    element(1, _Other) /= finished,
		    element(1, _Other) /= print ->
	    %% ignore anything not generated by test server
	    run_test_case_msgloop(Ref,Pid,
				  Terminate,Comment,CurrConf,Status)
    after Timeout ->
	    ReturnValue
    end.

call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) ->
    Starter = self(),
    Data = {Mod,Func,TCPid,TCExitReason,Loc},
    EndConfProc =
	fun() ->
		Supervisor = self(),
		EndConfApply =
		    fun() ->
			    case catch apply(Mod,end_per_testcase,[Func,Conf]) of
				{'EXIT',Why} ->
				    timer:sleep(1),
				    group_leader() ! {printout,12,
						      "WARNING! "
						      "~p:end_per_testcase(~p, ~p)"
						      " crashed!\n\tReason: ~p\n",
						      [Mod,Func,Conf,Why]};
				_ ->
				    ok
			    end,
			    Supervisor ! {self(),end_conf}
		    end,
		Pid = spawn_link(EndConfApply),
		receive
		    {Pid,end_conf} ->
			Starter ! {self(),{call_end_conf,Data,ok}};
		    {'EXIT',Pid,Reason} ->
			Starter ! {self(),{call_end_conf,Data,{error,Reason}}}
		after TVal ->
			exit(Pid, kill),
			group_leader() ! {printout,12,
					  "WARNING! ~p:end_per_testcase(~p, ~p)"
					  " failed!\n\tReason: timetrap timeout"
					  " after ~w ms!\n", [Mod,Func,Conf,TVal]},
			Starter ! {self(),{call_end_conf,Data,{error,timeout}}}
		end
	end,
    spawn_link(EndConfProc).

spawn_fw_call(Mod,{init_per_testcase,Func},_,Pid,{timetrap_timeout,TVal}=Why,
	      Loc,SendTo) ->
    FwCall =
	fun() ->
		Skip = {skip,{failed,{Mod,init_per_testcase,Why}}},
		%% if init_per_testcase fails, the test case
		%% should be skipped
		case catch do_end_tc_call(Mod,Func, Loc, {Pid,Skip,[[]]}, Why) of
		    {'EXIT',FwEndTCErr} ->
			exit({fw_notify_done,end_tc,FwEndTCErr});
		    _ ->
			ok
		end,
		%% finished, report back
		SendTo ! {self(),fw_notify_done,
			  {TVal/1000,Skip,Loc,[],undefined}}
	end,
    spawn_link(FwCall);

spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid,
	      {timetrap_timeout,TVal}=Why,_Loc,SendTo) ->
    %%! This is a temporary fix that keeps Test Server alive during
    %%! execution of a parallel test case group, when sometimes
    %%! this clause gets called with EndConf == undefined. See OTP-9594
    %%! for more info.
    EndConf1 = if EndConf == undefined ->
		       [{tc_status,{failed,{Mod,end_per_testcase,Why}}}];
		  true ->
		       EndConf
	       end,
    FwCall =
	fun() ->
		{RetVal,Report} =
		    case proplists:get_value(tc_status, EndConf1) of
			undefined ->
			    E = {failed,{Mod,end_per_testcase,Why}},
			    {E,E};
			E = {failed,Reason} ->
			    {E,{error,Reason}};
			Result ->
			    E = {failed,{Mod,end_per_testcase,Why}},
			    {Result,E}
		    end,
		group_leader() ! {printout,12,
				  "WARNING! ~p:end_per_testcase(~p, ~p)"
				  " failed!\n\tReason: timetrap timeout"
				  " after ~w ms!\n", [Mod,Func,EndConf,TVal]},
		FailLoc = proplists:get_value(tc_fail_loc, EndConf1),
		case catch do_end_tc_call(Mod,Func, FailLoc,
					  {Pid,Report,[EndConf1]}, Why) of
		    {'EXIT',FwEndTCErr} ->
			exit({fw_notify_done,end_tc,FwEndTCErr});
		    _ ->
			ok
		end,
		Warn = "<font color=\"red\">"
		       "WARNING: end_per_testcase timed out!</font>",
		%% finished, report back (if end_per_testcase fails, a warning
		%% should be printed as part of the comment)
		SendTo ! {self(),fw_notify_done,
			  {TVal/1000,RetVal,FailLoc,[],Warn}}
	end,
    spawn_link(FwCall);

spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) ->
    FwCall =
	fun() ->
		test_server_sup:framework_call(report, [framework_error,
							{{FwMod,FwFunc},
							 FwError}]),
		Comment =
		    lists:flatten(
		      io_lib:format("<font color=\"red\">"
				    "WARNING! ~w:~w failed!</font>",
				    [FwMod,FwFunc])),
	    %% finished, report back
	    SendTo ! {self(),fw_notify_done,
		      {died,{error,{FwMod,FwFunc,FwError}},
		       {FwMod,FwFunc},[],Comment}}
	end,
    spawn_link(FwCall);

spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) ->
    {Mod1,Func1} =
	case {Mod,Func,CurrConf} of
	    {undefined,undefined,{{M,F},_}} -> {M,F};
	    _ -> {Mod,Func}
	end,	    
    FwCall =
	fun() ->
		case catch fw_error_notify(Mod1,Func1,[],
					   Error,Loc) of
		    {'EXIT',FwErrorNotifyErr} ->
			exit({fw_notify_done,error_notification,
			      FwErrorNotifyErr});
		    _ ->
			ok
		end,
		Conf = [{tc_status,{failed,timetrap_timeout}}],
		case catch do_end_tc_call(Mod1,Func1, Loc,
					  {Pid,Error,[Conf]},Error) of
		    {'EXIT',FwEndTCErr} ->
			exit({fw_notify_done,end_tc,FwEndTCErr});
		    _ ->
			ok
		end,
		%% finished, report back
		SendTo ! {self(),fw_notify_done,{died,Error,Loc,[],undefined}}
	end,
    spawn_link(FwCall).

%% The job proxy process forwards messages between the test case
%% process on a shielded node (and its descendants) and the job process.
%%
%% The job proxy process have to be started by the test-case process
%% on the shielded node!
start_job_proxy() ->
    group_leader(spawn(fun () -> job_proxy_msgloop() end), self()), ok.

%% The io_reply_proxy is not the most satisfying solution but it works...
io_reply_proxy(ReplyTo) ->
    receive
	IoReply when is_tuple(IoReply),
		     element(1, IoReply) == io_reply ->
	    ReplyTo ! IoReply;
	_ ->
	    io_reply_proxy(ReplyTo)
    end.

job_proxy_msgloop() ->
    receive

	%%
	%% Messages that need intervention by proxy...
	%%

	%% io stuff ...
	IoReq when tuple_size(IoReq) >= 2,
	           element(1, IoReq) == io_request ->

	    ReplyProxy = spawn(fun () -> io_reply_proxy(element(2, IoReq)) end),
	    group_leader() ! setelement(2, IoReq, ReplyProxy);

	%% test_server stuff...
	{sync_apply, From, MFA} ->
	    group_leader() ! {sync_apply_proxy, self(), From, MFA};
	{sync_result_proxy, To, Result} ->
	    To ! {sync_result, Result};

	%%
	%% Messages that need no intervention by proxy...
	%%
        Msg ->
	    group_leader() ! Msg
    end,
    job_proxy_msgloop().

%% A test case is known to have failed if it returns {'EXIT', _} tuple,
%% or sends a message {failed, File, Line} to it's group_leader

run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit,
		   TimetrapData, LogOpts, TCCallback) ->
    put(test_server_multiply_timetraps, TimetrapData),
    put(test_server_logopts, LogOpts),
    FWInitResult = test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0],
						  {ok,Args0}),
    group_leader() ! {test_case_initialized,self()},
    {{Time,Value},Loc,Opts} =
	case FWInitResult of
	    {ok,Args} ->
		run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback);
	    Error = {error,_Reason} ->
		Where = {Mod,Func},
		NewResult = do_end_tc_call(Mod,Func, Where, {Error,Args0},
					   {skip,{failed,Error}}),
		{{0,NewResult},Where,[]};
	    {fail,Reason} ->
		Conf = [{tc_status,{failed,Reason}} | hd(Args0)],
		Where = {Mod,Func},
		fw_error_notify(Mod, Func, Conf, Reason),
		NewResult = do_end_tc_call(Mod,Func, Where, {{error,Reason},[Conf]},
					   {fail,Reason}),
		{{0,NewResult},Where,[]};
	    Skip = {skip,_Reason} ->
		Where = {Mod,Func},
		NewResult = do_end_tc_call(Mod,Func, Where, {Skip,Args0}, Skip),
		{{0,NewResult},Where,[]};
	    {auto_skip,Reason} ->
		Where = {Mod,Func},
		NewResult = do_end_tc_call(Mod,Func, Where, {{skip,Reason},Args0},
					   {skip,Reason}),
		{{0,NewResult},Where,[]}
	end,
    exit({Ref,Time,Value,Loc,Opts}).

run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) ->
    %% save current state in controller loop
    tc_supervisor_req(set_curr_conf, {{Mod,Func},hd(Args)}),
    case RunInit of
	run_init ->
	    put(test_server_init_or_end_conf,{init_per_testcase,Func}),
	    put(test_server_loc, {Mod,{init_per_testcase,Func}}),
	    ensure_timetrap(Args),
	    case init_per_testcase(Mod, Func, Args) of
		Skip = {skip,Reason} ->
		    Line = get_loc(),
		    Conf = [{tc_status,{skipped,Reason}}],
		    NewRes = do_end_tc_call(Mod,Func, Line, {Skip,[Conf]}, Skip),
		    {{0,NewRes},Line,[]};
		{skip_and_save,Reason,SaveCfg} ->
		    Line = get_loc(),
		    Conf = [{tc_status,{skipped,Reason}},{save_config,SaveCfg}],
		    NewRes = do_end_tc_call(Mod,Func, Line, {{skip,Reason},[Conf]},
					    {skip,Reason}),
		    {{0,NewRes},Line,[]};
		FailTC = {fail,Reason} ->       % user fails the testcase
		    EndConf = [{tc_status,{failed,Reason}} | hd(Args)],
		    fw_error_notify(Mod, Func, EndConf, Reason),
		    NewRes = do_end_tc_call(Mod,Func, {Mod,Func},
					    {{error,Reason},[EndConf]},
					    FailTC),
		    {{0,NewRes},{Mod,Func},[]};
		{ok,NewConf} ->
		    put(test_server_init_or_end_conf,undefined),
		    %% call user callback function if defined
		    NewConf1 = user_callback(TCCallback, Mod, Func, init, NewConf),
		    %% save current state in controller loop
		    tc_supervisor_req(set_curr_conf, {{Mod,Func},NewConf1}),
		    put(test_server_loc, {Mod,Func}),
		    %% execute the test case
		    {{T,Return},Loc} = {ts_tc(Mod, Func, [NewConf1]),get_loc()},
		    {EndConf,TSReturn,FWReturn} =
			case Return of
			    {E,TCError} when E=='EXIT' ; E==failed ->
				ModLoc = mod_loc(Loc),
				fw_error_notify(Mod, Func, NewConf1,
						TCError, ModLoc),
				{[{tc_status,{failed,TCError}},
				  {tc_fail_loc,ModLoc}|NewConf1],
				 Return,{error,TCError}};
			    SaveCfg={save_config,_} ->
				{[{tc_status,ok},SaveCfg|NewConf1],Return,ok};
			    {skip_and_save,Why,SaveCfg} ->
				Skip = {skip,Why},
				{[{tc_status,{skipped,Why}},
				  {save_config,SaveCfg}|NewConf1],
				 Skip,Skip};
			    {skip,Why} ->
				{[{tc_status,{skipped,Why}}|NewConf1],Return,Return};
			    _ ->
				{[{tc_status,ok}|NewConf1],Return,ok}
			end,
		    %% call user callback function if defined
		    EndConf1 = user_callback(TCCallback, Mod, Func, 'end', EndConf),
		    %% update current state in controller loop
		    tc_supervisor_req(set_curr_conf, EndConf1),
		    {FWReturn1,TSReturn1,EndConf2} =
			case end_per_testcase(Mod, Func, EndConf1) of
			    SaveCfg1={save_config,_} ->
				{FWReturn,TSReturn,[SaveCfg1|lists:keydelete(save_config,1,
									     EndConf1)]};
			    {fail,ReasonToFail} ->
				%% user has failed the testcase
				fw_error_notify(Mod, Func, EndConf1, ReasonToFail),
				{{error,ReasonToFail},{failed,ReasonToFail},EndConf1};
			    {failed,{_,end_per_testcase,_}} = Failure when FWReturn == ok ->
				%% unexpected termination in end_per_testcase
				%% report this as the result to the framework
				{Failure,TSReturn,EndConf1};
			    _ ->
				%% test case result should be reported to framework
				%% no matter the status of end_per_testcase
				{FWReturn,TSReturn,EndConf1}
			end,
		    %% clear current state in controller loop
		    tc_supervisor_req(set_curr_conf, undefined),
		    put(test_server_init_or_end_conf,undefined),
		    case do_end_tc_call(Mod,Func, Loc,
					{FWReturn1,[EndConf2]}, TSReturn1) of
			{failed,Reason} = NewReturn ->
			    fw_error_notify(Mod,Func,EndConf2, Reason),
			    {{T,NewReturn},{Mod,Func},[]};
			NewReturn ->
			    {{T,NewReturn},Loc,[]}
		    end
	    end;
	skip_init ->
	    %% call user callback function if defined
	    Args1 = user_callback(TCCallback, Mod, Func, init, Args),
	    ensure_timetrap(Args1),
	    %% ts_tc does a catch
	    put(test_server_loc, {Mod,Func}),
	    %% if this is a named conf group, the test case (init or end conf)
	    %% should be called with the name as the first argument
	    Args2 = if Name == undefined -> Args1;
		       true -> [Name | Args1]
		    end,
	    %% execute the conf test case
	    {{T,Return},Loc} = {ts_tc(Mod, Func, Args2),get_loc()},
	    %% call user callback function if defined
	    Return1 = user_callback(TCCallback, Mod, Func, 'end', Return),
	    {Return2,Opts} = process_return_val([Return1], Mod, Func,
						Args1, {Mod,Func}, Return1),
	    {{T,Return2},Loc,Opts}
    end.

do_end_tc_call(M,F, Loc, Res, Return) ->
    IsSuite = case lists:reverse(atom_to_list(M)) of
		  [$E,$T,$I,$U,$S,$_|_]  -> true;
		  _ -> false
	      end,
    FwMod = os:getenv("TEST_SERVER_FRAMEWORK"),
    {Mod,Func} =
	if FwMod == M ; FwMod == "undefined"; FwMod == false ->
		{M,F};
	   (not IsSuite) and is_list(Loc) and (length(Loc)>1) ->
		%% If failure in other module (M) than suite, try locate
		%% suite name in Loc list and call end_tc with Suite:TestCase
		%% instead of M:F.
		GetSuite = fun(S,TC) ->
				   case lists:reverse(atom_to_list(S)) of
				       [$E,$T,$I,$U,$S,$_|_]  -> [{S,TC}];
				      _ -> []
				   end
			  end,
		case lists:flatmap(fun({S,TC,_})   -> GetSuite(S,TC);
				      ({{S,TC},_}) -> GetSuite(S,TC);
				      ({S,TC})     -> GetSuite(S,TC);
				      (_)          -> []
				   end, Loc) of
		    [] ->
			{M,F};
		    [FoundSuite|_] ->
			FoundSuite
		end;
	   true ->
		{M,F}
	end,

    Ref = make_ref(),
    if FwMod == "ct_framework" ; FwMod == "undefined"; FwMod == false ->
	    case test_server_sup:framework_call(
		   end_tc, [?pl2a(Mod),Func,Res, Return], ok) of
		{fail,FWReason} ->
		    {failed,FWReason};
		ok ->
		    case Return of
			{fail,Reason} ->
			    {failed,Reason};
			Return ->
			    Return
		    end;
		NewReturn ->
		    NewReturn
	    end;
       true ->
	    case test_server_sup:framework_call(FwMod, end_tc,
						[?pl2a(Mod),Func,Res], Ref) of
		{fail,FWReason} ->
		    {failed,FWReason};
		_Else ->
		    Return
	    end
    end.

%% the return value is a list and we have to check if it contains
%% the result of an end conf case or if it's a Config list
process_return_val([Return], M,F,A, Loc, Final) when is_list(Return) ->
    ReturnTags = [skip,skip_and_save,save_config,comment,return_group_result],
    %% check if all elements in the list are valid end conf return value tuples
    case lists:all(fun(Val) when is_tuple(Val) ->
			   lists:any(fun(T) -> T == element(1, Val) end, ReturnTags);
		      (ok) ->
			   true;
		      (_) ->
			   false
		   end, Return) of
	true ->		     % must be return value from end conf case
	    process_return_val1(Return, M,F,A, Loc, Final, []);
	false -> % must be Config value from init conf case
	    case do_end_tc_call(M, F, Loc, {ok,A}, Return) of
		{failed, FWReason} = Failed ->
		    fw_error_notify(M,F,A, FWReason),
		    {Failed, []};
		NewReturn ->
		    {NewReturn, []}
	    end
    end;
%% the return value is not a list, so it's the return value from an
%% end conf case or it's a dummy value that can be ignored
process_return_val(Return, M,F,A, Loc, Final) ->
    process_return_val1(Return, M,F,A, Loc, Final, []).

process_return_val1([Failed={E,TCError}|_], M,F,A=[Args], Loc, _, SaveOpts)
  when E=='EXIT';
       E==failed ->
    fw_error_notify(M,F,A, TCError, mod_loc(Loc)),
    case do_end_tc_call(M,F, Loc, {{error,TCError},
				   [[{tc_status,{failed,TCError}}|Args]]},
			Failed) of
	{failed,FWReason} ->
	    {{failed,FWReason},SaveOpts};
	NewReturn ->
	    {NewReturn,SaveOpts}
    end;
process_return_val1([SaveCfg={save_config,_}|Opts], M,F,[Args], Loc, Final, SaveOpts) ->
    process_return_val1(Opts, M,F,[[SaveCfg|Args]], Loc, Final, SaveOpts);
process_return_val1([{skip_and_save,Why,SaveCfg}|Opts], M,F,[Args], Loc, _, SaveOpts) ->
    process_return_val1(Opts, M,F,[[{save_config,SaveCfg}|Args]], Loc, {skip,Why}, SaveOpts);
process_return_val1([GR={return_group_result,_}|Opts], M,F,A, Loc, Final, SaveOpts) ->
    process_return_val1(Opts, M,F,A, Loc, Final, [GR|SaveOpts]);
process_return_val1([RetVal={Tag,_}|Opts], M,F,A, Loc, _, SaveOpts) when Tag==skip;
									 Tag==comment ->
    process_return_val1(Opts, M,F,A, Loc, RetVal, SaveOpts);
process_return_val1([_|Opts], M,F,A, Loc, Final, SaveOpts) ->
    process_return_val1(Opts, M,F,A, Loc, Final, SaveOpts);
process_return_val1([], M,F,A, Loc, Final, SaveOpts) ->
    case do_end_tc_call(M,F, Loc, {Final,A}, Final) of
	{failed,FWReason} ->
	    {{failed,FWReason},SaveOpts};
	NewReturn ->
	    {NewReturn,lists:reverse(SaveOpts)}
    end.

user_callback(undefined, _, _, _, Args) ->
    Args;
user_callback({CBMod,CBFunc}, Mod, Func, InitOrEnd, [Args]) when is_list(Args) ->
    case catch apply(CBMod, CBFunc, [InitOrEnd,Mod,Func,Args]) of
	Args1 when is_list(Args1) ->
	    [Args1];
	_ ->
	    [Args]
    end;
user_callback({CBMod,CBFunc}, Mod, Func, InitOrEnd, Args) ->
    case catch apply(CBMod, CBFunc, [InitOrEnd,Mod,Func,Args]) of
	Args1 when is_list(Args1) ->
	    Args1;
	_ ->
	    Args
    end.

init_per_testcase(Mod, Func, Args) ->
    case code:is_loaded(Mod) of
	false -> code:load_file(Mod);
	_ -> ok
    end,
    case erlang:function_exported(Mod, init_per_testcase, 2) of
	true ->
	    do_init_per_testcase(Mod, [Func|Args]);
	false ->
	    %% Optional init_per_testcase is not defined -- keep quiet.
	    [Config] = Args,
	    {ok, Config}
    end.

do_init_per_testcase(Mod, Args) ->
    try	apply(Mod, init_per_testcase, Args) of
	{Skip,Reason} when Skip =:= skip; Skip =:= skipped ->
	    {skip,Reason};
	{skip_and_save,_,_}=Res ->
	    Res;
	NewConf when is_list(NewConf) ->
	    case lists:filter(fun(T) when is_tuple(T) -> false;
				 (_) -> true end, NewConf) of
		[] ->
		    {ok,NewConf};
		Bad ->
		    group_leader() ! {printout,12,
				      "ERROR! init_per_testcase has returned "
				      "bad elements in Config: ~p\n",[Bad]},
		    {skip,{failed,{Mod,init_per_testcase,bad_return}}}
	    end;
	{fail,_Reason}=Res ->
	    Res;
	_Other ->
	    group_leader() ! {printout,12,
			      "ERROR! init_per_testcase did not return "
			      "a Config list.\n",[]},
	    {skip,{failed,{Mod,init_per_testcase,bad_return}}}
    catch
	throw:Other ->
	    set_loc(erlang:get_stacktrace()),
	    Line = get_loc(),
	    FormattedLoc = test_server_sup:format_loc(mod_loc(Line)),
	    group_leader() ! {printout,12,
			      "ERROR! init_per_testcase thrown!\n"
			      "\tLocation: ~s\n\tReason: ~p\n",
			      [FormattedLoc, Other]},
	    {skip,{failed,{Mod,init_per_testcase,Other}}};
	_:Reason0 ->
	    Stk = erlang:get_stacktrace(),
	    Reason = {Reason0,Stk},
	    set_loc(Stk),
	    Line = get_loc(),
	    FormattedLoc = test_server_sup:format_loc(mod_loc(Line)),
	    group_leader() ! {printout,12,
			      "ERROR! init_per_testcase crashed!\n"
			      "\tLocation: ~s\n\tReason: ~p\n",
			      [FormattedLoc,Reason]},
	    {skip,{failed,{Mod,init_per_testcase,Reason}}}
    end.

end_per_testcase(Mod, Func, Conf) ->
    case erlang:function_exported(Mod,end_per_testcase,2) of
	true ->
	    do_end_per_testcase(Mod,end_per_testcase,Func,Conf);
	false ->
	    %% Backwards compatibility!
	    case erlang:function_exported(Mod,fin_per_testcase,2) of
		true ->
		    do_end_per_testcase(Mod,fin_per_testcase,Func,Conf);
		false ->
		    ok
	    end
    end.

do_end_per_testcase(Mod,EndFunc,Func,Conf) ->
    put(test_server_init_or_end_conf,{EndFunc,Func}),
    put(test_server_loc, {Mod,{EndFunc,Func}}),
    try Mod:EndFunc(Func, Conf) of
	{save_config,_}=SaveCfg ->
	    SaveCfg;
	{fail,_}=Fail ->
	    Fail;
	_ ->
	    ok
    catch
	throw:Other ->
	    Comment0 = case read_comment() of
			   ""  -> "";
			   Cmt -> Cmt ++ test_server_ctrl:xhtml("<br>",
								"<br />")
		       end,
	    set_loc(erlang:get_stacktrace()),
	    comment(io_lib:format("~s<font color=\"red\">"
				  "WARNING: ~w thrown!"
				  "</font>\n",[Comment0,EndFunc])),
	    group_leader() ! {printout,12,
			      "WARNING: ~w thrown!\n"
			      "Reason: ~p\n"
			      "Line: ~s\n",
			      [EndFunc, Other,
			       test_server_sup:format_loc(
				 mod_loc(get_loc()))]},
	    {failed,{Mod,end_per_testcase,Other}};
	  Class:Reason ->
	    Stk = erlang:get_stacktrace(),
	    set_loc(Stk),
	    Why = case Class of
		      exit -> {'EXIT',Reason};
		      error -> {'EXIT',{Reason,Stk}}
		  end,
	    Comment0 = case read_comment() of
			   ""  -> "";
			   Cmt -> Cmt ++ test_server_ctrl:xhtml("<br>",
								"<br />")
		       end,
	    comment(io_lib:format("~s<font color=\"red\">"
				  "WARNING: ~w crashed!"
				  "</font>\n",[Comment0,EndFunc])),
	    group_leader() ! {printout,12,
			      "WARNING: ~w crashed!\n"
			      "Reason: ~p\n"
			      "Line: ~s\n",
			      [EndFunc, Reason,
			       test_server_sup:format_loc(
				 mod_loc(get_loc()))]},
	    {failed,{Mod,end_per_testcase,Why}}
    end.

get_loc() ->
    get(test_server_loc).

get_loc(Pid) ->
    [{current_stacktrace,Stk0},{dictionary,Dict}] =
	process_info(Pid, [current_stacktrace,dictionary]),
    lists:foreach(fun({Key,Val}) -> put(Key, Val) end, Dict),
    Stk = [rewrite_loc_item(Loc) || Loc <- Stk0],
    case get(test_server_loc) of
	undefined ->
	    put(test_server_loc, Stk);
	{Suite,Case} ->
	    %% location info unknown, check if {Suite,Case,Line}
	    %% is available in stacktrace. and if so, use stacktrace
	    %% instead of currect test_server_loc
	    case [match || {S,C,_L} <- Stk, S == Suite, C == Case] of
		[match|_] -> put(test_server_loc, Stk);
		_         -> ok
	    end;
	_ ->
	    ok
    end,
    get_loc().

%% find the latest known Suite:Testcase
get_mf(MFs) ->
    get_mf(MFs, {undefined,undefined}).

get_mf([MF|MFs], _Found) when is_tuple(MF) ->
    ModFunc = {Mod,_} = case MF of
			    {M,F,_} -> {M,F};
			    MF -> MF
			end,
    case is_suite(Mod) of
	true -> ModFunc;
	false -> get_mf(MFs, ModFunc)
    end;
get_mf(_, Found) ->
    Found.

is_suite(Mod) ->
    case lists:reverse(atom_to_list(Mod)) of
	"ETIUS" ++ _ -> true;
	_ -> false
    end.

mod_loc(Loc) ->
    %% handle diff line num versions
    case Loc of
	[{{_M,_F},_L}|_] ->
	    [begin if L /= 0 -> {?pl2a(M),F,L};
		      true   -> {?pl2a(M),F} end end || {{M,F},L} <- Loc];
	[{_M,_F}|_] ->
	    [{?pl2a(M),F} || {M,F} <- Loc];
	{{M,F},0} ->
	    [{?pl2a(M),F}];
	{{M,F},L} ->
	    [{?pl2a(M),F,L}];
	{M,ForL} ->
	    [{?pl2a(M),ForL}];
	{M,F,0} ->
	    [{M,F}];
	[{M,F,0}|Stack] ->
	    [{M,F}|Stack];
	_ ->
	    Loc
    end.


fw_error_notify(Mod, Func, Args, Error) ->
    test_server_sup:framework_call(error_notification,
				   [?pl2a(Mod),Func,[Args],
				    {Error,unknown}]).
fw_error_notify(Mod, Func, Args, Error, Loc) ->
    test_server_sup:framework_call(error_notification,
				   [?pl2a(Mod),Func,[Args],
				    {Error,Loc}]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% print(Detail,Format,Args,Printer) -> ok
%% Detail = integer()
%% Format = string()
%% Args = [term()]
%%
%% Just like io:format, except that depending on the Detail value, the output
%% is directed to console, major and/or minor log files.

print(Detail,Format,Args) ->
    local_or_remote_apply({test_server_ctrl,print,[Detail,Format,Args]}).

print(Detail,Format,Args,Printer) ->
    local_or_remote_apply({test_server_ctrl,print,[Detail,Format,Args,Printer]}).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% print_timsteamp(Detail,Leader) -> ok
%%
%% Prints Leader followed by a time stamp (date and time). Depending on
%% the Detail value, the output is directed to console, major and/or minor
%% log files.

print_timestamp(Detail,Leader) ->
    local_or_remote_apply({test_server_ctrl,print_timestamp,[Detail,Leader]}).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% lookup_config(Key,Config) -> {value,{Key,Value}} | undefined
%% Key = term()
%% Value = term()
%% Config = [{Key,Value},...]
%%
%% Looks up a specific key in the config list, and returns the value
%% of the associated key, or undefined if the key doesn't exist.

lookup_config(Key,Config) ->
    case lists:keysearch(Key,1,Config) of
	{value,{Key,Val}} ->
	    Val;
	_ ->
	    io:format("Could not find element ~p in Config.~n",[Key]),
	    undefined
    end.

%% timer:tc/3
ts_tc(M, F, A) ->
    Before = erlang:now(),
    Result = try
		 apply(M, F, A)
	     catch
		 Type:Reason ->
		     Stk = erlang:get_stacktrace(),
		     set_loc(Stk),
		     case Type of
			 throw ->
			     {failed,{thrown,Reason}};
			 error ->
			     {'EXIT',{Reason,Stk}};
			 exit ->
			     {'EXIT',Reason}
		     end
	     end,
    After = erlang:now(),
    Elapsed =
	(element(1,After)*1000000000000
	 +element(2,After)*1000000+element(3,After)) -
	(element(1,Before)*1000000000000
	 +element(2,Before)*1000000+element(3,Before)),
    {Elapsed, Result}.

set_loc(Stk) ->
    Loc = [rewrite_loc_item(I) || {_,_,_,_}=I <- Stk],
    put(test_server_loc, Loc).

rewrite_loc_item({M,F,_,Loc}) ->
    {M,F,proplists:get_value(line, Loc, 0)}.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%                TEST SUITE SUPPORT FUNCTIONS                      %%
%%                                                                  %%
%% Note: Some of these functions have been moved to test_server_sup %%
%%       in an attempt to keep this modules small (yeah, right!)    %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% format(Format) -> IoLibReturn
%% format(Detail,Format) -> IoLibReturn
%% format(Format,Args) -> IoLibReturn
%% format(Detail,Format,Args) -> IoLibReturn
%% Detail = integer()
%% Format = string()
%% Args = [term(),...]
%% IoLibReturn = term()
%%
%% Logs the Format string and Args, similar to io:format/1/2 etc. If
%% Detail is not specified, the default detail level (which is 50) is used.
%% Which log files the string will be logged in depends on the thresholds
%% set with set_levels/3. Typically with default detail level, only the
%% minor log file is used.
format(Format) ->
    format(minor, Format, []).

format(major, Format) ->
    format(major, Format, []);
format(minor, Format) ->
    format(minor, Format, []);
format(Detail, Format) when is_integer(Detail) ->
    format(Detail, Format, []);
format(Format, Args) ->
    format(minor, Format, Args).

format(Detail, Format, Args) ->
    Str =
	case catch io_lib:format(Format,Args) of
	    {'EXIT',_} ->
		io_lib:format("illegal format; ~p with args ~p.\n",
			      [Format,Args]);
	    Valid -> Valid
	end,
    log({Detail, Str}).

log(Msg) ->
    group_leader() ! {structured_io, self(), Msg},
    ok.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% capture_start() -> ok
%% capture_stop() -> ok
%%
%% Starts/stops capturing all output from io:format, and similar. Capturing
%% output doesn't stop output from happening. It just makes it possible
%% to retrieve the output using capture_get/0.
%% Starting and stopping capture doesn't affect already captured output.
%% All output is stored as messages in the message queue until retrieved

capture_start() ->
    group_leader() ! {capture,self()},
    ok.

capture_stop() ->
    group_leader() ! {capture,false},
    ok.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% capture_get() -> Output
%% Output = [string(),...]
%%
%% Retrieves all the captured output since last call to capture_get/0.
%% Note that since output arrive as messages to the process, it takes
%% a short while from the call to io:format until all output is available
%% by capture_get/0. It is not necessary to call capture_stop/0 before
%% retreiving the output.
capture_get() ->
    test_server_sup:capture_get([]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% messages_get() -> Messages
%% Messages = [term(),...]
%%
%% Returns all messages in the message queue.
messages_get() ->
    test_server_sup:messages_get([]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% permit_io(GroupLeader, FromPid) -> ok
%%
%% Make sure proceeding IO from FromPid won't get rejected
permit_io(GroupLeader, FromPid) ->
    GroupLeader ! {permit_io,FromPid}.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% sleep(Time) -> ok
%% Time = integer() | float() | infinity
%%
%% Sleeps the specified number of milliseconds. This sleep also accepts
%% floating point numbers (which are truncated) and the atom 'infinity'.
sleep(infinity) ->
    receive
    after infinity ->
	    ok
    end;
sleep(MSecs) ->
    receive
    after trunc(MSecs) ->
	    ok
    end,
    ok.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% adjusted_sleep(Time) -> ok
%% Time = integer() | float() | infinity
%%
%% Sleeps the specified number of milliseconds, multiplied by the
%% 'multiply_timetraps' value (if set) and possibly also automatically scaled
%% up if 'scale_timetraps' is set to true (which is default).
%% This function also accepts floating point numbers (which are truncated) and
%% the atom 'infinity'.
adjusted_sleep(infinity) ->
    receive
    after infinity ->
	    ok
    end;
adjusted_sleep(MSecs) ->
    {Multiplier,ScaleFactor} =
	case test_server_ctrl:get_timetrap_parameters() of
	    {undefined,undefined} ->
		{1,1};
	    {undefined,false} ->
		{1,1};
	    {undefined,true} ->
		{1,timetrap_scale_factor()};
	    {infinity,_} ->
		{infinity,1};
	    {Mult,undefined} ->
		{Mult,1};
	    {Mult,false} ->
		{Mult,1};
	    {Mult,true} ->
		{Mult,timetrap_scale_factor()}
	end,
    receive
    after trunc(MSecs*Multiplier*ScaleFactor) ->
	    ok
    end,
    ok.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% fail(Reason) -> exit({suite_failed,Reason})
%%
%% Immediately calls exit. Included because test suites are easier
%% to read when using this function, rather than exit directly.
fail(Reason) ->
    comment(cast_to_list(Reason)),
    try
	exit({suite_failed,Reason})
    catch
	Class:R ->
	    case erlang:get_stacktrace() of
		[{?MODULE,fail,1,_}|Stk] -> ok;
		Stk -> ok
	    end,
	    erlang:raise(Class, R, Stk)
    end.

cast_to_list(X) when is_list(X) -> X;
cast_to_list(X) when is_atom(X) -> atom_to_list(X);
cast_to_list(X) -> lists:flatten(io_lib:format("~p", [X])).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% fail() -> exit(suite_failed)
%%
%% Immediately calls exit. Included because test suites are easier
%% to read when using this function, rather than exit directly.
fail() ->
    try
	exit(suite_failed)
    catch
	Class:R ->
	    case erlang:get_stacktrace() of
		[{?MODULE,fail,0,_}|Stk] -> ok;
		Stk -> ok
	    end,
	    erlang:raise(Class, R, Stk)
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% break(Comment) -> ok
%%
%% Break a test case so part of the test can be done manually.
%% Use continue/0 to continue.
break(Comment) ->
    break(?MODULE, Comment).

break(CBM, Comment) ->
    break(CBM, '', Comment).

break(CBM, TestCase, Comment) ->
    timetrap_cancel(),
    {TCName,CntArg,PName} =
	if TestCase == '' -> 
		{"", "", test_server_break_process};
	   true ->
		Str = atom_to_list(TestCase),
		{[32 | Str], Str,
		 list_to_atom("test_server_break_process_" ++ Str)}
	end,
    io:format(user,
	      "\n\n\n--- SEMIAUTOMATIC TESTING ---"
	      "\nThe test case~s executes on process ~w"
	      "\n\n\n~s"
	      "\n\n\n-----------------------------\n\n"
	      "Continue with --> ~w:continue(~s).\n",
	      [TCName,self(),Comment,CBM,CntArg]),
    case whereis(PName) of
	undefined ->
	    spawn_break_process(self(), PName);
	OldBreakProcess ->
	    OldBreakProcess ! cancel,
	    spawn_break_process(self(), PName)
    end,
    receive continue -> ok end.

spawn_break_process(Pid, PName) ->
    spawn(fun() ->
		  register(PName, self()),
		  receive
		      continue -> continue(Pid);
		      cancel -> ok
		  end
	  end).

continue() ->
    case whereis(test_server_break_process) of
	undefined    -> ok;
	BreakProcess -> BreakProcess ! continue
    end.

continue(TestCase) when is_atom(TestCase) ->
    PName = list_to_atom("test_server_break_process_" ++
			 atom_to_list(TestCase)),
    case whereis(PName) of
	undefined    -> ok;
	BreakProcess -> BreakProcess ! continue
    end;	

continue(Pid) when is_pid(Pid) ->
    Pid ! continue.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timetrap_scale_factor() -> Factor
%%
%% Returns the amount to scale timetraps with.

%% {X, fun() -> check() end} <- multiply scale with X if Fun() is true
timetrap_scale_factor() ->
    timetrap_scale_factor([
	{ 2, fun() -> has_lock_checking() end},
	{ 3, fun() -> has_superfluous_schedulers() end},
	{ 5, fun() -> purify_is_running() end},
	{ 6, fun() -> is_debug() end},
	{10, fun() -> is_cover() end}
    ]).

timetrap_scale_factor(Scales) ->
    %% The fun in {S, Fun} a filter input to the list comprehension
    lists:foldl(fun(S,O) -> O*S end, 1, [ S || {S,F} <- Scales, F()]).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timetrap(Timeout) -> Handle
%% Handle = term()
%%
%% Creates a time trap, that will kill the calling process if the
%% trap is not cancelled with timetrap_cancel/1, within Timeout milliseconds.
timetrap(Timeout) ->
    MultAndScale =
	case get(test_server_multiply_timetraps) of
	    undefined -> {fun(T) -> T end, true};
	    {undefined,false} -> {fun(T) -> T end, false};
	    {undefined,_} -> {fun(T) -> T end, true};
	    {infinity,_} -> {fun(_) -> infinity end, false};
	    {Int,Scale} -> {fun(infinity) -> infinity;
			       (T) -> T*Int end, Scale}
	end,	    
    timetrap(Timeout, Timeout, self(), MultAndScale).

%% when the function is called from different process than
%% the test case, the test_server_multiply_timetraps data
%% is unknown and must be passed as argument
timetrap(Timeout, TCPid, MultAndScale) ->
    timetrap(Timeout, Timeout, TCPid, MultAndScale).

timetrap(Timeout0, TimeToReport0, TCPid, MultAndScale = {Multiplier,Scale}) ->
    %% the time_ms call will either convert Timeout to ms or spawn a
    %% user timetrap which sends the result to the IO server process
    Timeout = time_ms(Timeout0, TCPid, MultAndScale),
    Timeout1 = Multiplier(Timeout),
    TimeToReport = if Timeout0 == TimeToReport0 ->
			   Timeout1;
		      true ->
			   %% only convert to ms, don't start a
			   %% user timetrap
			   time_ms_check(TimeToReport0)
		   end,
    cancel_default_timetrap(self() == TCPid),
    Handle = case Timeout1 of
		 infinity ->
		     infinity;
		 _ ->
		     spawn_link(test_server_sup,timetrap,[Timeout1,TimeToReport,
							  Scale,TCPid])
	     end,

    %% ERROR! This sets dict on IO process instead of testcase process
    %% if Timeout is return value from previous user timetrap!!

    case get(test_server_timetraps) of
	undefined ->
	    put(test_server_timetraps,[{Handle,TCPid,{TimeToReport,Scale}}]);
	List ->
	    List1 = lists:delete({infinity,TCPid,{infinity,false}}, List),
	    put(test_server_timetraps,[{Handle,TCPid,{TimeToReport,Scale}}|List1])
    end,
    Handle.

ensure_timetrap(Config) ->
    case get(test_server_timetraps) of
	[_|_] ->
	    ok;
	_ ->
	    case get(test_server_default_timetrap) of
		undefined -> ok;
		Garbage ->
		    erase(test_server_default_timetrap),
		    format("=== WARNING: garbage in "
			   "test_server_default_timetrap: ~p~n",
			   [Garbage])
	    end,
	    DTmo = case lists:keysearch(default_timeout,1,Config) of
		       {value,{default_timeout,Tmo}} -> Tmo;
		       _ -> ?DEFAULT_TIMETRAP_SECS
		   end,
	    format("=== test_server setting default "
		   "timetrap of ~p seconds~n",
		   [DTmo]),
	    put(test_server_default_timetrap, timetrap(seconds(DTmo)))
    end.

%% executing on IO process, no default timetrap ever set here
cancel_default_timetrap(false) ->
    ok;
cancel_default_timetrap(true) ->
    case get(test_server_default_timetrap) of
	undefined ->
	    ok;
	TimeTrap when is_pid(TimeTrap) ->
	    timetrap_cancel(TimeTrap),
	    erase(test_server_default_timetrap),
	    format("=== test_server canceled default timetrap "
		   "since another timetrap was set~n"),
	    ok;
	Garbage ->
	    erase(test_server_default_timetrap),
	    format("=== WARNING: garbage in "
		   "test_server_default_timetrap: ~p~n",
		   [Garbage]),
	    error
    end.

time_ms({hours,N}, _, _) -> hours(N);
time_ms({minutes,N}, _, _) -> minutes(N);
time_ms({seconds,N}, _, _) -> seconds(N);
time_ms({Other,_N}, _, _) ->
    format("=== ERROR: Invalid time specification: ~p. "
	   "Should be seconds, minutes, or hours.~n", [Other]),
    exit({invalid_time_format,Other});
time_ms(Ms, _, _) when is_integer(Ms) -> Ms;
time_ms(infinity, _, _) -> infinity;
time_ms(Fun, TCPid, MultAndScale) when is_function(Fun) ->
    time_ms_apply(Fun, TCPid, MultAndScale);
time_ms({M,F,A}=MFA, TCPid, MultAndScale) when is_atom(M), is_atom(F), is_list(A) ->
    time_ms_apply(MFA, TCPid, MultAndScale);
time_ms(Other, _, _) -> exit({invalid_time_format,Other}).

time_ms_check(MFA = {M,F,A}) when is_atom(M), is_atom(F), is_list(A) ->
    MFA;
time_ms_check(Fun) when is_function(Fun) ->
    Fun;
time_ms_check(Other) ->
    time_ms(Other, undefined, undefined).

time_ms_apply(Func, TCPid, MultAndScale) ->
    {_,GL} = process_info(TCPid, group_leader),
    WhoAmI = self(),				% either TC or IO server
    T0 = now(),
    UserTTSup = 
	spawn(fun() -> 
		      user_timetrap_supervisor(Func, WhoAmI, TCPid,
					       GL, T0, MultAndScale)
	      end),
    receive
	{UserTTSup,infinity} ->
	    %% remember the user timetrap so that it can be cancelled
	    save_user_timetrap(TCPid, UserTTSup, T0),
	    %% we need to make sure the user timetrap function
	    %% gets time to execute and return
	    timetrap(infinity, TCPid, MultAndScale)
    after 5000 ->
	    exit(UserTTSup, kill),
	    if WhoAmI /= GL ->
		    exit({user_timetrap_error,time_ms_apply});
	       true ->
		    format("=== ERROR: User timetrap execution failed!", []),
		    ignore
	    end
    end.

user_timetrap_supervisor(Func, Spawner, TCPid, GL, T0, MultAndScale) ->
    process_flag(trap_exit, true),
    Spawner ! {self(),infinity},
    MonRef = monitor(process, TCPid),
    UserTTSup = self(),
    group_leader(GL, UserTTSup),
    UserTT = spawn_link(fun() -> call_user_timetrap(Func, UserTTSup) end),
    receive
	{UserTT,Result} ->
	    demonitor(MonRef, [flush]),
	    Elapsed = trunc(timer:now_diff(now(), T0) / 1000),
	    try time_ms_check(Result) of
		TimeVal ->
		    %% this is the new timetrap value to set (return value
		    %% from a fun or an MFA)
		    GL ! {user_timetrap,TCPid,TimeVal,T0,Elapsed,MultAndScale}
	    catch _:_ ->		    
		    %% when other than a legal timetrap value is returned
		    %% which will be the normal case for user timetraps
		    GL ! {user_timetrap,TCPid,0,T0,Elapsed,MultAndScale}
	    end;
	{'EXIT',UserTT,Error} when Error /= normal ->
	    demonitor(MonRef, [flush]),
	    GL ! {user_timetrap,TCPid,0,T0,{user_timetrap_error,Error},
		  MultAndScale};
	{'DOWN',MonRef,_,_,_} ->
	    demonitor(MonRef, [flush]),
	    exit(UserTT, kill)
    end.

call_user_timetrap(Func, Sup) when is_function(Func) ->
    try Func() of
	Result -> 
	    Sup ! {self(),Result}
    catch _:Error ->
	    exit({Error,erlang:get_stacktrace()})
    end;
call_user_timetrap({M,F,A}, Sup) ->
    try apply(M,F,A) of
	Result -> 
	    Sup ! {self(),Result}
    catch _:Error ->
	    exit({Error,erlang:get_stacktrace()})
    end.

save_user_timetrap(TCPid, UserTTSup, StartTime) ->
    %% save pid of user timetrap supervisor process so that
    %% it may be stopped even before the timetrap func has returned
    NewUserTT = {TCPid,{UserTTSup,StartTime}},
    case get(test_server_user_timetrap) of
	undefined ->
	    put(test_server_user_timetrap, [NewUserTT]);
	UserTTSups ->
	    case proplists:get_value(TCPid, UserTTSups) of
		undefined ->
		    put(test_server_user_timetrap,
			[NewUserTT | UserTTSups]);
		PrevTTSup ->
		    %% remove prev user timetrap
		    remove_user_timetrap(PrevTTSup),
		    put(test_server_user_timetrap,
			[NewUserTT | proplists:delete(TCPid,
						      UserTTSups)])
	    end
    end.
    
update_user_timetraps(TCPid, StartTime) ->
    %% called when a user timetrap is triggered
    case get(test_server_user_timetrap) of
	undefined ->
	    proceed;
	UserTTs ->
	    case proplists:get_value(TCPid, UserTTs) of
		{_UserTTSup,StartTime} ->	% same timetrap
		    put(test_server_user_timetrap,
			proplists:delete(TCPid, UserTTs)),
		    proceed;
		{OtherUserTTSup,OtherStartTime} ->
		    case timer:now_diff(OtherStartTime, StartTime) of
			Diff when Diff >= 0 ->
			    ignore;
			_ ->
			    exit(OtherUserTTSup, kill),
			    put(test_server_user_timetrap,
				proplists:delete(TCPid, UserTTs)),
			    proceed
		    end;
		undefined ->
		    proceed
	    end
    end.

remove_user_timetrap(TTSup) ->
    exit(TTSup, kill).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timetrap_cancel(Handle) -> ok
%% Handle = term()
%%
%% Cancels a time trap.
timetrap_cancel(Handle) ->
    timetrap_cancel_one(Handle, true).

timetrap_cancel_one(infinity, _SendToServer) ->
    ok;
timetrap_cancel_one(Handle, SendToServer) ->
    case get(test_server_timetraps) of
	undefined ->
	    ok;
	[{Handle,_,_}] ->
	    erase(test_server_timetraps);
	Timers ->
	    case lists:keysearch(Handle, 1, Timers) of
		{value,_} ->
		    put(test_server_timetraps,
			lists:keydelete(Handle, 1, Timers));
		false when SendToServer == true ->
		    group_leader() ! {timetrap_cancel_one,Handle,self()};
		false ->
		    ok
	    end
    end,
    test_server_sup:timetrap_cancel(Handle).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timetrap_cancel() -> ok
%%
%% Cancels timetrap for current test case.
timetrap_cancel() ->
    timetrap_cancel_all(self(), true).

timetrap_cancel_all(TCPid, SendToServer) ->
    case get(test_server_timetraps) of
	undefined ->
	    ok;
	Timers ->
	    [timetrap_cancel_one(Handle, false) ||
		{Handle,Pid,_} <- Timers, Pid == TCPid]
    end,
    case get(test_server_user_timetrap) of
	undefined ->
	    ok;
	UserTTs ->
	    case proplists:get_value(TCPid, UserTTs) of
		{UserTTSup,_StartTime} ->
		    remove_user_timetrap(UserTTSup),
		    put(test_server_user_timetrap,
			proplists:delete(TCPid, UserTTs));
		undefined ->
		    ok
	    end
    end,
    if SendToServer == true ->
	    group_leader() ! {timetrap_cancel_all,TCPid,self()};
       true ->
	    ok
    end,
    ok.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% get_timetrap_info() -> {Timeout,Scale} | undefined
%%
%% Read timetrap info for current test case
get_timetrap_info() ->
    get_timetrap_info(self(), true).

get_timetrap_info(TCPid, SendToServer) ->
    case get(test_server_timetraps) of
	undefined ->
	    undefined;
	Timers ->
	    case [Info || {Handle,Pid,Info} <- Timers, 
			  Pid == TCPid, Handle /= infinity] of
		[I|_] ->
		    I;
		[] when SendToServer == true ->
		    tc_supervisor_req({get_timetrap_info,TCPid});
		[] ->
		    undefined
	    end
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% hours(N) -> Milliseconds
%% minutes(N) -> Milliseconds
%% seconds(N) -> Milliseconds
%% N = integer() | float()
%% Milliseconds = integer()
%%
%% Transforms the named units to milliseconds. Fractions in the input
%% are accepted. The output is an integer.
hours(N)   -> trunc(N * 1000 * 60 * 60).
minutes(N) -> trunc(N * 1000 * 60).
seconds(N) -> trunc(N * 1000).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% tc_supervisor_req(Tag) -> Result
%% tc_supervisor_req(Tag, Msg) -> Result
%%

tc_supervisor_req(Tag) ->
    Pid = test_server_gl:get_tc_supervisor(group_leader()),
    Pid ! {Tag,self()},
    receive
	{Pid,Tag,Result} ->
	    Result
    after 5000 ->
	    error(no_answer_from_tc_supervisor)
    end.

tc_supervisor_req(Tag, Msg) ->
    Pid = test_server_gl:get_tc_supervisor(group_leader()),
    Pid ! {Tag,self(),Msg},
    receive
	{Pid,Tag,Result} ->
	    Result
    after 5000 ->
	    error(no_answer_from_tc_supervisor)
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timecall(M,F,A) -> {Time,Val}
%% Time = float()
%%
%% Measures the time spent evaluating MFA. The measurement is done with
%% erlang:now/0, and should have pretty good accuracy on most platforms.
%% The function is not evaluated in a catch context.
timecall(M, F, A) ->
    test_server_sup:timecall(M,F,A).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% do_times(N,M,F,A) -> ok
%% do_times(N,Fun) ->
%% N = integer()
%% Fun = fun() -> void()
%%
%% Evaluates MFA or Fun N times, and returns ok.
do_times(N,M,F,A) when N>0 ->
    apply(M,F,A),
    do_times(N-1,M,F,A);
do_times(0,_,_,_) ->
    ok.

do_times(N,Fun) when N>0 ->
    Fun(),
    do_times(N-1,Fun);
do_times(0,_) ->
    ok.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% m_out_of_n(M,N,Fun) -> ok | exit({m_out_of_n_failed,{R,left_to_do}})
%% M = integer()
%% N = integer()
%% Fun = fun() -> void()
%% R = integer()
%%
%% Repeats evaluating the given function until it succeeded (didn't crash)
%% M times. If, after N times, M successful attempts have not been
%% accomplished, the process crashes with reason {m_out_of_n_failed
%% {R,left_to_do}}, where R indicates how many cases that remained to be
%% successfully completed.
%%
%% For example:
%% m_out_of_n(1,4,fun() -> tricky_test_case() end)
%%                           Tries to run tricky_test_case() up to 4 times,
%%                           and is happy if it succeeds once.
%%
%% m_out_of_n(7,8,fun() -> clock_sanity_check() end)
%%                         Tries running clock_sanity_check() up to 8
%%                         times and allows the function to fail once.
%%                         This might be useful if clock_sanity_check/0
%%                         is known to fail if the clock crosses an hour
%%                         boundary during the test (and the up to 8
%%                         test runs could never cross 2 boundaries)
m_out_of_n(0,_,_) ->
    ok;
m_out_of_n(M,0,_) ->
    exit({m_out_of_n_failed,{M,left_to_do}});
m_out_of_n(M,N,Fun) ->
    case catch Fun() of
	{'EXIT',_} ->
	    m_out_of_n(M,N-1,Fun);
	_Other ->
	    m_out_of_n(M-1,N-1,Fun)
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%call_crash(M,F,A)
%%call_crash(Time,M,F,A)
%%call_crash(Time,Crash,M,F,A)
%%	M     - atom()
%%	F     - atom()
%%	A     - [term()]
%%	Time  - integer() in milliseconds.
%%	Crash - term()
%%
%%	Spaws a new process that calls MFA. The call is considered
%%      successful if the call crashes with the given reason (Crash),
%%      or any other reason if Crash is not specified.
%%	** The call must terminate withing the given Time (defaults
%%      to infinity), or it is considered a failure (exit with reason
%%      'call_crash_timeout' is generated).

call_crash(M,F,A) ->
    call_crash(infinity,M,F,A).
call_crash(Time,M,F,A) ->
    call_crash(Time,any,M,F,A).
call_crash(Time,Crash,M,F,A) ->
    test_server_sup:call_crash(Time,Crash,M,F,A).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% start_node(SlaveName, Type, Options) ->
%%                   {ok, Slave} | {error, Reason}
%%
%% SlaveName = string(), atom().
%% Type = slave | peer
%% Options = [{tuple(), term()}]
%%
%% OptionList is a tuplelist wich may contain one
%% or more of these members:
%%
%% Slave and Peer:
%% {remote, true}         - Start the node on a remote host. If not specified,
%%                          the node will be started on the local host (with
%%                          some exceptions, for instance VxWorks,
%%                          where all nodes are started on a remote host).
%% {args, Arguments}      - Arguments passed directly to the node.
%% {cleanup, false}       - Nodes started with this option will not be killed
%%                          by the test server after completion of the test case
%%                          Therefore it is IMPORTANT that the USER terminates
%%                          the node!!
%% {erl, ReleaseList}     - Use an Erlang emulator determined by ReleaseList
%%                          when starting nodes, instead of the same emulator
%%                          as the test server is running. ReleaseList is a list
%%                          of specifiers, where a specifier is either
%%                          {release, Rel}, {prog, Prog}, or 'this'. Rel is
%%                          either the name of a release, e.g., "r7a" or
%%                          'latest'. 'this' means using the same emulator as
%%                          the test server. Prog is the name of an emulator
%%                          executable.  If the list has more than one element,
%%                          one of them is picked randomly. (Only
%%                          works on Solaris and Linux, and the test
%%                          server gives warnings when it notices that
%%                          nodes are not of the same version as
%%                          itself.)
%%
%% Peer only:
%% {wait, false}	  - Don't wait for the node to be started.
%% {fail_on_error, false} - Returns {error, Reason} rather than failing
%%			    the test case. This option can only be used with
%%                          peer nodes.
%%                          Note that slave nodes always act as if they had
%%                          fail_on_error==false.
%%

start_node(Name, Type, Options) ->
    lists:foreach(
      fun(N) ->
	      case firstname(N) of
		  Name ->
		      format("=== WARNING: Trying to start node \'~w\' when node"
			     " with same first name exists: ~w", [Name, N]);
		  _other -> ok
	      end
      end,
      nodes()),

    group_leader() ! {sync_apply,
		      self(),
		      {test_server_ctrl,start_node,[Name,Type,Options]}},
    Result = receive {sync_result,R} -> R end,

    case Result of
	{ok,Node} ->

            %% Cannot run cover on shielded node or on a node started
            %% by a shielded node.
            Cover = case is_cover() of
                        true ->
                            not is_shielded(Name) andalso same_version(Node);
                        false ->
                            false
                    end,

	    net_adm:ping(Node),
	    case Cover of
		true ->
		    do_cover_for_node(Node,start);
		_ ->
		    ok
	    end,
	    {ok,Node};
	{fail,Reason} -> fail(Reason);
	Error -> Error
    end.

firstname(N) ->
    list_to_atom(upto($@,atom_to_list(N))).

%% This should!!! crash if H is not member in list.
upto(H, [H | _T]) -> [];
upto(H, [X | T]) -> [X | upto(H,T)].


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% wait_for_node(Name) -> ok | {error,timeout}
%%
%% If a node is started with the options {wait,false}, this function
%% can be used to wait for the node to come up from the
%% test server point of view (i.e. wait until it has contacted
%% the test server controller after startup)
wait_for_node(Slave) ->
    group_leader() ! {sync_apply,
		      self(),
		      {test_server_ctrl,wait_for_node,[Slave]}},
    Result = receive {sync_result,R} -> R end,
    case Result of
	ok ->
	    Cover = case is_cover() of
			true ->
			    not is_shielded(Slave) andalso same_version(Slave);
			false ->
			    false
		    end,

	    net_adm:ping(Slave),
	    case Cover of
		true ->
		    do_cover_for_node(Slave,start);
		_ ->
		    ok
	    end;
	_ ->
	    ok
    end,
    Result.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% stop_node(Name) -> true|false
%%
%% Kills a (remote) node.
%% Also inform test_server_ctrl so it can clean up!
stop_node(Slave) ->
    Nocover = is_shielded(Slave) orelse not same_version(Slave),
    case is_cover() of
	true when not Nocover ->
	    do_cover_for_node(Slave,flush);
	_ ->
	    ok
    end,
    group_leader() ! {sync_apply,self(),{test_server_ctrl,stop_node,[Slave]}},
    Result = receive {sync_result,R} -> R end,
    case Result of
	ok ->
	    erlang:monitor_node(Slave, true),
	    slave:stop(Slave),
	    receive
		{nodedown, Slave} ->
		    format(minor, "Stopped slave node: ~p", [Slave]),
		    format(major, "=node_stop     ~p", [Slave]),
		    true
	    after 30000 ->
		    format("=== WARNING: Node ~p does not seem to terminate.",
			   [Slave]),
		    false
	    end;
	{error, _Reason} ->
	    %% Either, the node is already dead or it was started
	    %% with the {cleanup,false} option, or it was started
	    %% in some other way than test_server:start_node/3
	    format("=== WARNING: Attempt to stop a nonexisting slavenode (~p)~n"
		   "===          Trying to kill it anyway!!!",
		   [Slave]),
	    case net_adm:ping(Slave)of
		pong ->
		    slave:stop(Slave),
		    true;
		pang ->
		    false
	    end
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% is_release_available(Release) -> true | false
%% Release -> string()
%%
%% Test if a release (such as "r10b") is available to be
%% started using start_node/3.

is_release_available(Release) ->
    group_leader() ! {sync_apply,
		      self(),
		      {test_server_ctrl,is_release_available,[Release]}},
    receive {sync_result,R} -> R end.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% run_on_shielded_node(Fun, CArgs) -> term()
%% Fun -> function()
%% CArg -> list()
%%
%%
%% Fun is executed in a process on a temporarily created
%% hidden node. Communication with the job process goes
%% via a job proxy process on the hidden node, i.e. the
%% group leader of the test case process is the job proxy
%% process. This makes it possible to start nodes from the
%% hidden node that are unaware of the test server node.
%% Without the job proxy process all processes would have
%% a process residing on the test_server node as group_leader.
%%
%% Fun    -  Function to execute
%% CArg   -  Extra command line arguments to use when starting
%%           the shielded node.
%%
%% If Fun is successfully executed, the result is returned.
%%

run_on_shielded_node(Fun, CArgs) when is_function(Fun), is_list(CArgs) ->
    {A,B,C} = now(),
    Name = "shielded_node-" ++ integer_to_list(A) ++ "-" ++ integer_to_list(B)
	++ "-" ++ integer_to_list(C),
    Node = case start_node(Name, slave, [{args, "-hidden " ++ CArgs}]) of
	       {ok, N} -> N;
	       Err -> fail({failed_to_start_shielded_node, Err})
	   end,
    Master = self(),
    Ref = make_ref(),
    Slave = spawn(Node,
		  fun () ->
			  start_job_proxy(),
			  receive
			      Ref ->
				  Master ! {Ref, Fun()}
			  end,
			  receive after infinity -> infinity end
		  end),
    MRef = erlang:monitor(process, Slave),
    Slave ! Ref,
    receive
	{'DOWN', MRef, _, _, Info} ->
	    stop_node(Node),
	    fail(Info);
	{Ref, Res} ->
	    stop_node(Node),
	    receive
		{'DOWN', MRef, _, _, _} ->
		    Res
	    end
    end.

%% Return true if Name or node() is a shielded node
is_shielded(Name) ->
    case {cast_to_list(Name),atom_to_list(node())} of
	{"shielded_node"++_,_} -> true;
	{_,"shielded_node"++_} -> true;
	_ -> false
    end.

same_version(Name) ->
    ThisVersion = erlang:system_info(version),
    OtherVersion = rpc:call(Name, erlang, system_info, [version]),
    ThisVersion =:= OtherVersion.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% temp_name(Stem) -> string()
%% Stem = string()
%%
%% Create a unique file name, based on (starting with) Stem.
%% A filename of the form <Stem><Number> is generated, and the
%% function checks that that file doesn't already exist.
temp_name(Stem) ->
    {A,B,C} = erlang:now(),
    RandomNum = A bxor B bxor C,
    RandomName = Stem ++ integer_to_list(RandomNum),
    {ok,Files} = file:list_dir(filename:dirname(Stem)),
    case lists:member(RandomName,Files) of
	true ->
	    %% oh, already exists - bad luck. Try again.
	    temp_name(Stem); %% recursively try again
	false ->
	    RandomName
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% app_test/1
%%
app_test(App) ->
    app_test(App, pedantic).
app_test(App, Mode) ->
    test_server_sup:app_test(App, Mode).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% is_native(Mod) -> true | false
%%
%% Checks wether the module is natively compiled or not.

is_native(Mod) ->
    case catch Mod:module_info(native_addresses) of
	[_|_] -> true;
	_Other -> false
    end.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% comment(String) -> ok
%%
%% The given String will occur in the comment field
%% of the table on the test suite result page. If
%% called several times, only the last comment is
%% printed.
%% comment/1 is also overwritten by the return value
%% {comment,Comment} or fail/1 (which prints Reason
%% as a comment).
comment(String) ->
    group_leader() ! {comment,String},
    ok.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% read_comment() -> string()
%%
%% Read the current comment string stored in
%% state during test case execution.
read_comment() ->
    tc_supervisor_req(read_comment).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% make_priv_dir() -> ok
%%
%% Order test server to create the private directory
%% for the current test case.
make_priv_dir() ->
    tc_supervisor_req(make_priv_dir).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% os_type() -> OsType
%%
%% Returns the OsType of the target node. OsType is
%% the same as returned from os:type()
os_type() ->
    test_server_ctrl:get_target_os_type().


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% is_cover() -> boolean()
%%
%% Returns true if cover is running, else false
is_cover() ->
    case whereis(cover_server) of
	undefined -> false;
	_ -> true
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% is_debug() -> boolean()
%%
%% Returns true if the emulator is debug-compiled, false otherwise.
is_debug() ->
    case catch erlang:system_info(debug_compiled) of
	{'EXIT', _} ->
	    case string:str(erlang:system_info(system_version), "debug") of
		Int when is_integer(Int), Int > 0 -> true;
		_ -> false
	    end;
	Res ->
	    Res
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% has_lock_checking() -> boolean()
%%
%% Returns true if the emulator has lock checking enabled, false otherwise.
has_lock_checking() ->
    case catch erlang:system_info(lock_checking) of
	{'EXIT', _} -> false;
	Res -> Res
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% has_superfluous_schedulers() -> boolean()
%%
%% Returns true if the emulator has more scheduler threads than logical
%% processors, false otherwise.
has_superfluous_schedulers() ->
    case catch {erlang:system_info(schedulers),
		erlang:system_info(logical_processors)} of
	{S, P} when is_integer(S), is_integer(P), S > P -> true;
	_ -> false
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% is_commercial_build() -> boolean()
%%
%% Returns true if the current emulator is commercially supported.
%% (The emulator will not have "[source]" in its start-up message.)
%% We might want to do more tests on a commercial platform, for instance
%% ensuring that all applications have documentation).
is_commercial() ->
    case string:str(erlang:system_info(system_version), "source") of
	Int when is_integer(Int), Int > 0 -> false;
	_ -> true
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%                     DEBUGGER INTERFACE                    %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% purify_is_running() -> false|true
%%
%% Tests if Purify is currently running.

purify_is_running() ->
    case catch erlang:system_info({error_checker, running}) of
	{'EXIT', _} -> false;
	Res -> Res
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% purify_new_leaks() -> false|BytesLeaked
%% BytesLeaked = integer()
%%
%% Checks for new memory leaks if Purify is active.
%% Returns the number of bytes leaked, or false if Purify
%% is not running.
purify_new_leaks() ->
    case catch erlang:system_info({error_checker, memory}) of
	{'EXIT', _} -> false;
	Leaked when is_integer(Leaked) -> Leaked
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% purify_new_fds_inuse() -> false|FdsInuse
%% FdsInuse = integer()
%%
%% Checks for new file descriptors in use.
%% Returns the number of new file descriptors in use, or false
%% if Purify is not running.
purify_new_fds_inuse() ->
    case catch erlang:system_info({error_checker, fd}) of
	{'EXIT', _} -> false;
	Inuse when is_integer(Inuse) -> Inuse
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% purify_format(Format, Args) -> ok
%% Format = string()
%% Args = lists()
%%
%% Outputs the formatted string to Purify's logfile,if Purify is active.
purify_format(Format, Args) ->
    (catch erlang:system_info({error_checker, io_lib:format(Format, Args)})),
    ok.



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% Generic send functions for communication with host
%%
sync_local_or_remote_apply(Proxy,From,{M,F,A} = MFA) ->
    case get(test_server_job_sock) of
	undefined ->
	    %% i'm a local target
	    Result = apply(M,F,A),
	    if is_pid(Proxy) -> Proxy ! {sync_result_proxy,From,Result};
	       true -> From ! {sync_result,Result}
	    end;
	JobSock ->
	    %% i'm a remote target
	    request(JobSock,{sync_apply,MFA}),
	    {sync_result,Result} = recv(JobSock),
	    if is_pid(Proxy) -> Proxy ! {sync_result_proxy,From,Result};
	       true -> From ! {sync_result,Result}
	    end
    end.
local_or_remote_apply({M,F,A} = MFA) ->
    case get(test_server_job_sock) of
	undefined ->
	    %% i'm a local target
	    apply(M,F,A),
	    ok;
	JobSock ->
	    %% i'm a remote target
	    request(JobSock,{apply,MFA}),
	    ok
    end.

request(Sock,Request) ->
    gen_tcp:send(Sock,<<1,(term_to_binary(Request))/binary>>).

%%
%% Generic receive function for communication with host
%%
recv(Sock) ->
    case gen_tcp:recv(Sock,0) of
	{error,closed} ->
	    gen_tcp:close(Sock),
	    exit(connection_lost);
	{ok,<<1,Request/binary>>} ->
	    binary_to_term(Request);
	{ok,<<0,B/binary>>} ->
	    B
    end.