The R13B03 release.OTP_R13B03

1 files changed, 2203 insertions, 0 deletions

diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl
new file mode 100644
index 0000000000..99e24205ae
--- /dev/null
+++ b/lib/test_server/src/test_server.erl
@@ -0,0 +1,2203 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+-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/2]).
+
+%%% 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([hours/1,minutes/1,seconds/1,sleep/1,timecall/3]).
+-export([timetrap_scale_factor/0,timetrap/1,timetrap_cancel/1]).
+-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]).
+-export([os_type/0]).
+-export([run_on_shielded_node/2]).
+-export([is_cover/0,is_debug/0,is_commercial/0]).
+
+-export([break/1,continue/0]).
+
+%%% 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;
+				    Dont=:=test_server;
+				    Dont=:=test_server_ctrl ->
+    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) -> [{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.
+cover_analyse(Analyse,Modules) ->
+    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 = lists:map(
+	  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),
+    Sticky = unstick_all_sticky(node()),
+    cover:stop(),
+    stick_all_sticky(node(),Sticky),
+    R.
+
+
+unstick_all_sticky(Node) ->
+    lists:filter(
+      fun(M) -> 
+	      case code:is_sticky(M) of
+		  true ->
+		      rpc:call(Node,code,unstick_mod,[M]),
+		      true;
+		  false ->
+		      false
+	      end
+      end,
+      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,MultiplyTimetrap) -> 
+%%               {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.
+%% This might be io requests (which are redirected to the log files).
+%%
+%% 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.
+%%
+%% MultiplyTimetrap indicates a possible extension of all timetraps
+%% Timetraps will be multiplied by this integer. If it is infinity, no
+%% timetraps will be started at all.
+
+run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,MultiplyTimetrap}) ->
+    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, MultiplyTimetrap),
+    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, MultiplyTimetrap) ->
+    case get(test_server_job_dir) of
+	undefined ->
+	    %% i'm a local target
+	    do_run_test_case_apply(Mod, Func, Args, Name, RunInit, MultiplyTimetrap);
+	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,
+					   MultiplyTimetrap);
+		_other ->
+		    do_run_test_case_apply(Mod, Func, Args, Name, RunInit,
+					   MultiplyTimetrap)
+	    end
+    end.
+do_run_test_case_apply(Mod, Func, Args, Name, RunInit, MultiplyTimetrap) ->
+    {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 "),
+    TCCallback = get(test_server_testcase_callback),
+    Ref = make_ref(),
+    OldGLeader = group_leader(),
+    %% Set ourself to group leader for the spawned process
+    group_leader(self(),self()),
+    Pid = 
+	spawn_link(
+	  fun() -> 
+		  run_test_case_eval(Mod, Func, Args, Name, Ref, 
+				     RunInit, MultiplyTimetrap,
+				     TCCallback)
+	  end),
+    group_leader(OldGLeader, self()),
+    put(test_server_detected_fail, []),
+    run_test_case_msgloop(Ref, Pid, false, false, "").
+
+%% 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, CaptureStdout, Terminate, Comment) ->
+    %% NOTE: Keep job_proxy_msgloop/0 up to date when changes
+    %%       are made in this function!
+    {Timeout,ReturnValue} =
+	case Terminate of
+	    {true, ReturnVal} ->
+		{20, ReturnVal};
+	    false ->
+		{infinity, should_never_appear}
+	end,
+    receive
+	{abort_current_testcase,Reason,From} ->
+	    Line = get_loc(Pid),
+	    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,CaptureStdout,Terminate,NewComment);
+        {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}}
+	when is_list(Format) ->
+	    Msg = (catch io_lib:Func(Format,Args)),
+	    run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func),
+            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+        {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}}
+	when is_atom(Format) ->
+	    Msg = (catch io_lib:Func(Format,Args)),
+	    run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func),
+            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+        {io_request,From,ReplyAs,{put_chars,Bytes}} ->
+	    run_test_case_msgloop_io(
+	      ReplyAs,CaptureStdout,Bytes,From,put_chars),
+            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+        {io_request,From,ReplyAs,{put_chars,unicode,io_lib,Func,[Format,Args]}}
+	when is_list(Format) ->
+	    Msg = unicode_to_latin1(catch io_lib:Func(Format,Args)),
+	    run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func),
+            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+        {io_request,From,ReplyAs,{put_chars,latin1,io_lib,Func,[Format,Args]}}
+	when is_list(Format) ->
+	    Msg = (catch io_lib:Func(Format,Args)),
+	    run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func),
+            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+        {io_request,From,ReplyAs,{put_chars,unicode,io_lib,Func,[Format,Args]}}
+	when is_atom(Format) ->
+	    Msg = unicode_to_latin1(catch io_lib:Func(Format,Args)),
+	    run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func),
+            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+        {io_request,From,ReplyAs,{put_chars,latin1,io_lib,Func,[Format,Args]}}
+	when is_atom(Format) ->
+	    Msg = (catch io_lib:Func(Format,Args)),
+	    run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func),
+            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+        {io_request,From,ReplyAs,{put_chars,unicode,Bytes}} ->
+	    run_test_case_msgloop_io(
+	      ReplyAs,CaptureStdout,unicode_to_latin1(Bytes),From,put_chars),
+            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+        {io_request,From,ReplyAs,{put_chars,latin1,Bytes}} ->
+	    run_test_case_msgloop_io(
+	      ReplyAs,CaptureStdout,Bytes,From,put_chars),
+            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+        IoReq when element(1, IoReq) == io_request ->
+	    %% something else, just pass it on
+            group_leader() ! IoReq,
+            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+	{structured_io,ClientPid,Msg} ->
+	    output(Msg, ClientPid),
+            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+	{capture,NewCapture} ->
+            run_test_case_msgloop(Ref,Pid,NewCapture,Terminate,Comment);
+	{sync_apply,From,MFA} ->
+	    sync_local_or_remote_apply(false,From,MFA),
+	    run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+	{sync_apply_proxy,Proxy,From,MFA} ->
+	    sync_local_or_remote_apply(Proxy,From,MFA),
+	    run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+	{printout,Detail,Format,Args} ->
+	    print(Detail,Format,Args),
+	    run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+	{comment,NewComment} ->
+	    Terminate1 =
+		case Terminate of
+		    {true,{Time,Value,Loc,Opts,_OldComment}} -> 
+			{true,{Time,Value,mod_loc(Loc),Opts,NewComment}};
+		    Other ->
+			Other
+		end,
+	    run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate1,NewComment);
+	{'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} ->
+	    RetVal = {Time/1000000,Value,mod_loc(Loc),Opts,Comment},
+	    run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment);
+	{'EXIT',Pid,Reason} ->
+	    case Reason of
+		{timetrap_timeout,TVal,Loc} ->
+		    %% convert Loc to form that can be formatted
+		    Loc1 = mod_loc(Loc),
+		    {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,Pid,{timetrap_timeout,TVal},
+				  Loc1,self(),Comment),
+		    run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+		{timetrap_timeout,TVal,Loc,InitOrEnd} ->
+		    Loc1 = mod_loc(Loc),
+		    {Mod,_Func} = get_mf(Loc1),
+		    spawn_fw_call(Mod,InitOrEnd,Pid,{timetrap_timeout,TVal},
+				  Loc1,self(),Comment),
+		    run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);		    
+		{testcase_aborted,Reason,Loc} ->
+		    Loc1 = mod_loc(Loc),
+		    {Mod,Func} = get_mf(Loc1),
+		    spawn_fw_call(Mod,Func,Pid,{testcase_aborted,Reason},
+				  Loc1,self(),Comment),
+		    run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+		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)
+		    spawn_fw_call(undefined,undefined,Pid,testcase_aborted_or_killed,
+				  unknown,self(),Comment),
+		    run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+		_ ->
+		    %% the testcase has terminated because of Reason (e.g. an exit
+		    %% because a linked process failed)
+		    spawn_fw_call(undefined,undefined,Pid,Reason,
+				  unknown,self(),Comment),
+		    run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment)
+	    end;
+	{_FwCallPid,fw_notify_done,RetVal} ->
+	    %% the framework has been notified, we're finished
+	    run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment);	    
+ 	{'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} ->
+	    %% a framework function failed
+	    CB = os:getenv("TEST_SERVER_FRAMEWORK"),
+	    Loc = case CB of
+		      false -> 
+			  {test_server,Func};
+		      _ -> 
+			  {list_to_atom(CB),Func}
+		  end,
+	    RetVal = {died,{framework_error,Loc,Error},Loc,"Framework error"},
+	    run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment);
+	{failed,File,Line} ->
+	    put(test_server_detected_fail, 
+		[{File, Line}| get(test_server_detected_fail)]),
+       	    run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);
+	_Other when not is_tuple(_Other) ->
+	    %% ignore anything not generated by test server
+	    run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment);	    
+	_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,CaptureStdout,Terminate,Comment)
+    after Timeout ->
+	    ReturnValue
+    end.
+
+run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func) ->
+    case Msg of
+	{'EXIT',_} ->
+	    From ! {io_reply,ReplyAs,{error,Func}};
+	_ ->
+	    From ! {io_reply,ReplyAs,ok}
+    end,
+    if  CaptureStdout /= false ->
+	    CaptureStdout ! {captured,Msg};
+	true ->
+	    ok
+    end,
+    output({minor,Msg},From).
+
+output(Msg,Sender) ->
+    local_or_remote_apply({test_server_ctrl,output,[Msg,Sender]}).
+
+spawn_fw_call(Mod,{init_per_testcase,Func},Pid,{timetrap_timeout,TVal}=Why,
+	      Loc,SendTo,Comment) ->
+    FwCall =
+	fun() ->
+	    Skip = {skip,{failed,{Mod,init_per_testcase,Why}}},
+	    %% if init_per_testcase fails, the test case 
+	    %% should be skipped
+	    case catch test_server_sup:framework_call(
+			 end_tc,[?pl2a(Mod),Func,{Pid,Skip,[[]]}]) of
+		{'EXIT',FwEndTCErr} ->
+		    exit({fw_notify_done,end_tc,FwEndTCErr});
+		_ ->
+		    ok
+	    end,
+	    %% finished, report back
+	    SendTo ! {self(),fw_notify_done,
+		      {TVal/1000,Skip,Loc,[],Comment}}
+	end,
+    spawn_link(FwCall);
+spawn_fw_call(Mod,{end_per_testcase,Func},Pid,{timetrap_timeout,TVal}=Why,
+	      Loc,SendTo,_Comment) ->
+    FwCall =
+	fun() ->
+	    Conf = [{tc_status,ok}],
+	    %% if end_per_testcase fails, the test case should be
+	    %% reported successful with a warning printed as comment
+	    case catch test_server_sup:framework_call(end_tc,
+						      [?pl2a(Mod),Func,
+						       {Pid,
+							{failed,{Mod,end_per_testcase,Why}},
+							[Conf]}]) of
+		{'EXIT',FwEndTCErr} ->
+		    exit({fw_notify_done,end_tc,FwEndTCErr});
+		_ ->
+		    ok
+	    end,
+	    %% finished, report back
+	    SendTo ! {self(),fw_notify_done,
+		      {TVal/1000,{error,{Mod,end_per_testcase,Why}},Loc,[],
+		       ["<font color=\"red\">"
+			"WARNING: end_per_testcase timed out!"
+			"</font>"]}}
+	end,
+    spawn_link(FwCall);
+spawn_fw_call(Mod,Func,Pid,Error,Loc,SendTo,Comment) ->
+    FwCall =
+	fun() ->
+		case catch fw_error_notify(Mod,Func,[],
+					   Error,Loc) of
+		    {'EXIT',FwErrorNotifyErr} ->
+			exit({fw_notify_done,error_notification,
+			      FwErrorNotifyErr});
+		    _ ->
+			ok
+		end,
+		Conf = [{tc_status,{failed,timetrap_timeout}}],
+		case catch test_server_sup:framework_call(end_tc,
+							  [?pl2a(Mod),Func,
+							   {Pid,Error,[Conf]}]) of
+		    {'EXIT',FwEndTCErr} ->
+			exit({fw_notify_done,end_tc,FwEndTCErr});
+		    _ ->
+			ok
+		end,
+		%% finished, report back
+		SendTo ! {self(),fw_notify_done,{died,Error,Loc,Comment}}
+	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, 
+		   MultiplyTimetrap, TCCallback) ->
+    put(test_server_multiply_timetraps,MultiplyTimetrap),
+    {{Time,Value},Loc,Opts} =
+	case test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0],
+					    {ok,Args0}) of
+	    {ok,Args} ->
+		run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback);
+	    Error = {error,_Reason} ->
+		test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func,{Error,Args0}]),
+		{{0,{skip,{failed,Error}}},{Mod,Func},[]};
+	    {fail,Reason} ->
+		[Conf] = Args0,
+		Conf1 = [{tc_status,{failed,Reason}} | Conf],
+		fw_error_notify(Mod, Func, Conf, Reason),
+		test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func,
+						       {{error,Reason},[Conf1]}]),
+		{{0,{failed,Reason}},{Mod,Func},[]};
+	    Skip = {skip,_Reason} ->
+		test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func,{Skip,Args0}]),
+		{{0,Skip},{Mod,Func},[]};
+	    {auto_skip,Reason} ->
+		test_server_sup:framework_call(end_tc,[?pl2a(Mod),
+						       Func,
+						       {{skip,Reason},Args0}]),
+		{{0,{skip,{fw_auto_skip,Reason}}},{Mod,Func},[]}
+	end,
+    exit({Ref,Time,Value,Loc,Opts}).
+
+run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) ->
+    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}}],
+		    test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func,{Skip,[Conf]}]),
+		    {{0,{skip,Reason}},Line,[]};
+		{skip_and_save,Reason,SaveCfg} ->
+		    Line = get_loc(),
+		    Conf = [{tc_status,{skipped,Reason}},{save_config,SaveCfg}],
+		    test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func,
+							   {{skip,Reason},[Conf]}]),
+		    {{0,{skip,Reason}},Line,[]};
+		{ok,NewConf} ->
+		    put(test_server_init_or_end_conf,undefined),
+		    %% call user callback function if defined
+		    NewConf1 = user_callback(TCCallback, Mod, Func, init, NewConf),
+		    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 ->
+				fw_error_notify(Mod, Func, NewConf1,
+						TCError, mod_loc(Loc)),
+				{[{tc_status,{failed,TCError}}|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),
+		    {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 -> % unexpected termination
+				{Failure,TSReturn,EndConf1};
+			    _ -> 
+				{FWReturn,TSReturn,EndConf1}
+			end,
+		    case test_server_sup:framework_call(end_tc, [?pl2a(Mod), Func,
+								 {FWReturn1,[EndConf2]}]) of
+			{fail,Reason} ->
+			    fw_error_notify(Mod, Func, EndConf2, Reason),
+			    {{T,{failed,Reason}},{Mod,Func},[]};
+			_ ->
+			    {{T,TSReturn1},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, Loc, Return1),
+	    {{T,Return2},Loc,Opts}
+    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
+	    test_server_sup:framework_call(end_tc, [?pl2a(M),F,{ok,A}]),
+	    {Return,[]}
+    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)),
+    test_server_sup:framework_call(end_tc,
+				   [?pl2a(M),F,{{error,TCError},
+						[[{tc_status,{failed,TCError}}|Args]]}]),
+    {Failed,SaveOpts};
+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) ->
+    test_server_sup:framework_call(end_tc, [?pl2a(M),F,{Final,A}]),
+    {Final,lists:reverse(SaveOpts)}.
+
+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,
+    %% init_per_testcase defined, returns new configuration
+    case erlang:function_exported(Mod,init_per_testcase,2) of
+	true ->
+	    case catch my_apply(Mod, init_per_testcase, [Func|Args]) of
+		{'$test_server_ok',{Skip,Reason}} when Skip==skip; 
+						       Skip==skipped ->
+		    {skip,Reason};
+		{'$test_server_ok',Res={skip_and_save,_,_}} ->
+		    Res;
+		{'$test_server_ok',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;
+		{'$test_server_ok',_Other} ->
+		    group_leader() ! {printout,12, 
+				      "ERROR! init_per_testcase did not return "
+				      "a Config list.\n",[]},   
+		    {skip,{failed,{Mod,init_per_testcase,bad_return}}};
+		{'EXIT',Reason} ->
+		    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}}};
+		Other ->
+		    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}}}
+	    end;
+	false ->
+	    %% Optional init_per_testcase not defined
+	    %% keep quiet.
+	    [Config] = Args,
+	    {ok, Config}
+    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}}),
+    case catch my_apply(Mod, EndFunc, [Func,Conf]) of
+	{'$test_server_ok',SaveCfg={save_config,_}} ->
+	    SaveCfg;
+	{'$test_server_ok',{fail,_}=Fail} ->
+	    Fail;
+	{'$test_server_ok',_} ->
+	    ok;
+	{'EXIT',Reason} = Why ->
+	    comment(io_lib:format("<font color=\"red\">"
+				  "WARNING: ~w crashed!"
+				  "</font>\n",[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}};
+	Other ->
+	    comment(io_lib:format("<font color=\"red\">"
+				  "WARNING: ~w thrown!"
+				  "</font>\n",[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}}
+    end.
+
+get_loc() ->
+    case catch test_server_line:get_lines() of
+	[] ->
+	    get(test_server_loc);
+	{'EXIT',_} ->
+	    get(test_server_loc);
+	Loc ->
+	    Loc
+    end.
+
+get_loc(Pid) ->
+    {dictionary,Dict} = process_info(Pid, dictionary),
+    lists:foreach(fun({Key,Val}) -> put(Key,Val) end,Dict),
+    get_loc().
+
+get_mf([{M,F,_}|_]) -> {M,F};
+get_mf([{M,F}|_])   -> {M,F};
+get_mf(_)           -> {undefined,undefined}.
+
+mod_loc(Loc) ->
+    %% handle diff line num versions
+    case Loc of	
+	[{{_M,_F},_L}|_] ->
+	    [{?pl2a(M),F,L} || {{M,F},L} <- Loc];
+	[{_M,_F}|_] ->
+	    [{?pl2a(M),F} || {M,F} <- Loc];
+	{{M,F},L} ->
+	    [{?pl2a(M),F,L}];
+	{M,ForL} ->
+	    [{?pl2a(M),ForL}];
+	_ ->
+	    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) -> 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_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(),
+    Val = (catch my_apply(M, F, A)),
+    After = erlang:now(),
+    Result = case Val of
+		 {'$test_server_ok', R} -> 
+		     R; % test case ok
+		 {'EXIT',_Reason} = R -> 
+		     R; % test case crashed
+		 Other -> 
+		     {failed, {thrown,Other}} % test case was thrown
+	  end,
+    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}.
+
+my_apply(M, F, A) ->
+    {'$test_server_ok',apply(M, F, A)}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                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!)    %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+unicode_to_latin1(Chars) when is_list(Chars); is_binary(Chars) ->
+    lists:flatten( 
+      [ case X of
+	    High when High > 255 ->
+		io_lib:format("\\{~.8B}",[X]);
+	    Low ->
+		Low
+	end || X <- unicode:characters_to_list(Chars,unicode) ]);
+unicode_to_latin1(Garbage) ->
+    Garbage.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% 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([]).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% 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.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% 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)),
+    exit({suite_failed,Reason}).
+
+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() ->
+    exit(suite_failed).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% break(Comment) -> ok
+%%
+%% Break a test case so part of the test can be done manually.
+%% Use continue/0 to continue.
+break(Comment) ->
+    case erase(test_server_timetraps) of
+	undefined -> ok;
+	List -> lists:foreach(fun(Ref) -> timetrap_cancel(Ref) end,List)
+    end,
+    io:format(user,
+	      "\n\n\n--- SEMIAUTOMATIC TESTING ---"
+	      "\nThe test case executes on process ~w"
+	      "\n\n\n~s"
+	      "\n\n\n-----------------------------\n\n"
+	      "Continue with --> test_server:continue().\n",
+	      [self(),Comment]),
+    case whereis(test_server_break_process) of
+	undefined ->
+	    spawn_break_process(self());
+	OldBreakProcess ->
+	    OldBreakProcess ! cancel,
+	    spawn_break_process(self())
+    end,
+    receive continue -> ok end.
+
+spawn_break_process(Pid) ->
+    spawn(fun() -> 
+		  register(test_server_break_process,self()),
+		  receive 
+		      continue -> continue(Pid);
+		      cancel -> ok
+		  end
+	  end).
+
+continue() ->
+    case whereis(test_server_break_process) of
+	undefined ->
+	     ok;
+	BreakProcess ->
+	    BreakProcess ! continue
+    end.
+
+continue(Pid) ->
+    Pid ! continue.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% timetrap_scale_factor() -> Factor
+%%
+%% Returns the amount to scale timetraps with.
+
+timetrap_scale_factor() ->
+    F0 = case test_server:purify_is_running() of
+	    true -> 5;
+	    false -> 1
+	end,
+    F1 = case {is_debug(), has_lock_checking()} of
+	     {true,_} -> 6 * F0;
+	     {false,true} -> 2 * F0;
+	     {false,false} -> F0
+	 end,
+    F2 = case has_superfluous_schedulers() of
+	     true -> 3*F1;
+	     false -> F1
+	 end,
+    F = case test_server_sup:get_os_family() of
+	    vxworks -> 5 * F2;
+	    _ -> F2
+	end,
+    case test_server:is_cover() of
+	true -> 10 * F;
+	false -> F
+    end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% 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(Timeout0) ->
+    Timeout = time_ms(Timeout0),
+    cancel_default_timetrap(),
+    case get(test_server_multiply_timetraps) of
+	undefined -> timetrap1(Timeout);
+	infinity -> infinity;
+	Int -> timetrap1(Timeout*Int)
+    end.
+
+timetrap1(Timeout) ->
+    Ref = spawn_link(test_server_sup,timetrap,[Timeout,self()]),
+    case get(test_server_timetraps) of
+	undefined -> put(test_server_timetraps,[Ref]);
+	List -> put(test_server_timetraps,[Ref|List])
+    end,
+    Ref.
+
+ensure_timetrap(Config) ->
+    %format("ensure_timetrap:~p~n",[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.
+
+cancel_default_timetrap() ->
+    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_spec,Other});
+time_ms(Ms) when is_integer(Ms) -> Ms;
+time_ms(Other) -> exit({invalid_time_spec,Other}).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% timetrap_cancel(Handle) -> ok
+%% Handle = term()
+%%
+%% Cancels a time trap.
+timetrap_cancel(infinity) ->
+    ok;
+timetrap_cancel(Handle) ->
+    case get(test_server_timetraps) of
+	undefined -> ok;
+	[Handle] -> erase(test_server_timetraps);
+	List -> put(test_server_timetraps,lists:delete(Handle,List))
+    end,
+    test_server_sup:timetrap_cancel(Handle).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% 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).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% 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, as for the case of VxWorks and OSE,
+%%                          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 -> 
+		    Sticky = unstick_all_sticky(Node),
+		    cover:start(Node),
+		    stick_all_sticky(Node,Sticky);
+		_ -> 
+		    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]}},
+    receive {sync_result,R} -> R end.
+    
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% 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 -> 
+	    Sticky = unstick_all_sticky(Slave),
+	    cover:stop(Slave),
+	    stick_all_sticky(Slave,Sticky);
+	_ ->
+	    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) ->
+    case os:type() of
+	{ose,_} -> 
+	    Comment = "Skipping app_test on OSE",
+	    comment(Comment), % in case user ignores the return value
+	    {skip,Comment};
+	_other -> 
+	    test_server_sup:app_test(App, Mode)
+    end.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% 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.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% 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.