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

%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2002-2014. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%%     http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
%% %CopyrightEnd%
%%
-module(test_server_ctrl).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%                                                                  %%
%%                      The Erlang Test Server                      %%
%%                                                                  %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% MODULE DEPENDENCIES:
%% HARD TO REMOVE: erlang, lists, io_lib, gen_server, file, io, string,
%%                 code, ets, rpc, gen_tcp, inet, erl_tar, sets,
%%                 test_server, test_server_sup, test_server_node
%% EASIER TO REMOVE: filename, filelib, lib, re
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%% SUPERVISOR INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([start/0, start/1, start_link/1, stop/0]).

%%% OPERATOR INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([add_spec/1, add_dir/2, add_dir/3]).
-export([add_module/1, add_module/2,
	 add_conf/3,
	 add_case/2, add_case/3, add_cases/2, add_cases/3]).
-export([add_dir_with_skip/3, add_dir_with_skip/4, add_tests_with_skip/3]).
-export([add_module_with_skip/2, add_module_with_skip/3,
	 add_conf_with_skip/4,
	 add_case_with_skip/3, add_case_with_skip/4,
	 add_cases_with_skip/3, add_cases_with_skip/4]).
-export([jobs/0, run_test/1, wait_finish/0, idle_notify/1,
	 abort_current_testcase/1, abort/0]).
-export([start_get_totals/1, stop_get_totals/0]).
-export([reject_io_reqs/1, get_levels/0, set_levels/3]).
-export([multiply_timetraps/1, scale_timetraps/1, get_timetrap_parameters/0]).
-export([create_priv_dir/1]).
-export([cover/1, cover/2, cover/3,
	 cover_compile/7, cover_analyse/2, cross_cover_analyse/2,
	 trc/1, stop_trace/0]).
-export([testcase_callback/1]).
-export([set_random_seed/1]).
-export([kill_slavenodes/0]).

%%% TEST_SERVER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([print/2, print/3, print/4, print_timestamp/2]).
-export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]).
-export([format/1, format/2, format/3, to_string/1]).
-export([get_target_info/0]).
-export([get_hosts/0]).
-export([node_started/1]).
-export([uri_encode/1,uri_encode/2]).

%%% DEBUGGER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([i/0, p/1, p/3, pi/2, pi/4, t/0, t/1]).

%%% PRIVATE EXPORTED %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([init/1, terminate/2]).
-export([handle_call/3, handle_cast/2, handle_info/2]).
-export([do_test_cases/4]).
-export([do_spec/2, do_spec_list/2]).
-export([xhtml/2, escape_chars/1]).

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

-include("test_server_internal.hrl").
-include_lib("kernel/include/file.hrl").
-define(suite_ext, "_SUITE").
-define(log_ext, ".log.html").
-define(src_listing_ext,  ".src.html").
-define(logdir_ext, ".logs").
-define(data_dir_suffix, "_data/").
-define(suitelog_name, "suite.log").
-define(coverlog_name, "cover.html").
-define(raw_coverlog_name, "cover.log").
-define(cross_coverlog_name, "cross_cover.html").
-define(raw_cross_coverlog_name, "cross_cover.log").
-define(cross_cover_info, "cross_cover.info").
-define(cover_total, "total_cover.log").
-define(unexpected_io_log, "unexpected_io.log.html").
-define(last_file, "last_name").
-define(last_link, "last_link").
-define(last_test, "last_test").
-define(html_ext, ".html").
-define(now, os:timestamp()).

-define(void_fun, fun() -> ok end).
-define(mod_result(X), if X == skip -> skipped;
			  X == auto_skip -> skipped;
			  true -> X end).

-define(auto_skip_color, "#FFA64D").
-define(user_skip_color, "#FF8000").
-define(sortable_table_name, "SortableTable").

-record(state,{jobs=[], levels={1,19,10}, reject_io_reqs=false,
	       multiply_timetraps=1, scale_timetraps=true,
	       create_priv_dir=auto_per_run, finish=false,
	       target_info, trc=false, cover=false, wait_for_node=[],
	       testcase_callback=undefined, idle_notify=[],
	       get_totals=false, random_seed=undefined}).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% OPERATOR INTERFACE

add_dir(Name, Job=[Dir|_Dirs]) when is_list(Dir) ->
    add_job(cast_to_list(Name),
	    lists:map(fun(D)-> {dir,cast_to_list(D)} end, Job));
add_dir(Name, Dir) ->
    add_job(cast_to_list(Name), {dir,cast_to_list(Dir)}).

add_dir(Name, Job=[Dir|_Dirs], Pattern) when is_list(Dir) ->
    add_job(cast_to_list(Name),
	    lists:map(fun(D)-> {dir,cast_to_list(D),
				cast_to_list(Pattern)} end, Job));
add_dir(Name, Dir, Pattern) ->
    add_job(cast_to_list(Name), {dir,cast_to_list(Dir),cast_to_list(Pattern)}).

add_module(Mod) when is_atom(Mod) ->
    add_job(atom_to_list(Mod), {Mod,all}).

add_module(Name, Mods) when is_list(Mods) ->
    add_job(cast_to_list(Name), lists:map(fun(Mod) -> {Mod,all} end, Mods)).

add_conf(Name, Mod, Conf) when is_tuple(Conf) ->
    add_job(cast_to_list(Name), {Mod,[Conf]});

add_conf(Name, Mod, Confs) when is_list(Confs) ->
    add_job(cast_to_list(Name), {Mod,Confs}).

add_case(Mod, Case) when is_atom(Mod), is_atom(Case) ->
    add_job(atom_to_list(Mod), {Mod,Case}).

add_case(Name, Mod, Case) when is_atom(Mod), is_atom(Case) ->
    add_job(Name, {Mod,Case}).

add_cases(Mod, Cases) when is_atom(Mod), is_list(Cases) ->
    add_job(atom_to_list(Mod), {Mod,Cases}).

add_cases(Name, Mod, Cases) when is_atom(Mod), is_list(Cases) ->
    add_job(Name, {Mod,Cases}).

add_spec(Spec) ->
    Name = filename:rootname(Spec, ".spec"),
    case filelib:is_file(Spec) of
	true -> add_job(Name, {spec,Spec});
	false -> {error,nofile}
    end.

%% This version of the interface is to be used if there are
%% suites or cases that should be skipped.

add_dir_with_skip(Name, Job=[Dir|_Dirs], Skip) when is_list(Dir) ->
    add_job(cast_to_list(Name),
	    lists:map(fun(D)-> {dir,cast_to_list(D)} end, Job),
	    Skip);
add_dir_with_skip(Name, Dir, Skip) ->
    add_job(cast_to_list(Name), {dir,cast_to_list(Dir)}, Skip).

add_dir_with_skip(Name, Job=[Dir|_Dirs], Pattern, Skip) when is_list(Dir) ->
    add_job(cast_to_list(Name),
	    lists:map(fun(D)-> {dir,cast_to_list(D),
				cast_to_list(Pattern)} end, Job),
	    Skip);
add_dir_with_skip(Name, Dir, Pattern, Skip) ->
    add_job(cast_to_list(Name),
	    {dir,cast_to_list(Dir),cast_to_list(Pattern)}, Skip).

add_module_with_skip(Mod, Skip) when is_atom(Mod) ->
    add_job(atom_to_list(Mod), {Mod,all}, Skip).

add_module_with_skip(Name, Mods, Skip) when is_list(Mods) ->
    add_job(cast_to_list(Name), lists:map(fun(Mod) -> {Mod,all} end, Mods), Skip).

add_conf_with_skip(Name, Mod, Conf, Skip) when is_tuple(Conf) ->
    add_job(cast_to_list(Name), {Mod,[Conf]}, Skip);

add_conf_with_skip(Name, Mod, Confs, Skip) when is_list(Confs) ->
    add_job(cast_to_list(Name), {Mod,Confs}, Skip).

add_case_with_skip(Mod, Case, Skip) when is_atom(Mod), is_atom(Case) ->
    add_job(atom_to_list(Mod), {Mod,Case}, Skip).

add_case_with_skip(Name, Mod, Case, Skip) when is_atom(Mod), is_atom(Case) ->
    add_job(Name, {Mod,Case}, Skip).

add_cases_with_skip(Mod, Cases, Skip) when is_atom(Mod), is_list(Cases) ->
    add_job(atom_to_list(Mod), {Mod,Cases}, Skip).

add_cases_with_skip(Name, Mod, Cases, Skip) when is_atom(Mod), is_list(Cases) ->
    add_job(Name, {Mod,Cases}, Skip).

add_tests_with_skip(LogDir, Tests, Skip) ->
    add_job(LogDir,
	    lists:map(fun({Dir,all,all}) ->
			      {Dir,{dir,Dir}};
			 ({Dir,Mods,all}) ->
			      {Dir,lists:map(fun(M) -> {M,all} end, Mods)};
			 ({Dir,Mod,Cases}) ->
			      {Dir,{Mod,Cases}}
		      end, Tests),
	    Skip).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% COMMAND LINE INTERFACE

parse_cmd_line(Cmds) ->
    parse_cmd_line(Cmds, [], [], local, false, false, undefined).

parse_cmd_line(['SPEC',Spec|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
    case file:consult(Spec) of
	{ok, TermList} ->
	    Name = filename:rootname(Spec),
	    parse_cmd_line(Cmds, TermList++SpecList, [Name|Names], Param,
			   Trc, Cov, TCCB);
	{error,Reason} ->
	    io:format("Can't open ~w: ~p\n",[Spec, file:format_error(Reason)]),
	    parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, TCCB)
    end;
parse_cmd_line(['NAME',Name|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
    parse_cmd_line(Cmds, SpecList, [{name,atom_to_list(Name)}|Names],
		   Param, Trc, Cov, TCCB);
parse_cmd_line(['SKIPMOD',Mod|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
    parse_cmd_line(Cmds, [{skip,{Mod,"by command line"}}|SpecList], Names,
		   Param, Trc, Cov, TCCB);
parse_cmd_line(['SKIPCASE',Mod,Case|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
    parse_cmd_line(Cmds, [{skip,{Mod,Case,"by command line"}}|SpecList], Names,
		   Param, Trc, Cov, TCCB);
parse_cmd_line(['DIR',Dir|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
    Name = filename:basename(Dir),
    parse_cmd_line(Cmds, [{topcase,{dir,Name}}|SpecList], [Name|Names],
		   Param, Trc, Cov, TCCB);
parse_cmd_line(['MODULE',Mod|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
    parse_cmd_line(Cmds,[{topcase,{Mod,all}}|SpecList],[atom_to_list(Mod)|Names],
		   Param, Trc, Cov, TCCB);
parse_cmd_line(['CASE',Mod,Case|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
    parse_cmd_line(Cmds,[{topcase,{Mod,Case}}|SpecList],[atom_to_list(Mod)|Names],
		   Param, Trc, Cov, TCCB);
parse_cmd_line(['TRACE',Trc|Cmds], SpecList, Names, Param, _Trc, Cov, TCCB) ->
    parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, TCCB);
parse_cmd_line(['COVER',App,CF,Analyse|Cmds], SpecList, Names, Param, Trc, _Cov, TCCB) ->
    parse_cmd_line(Cmds, SpecList, Names, Param, Trc, {{App,CF}, Analyse}, TCCB);
parse_cmd_line(['TESTCASE_CALLBACK',Mod,Func|Cmds], SpecList, Names, Param, Trc, Cov, _) ->
    parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, {Mod,Func});
parse_cmd_line([Obj|_Cmds], _SpecList, _Names, _Param, _Trc, _Cov, _TCCB) ->
    io:format("~w: Bad argument: ~w\n", [?MODULE,Obj]),
    io:format(" Use the `ts' module to start tests.\n", []),
    io:format(" (If you ARE using `ts', there is a bug in `ts'.)\n", []),
    halt(1);
parse_cmd_line([], SpecList, Names, Param, Trc, Cov, TCCB) ->
    NameList = lists:reverse(Names, ["suite"]),
    Name = case lists:keysearch(name, 1, NameList) of
	       {value,{name,N}} -> N;
	       false -> hd(NameList)
	   end,
    {lists:reverse(SpecList), Name, Param, Trc, Cov, TCCB}.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% cast_to_list(X) -> string()
%% X = list() | atom() | void()
%% Returns a string representation of whatever was input

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("~w", [X])).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% START INTERFACE

%% Kept for backwards compatibility
start(_) ->
    start().
start_link(_) ->
    start_link().


start() ->
    case gen_server:start({local,?MODULE}, ?MODULE, [], []) of
	{ok, Pid} ->
	    {ok, Pid};
	Other ->
	    Other
    end.

start_link() ->
    case gen_server:start_link({local,?MODULE}, ?MODULE, [], []) of
	{ok, Pid} ->
	    {ok, Pid};
	Other ->
	    Other
    end.

run_test(CommandLine) ->
    process_flag(trap_exit,true),
    {SpecList,Name,Param,Trc,Cov,TCCB} = parse_cmd_line(CommandLine),
    {ok,_TSPid} = start_link(Param),
    case Trc of
	false -> ok;
	File -> trc(File)
    end,
    case Cov of
	false -> ok;
	{{App,CoverFile},Analyse} -> cover(App, maybe_file(CoverFile), Analyse)
    end,
    testcase_callback(TCCB),
    add_job(Name, {command_line,SpecList}),

    wait_finish().

%% Converted CoverFile to a string unless it is 'none'
maybe_file(none) ->
    none;
maybe_file(CoverFile) ->
    atom_to_list(CoverFile).

idle_notify(Fun) ->
    {ok, Pid} = controller_call({idle_notify,Fun}),
    Pid.

start_get_totals(Fun) ->
    {ok, Pid} = controller_call({start_get_totals,Fun}),
    Pid.

stop_get_totals() ->
    ok = controller_call(stop_get_totals),
    ok.

wait_finish() ->
    OldTrap = process_flag(trap_exit, true),
    {ok, Pid} = finish(true),
    link(Pid),
    receive
	{'EXIT',Pid,_} ->
	    ok
    end,
    process_flag(trap_exit, OldTrap),
    ok.

abort_current_testcase(Reason) ->
    controller_call({abort_current_testcase,Reason}).

abort() ->
    OldTrap = process_flag(trap_exit, true),
    {ok, Pid} = finish(abort),
    link(Pid),
    receive
	{'EXIT',Pid,_} ->
	    ok
    end,
    process_flag(trap_exit, OldTrap),
    ok.

finish(Abort) ->
    controller_call({finish,Abort}).

stop() ->
    controller_call(stop).

jobs() ->
    controller_call(jobs).

get_levels() ->
    controller_call(get_levels).

set_levels(Show, Major, Minor) ->
    controller_call({set_levels,Show,Major,Minor}).

reject_io_reqs(Bool) ->
    controller_call({reject_io_reqs,Bool}).

multiply_timetraps(N) ->
    controller_call({multiply_timetraps,N}).

scale_timetraps(Bool) ->
    controller_call({scale_timetraps,Bool}).

get_timetrap_parameters() ->
    controller_call(get_timetrap_parameters).

create_priv_dir(Value) ->
    controller_call({create_priv_dir,Value}).

trc(TraceFile) ->
    controller_call({trace,TraceFile}, 2*?ACCEPT_TIMEOUT).

stop_trace() ->
    controller_call(stop_trace).

node_started(Node) ->
    gen_server:cast(?MODULE, {node_started,Node}).

cover(App, Analyse) when is_atom(App) ->
    cover(App, none, Analyse);
cover(CoverFile, Analyse) ->
    cover(none, CoverFile, Analyse).
cover(App, CoverFile, Analyse) ->
    {Excl,Incl,Cross} = read_cover_file(CoverFile),
    CoverInfo = #cover{app=App,
		       file=CoverFile,
		       excl=Excl,
		       incl=Incl,
		       cross=Cross,
		       level=Analyse},
    controller_call({cover,CoverInfo}).

cover(CoverInfo) ->
    controller_call({cover,CoverInfo}).

cover_compile(App,File,Excl,Incl,Cross,Analyse,Stop) ->
    cover_compile(#cover{app=App,
			 file=File,
			 excl=Excl,
			 incl=Incl,
			 cross=Cross,
			 level=Analyse,
			 stop=Stop}).

testcase_callback(ModFunc) ->
    controller_call({testcase_callback,ModFunc}).

set_random_seed(Seed) ->
    controller_call({set_random_seed,Seed}).

kill_slavenodes() ->
    controller_call(kill_slavenodes).

get_hosts() ->
    get(test_server_hosts).

%%--------------------------------------------------------------------

add_job(Name, TopCase) ->
    add_job(Name, TopCase, []).

add_job(Name, TopCase, Skip) ->
    SuiteName =
	case Name of
	    "." -> "current_dir";
	    ".." -> "parent_dir";
	    Other -> Other
	end,
    Dir = filename:absname(SuiteName),
    controller_call({add_job,Dir,SuiteName,TopCase,Skip}).

controller_call(Arg) ->
    case catch gen_server:call(?MODULE, Arg, infinity) of
	{'EXIT',{{badarg,_},{gen_server,call,_}}} ->
	    exit(test_server_ctrl_not_running);
	{'EXIT',Reason} ->
	    exit(Reason);
	Other ->
	    Other
    end.
controller_call(Arg, Timeout) ->
    case catch gen_server:call(?MODULE, Arg, Timeout) of
	{'EXIT',{{badarg,_},{gen_server,call,_}}} ->
	    exit(test_server_ctrl_not_running);
	{'EXIT',Reason} ->
	    exit(Reason);
	Other ->
	    Other
    end.


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

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% init([])
%%
%% init() is the init function of the test_server's gen_server.
%%
init([]) ->
    case os:getenv("TEST_SERVER_CALL_TRACE") of
	false ->
	    ok;
	"" ->
	    ok;
	TraceSpec ->
	    test_server_sup:call_trace(TraceSpec)
    end,
    process_flag(trap_exit, true),
    %% copy format_exception setting from init arg to application environment
    case init:get_argument(test_server_format_exception) of
	{ok,[[TSFE]]} ->
	    application:set_env(test_server, format_exception, list_to_atom(TSFE));
	_ ->
	    ok
    end,
    test_server_sup:cleanup_crash_dumps(),
    test_server_sup:util_start(),
    State = #state{jobs=[],finish=false},
    TI0 = test_server:init_target_info(),
    TargetHost = test_server_sup:hoststr(),
    TI = TI0#target_info{host=TargetHost,
			 naming=naming(),
			 master=TargetHost},
    ets:new(slave_tab, [named_table,set,public,{keypos,2}]),
    set_hosts([TI#target_info.host]),
    {ok,State#state{target_info=TI}}.

naming() ->
    case lists:member($., test_server_sup:hoststr()) of
	true -> "-name";
	false -> "-sname"
    end.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call(kill_slavenodes, From, State) -> ok
%%
%% Kill all slave nodes that remain after a test case
%% is completed.
%%
handle_call(kill_slavenodes, _From, State) ->
    Nodes = test_server_node:kill_nodes(),
    {reply, Nodes, State};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({set_hosts, HostList}, From, State) -> ok
%%
%% Set the global hostlist.
%%
handle_call({set_hosts, Hosts}, _From, State) ->
    set_hosts(Hosts),
    {reply, ok, State};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call(get_hosts, From, State) -> [Hosts]
%%
%% Returns the lists of hosts that the test server
%% can use for slave nodes. This is primarily used
%% for nodename generation.
%%
handle_call(get_hosts, _From, State) ->
    Hosts = get_hosts(),
    {reply, Hosts, State};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({add_job,Dir,Name,TopCase,Skip}, _, State) ->
%%     ok | {error,Reason}
%%
%% Dir = string()
%% Name = string()
%% TopCase = term()
%% Skip = [SkipItem]
%% SkipItem = {Mod,Comment} | {Mod,Case,Comment} | {Mod,Cases,Comment}
%% Mod = Case = atom()
%% Comment = string()
%% Cases = [Case]
%%
%% Adds a job to the job queue. The name of the job is Name. A log directory
%% will be created in Dir/Name.logs. TopCase may be anything that
%% collect_cases/3 accepts, plus the following:
%%
%% {spec,SpecName} executes the named test suite specification file. Commands
%% in the file should be in the format accepted by do_spec_list/1.
%%
%% {command_line,SpecList} executes the list of specification instructions
%% supplied, which should be in the format accepted by do_spec_list/1.

handle_call({add_job,Dir,Name,TopCase,Skip}, _From, State) ->
    LogDir = Dir ++ ?logdir_ext,
    ExtraTools =
	case State#state.cover of
	    false -> [];
	    CoverInfo -> [{cover,CoverInfo}]
	end,
    ExtraTools1 =
	case State#state.random_seed of
	    undefined -> ExtraTools;
	    Seed -> [{random_seed,Seed}|ExtraTools]
	end,
    case lists:keysearch(Name, 1, State#state.jobs) of
	false ->
	    case TopCase of
		{spec,SpecName} ->
		    Pid = spawn_tester(
			    ?MODULE, do_spec,
			    [SpecName,{State#state.multiply_timetraps,
				       State#state.scale_timetraps}],
			    LogDir, Name, State#state.levels,
			    State#state.reject_io_reqs,
			    State#state.create_priv_dir,
			    State#state.testcase_callback, ExtraTools1),
		    NewJobs = [{Name,Pid}|State#state.jobs],
		    {reply, ok, State#state{jobs=NewJobs}};
		{command_line,SpecList} ->
		    Pid = spawn_tester(
			    ?MODULE, do_spec_list,
			    [SpecList,{State#state.multiply_timetraps,
				       State#state.scale_timetraps}],
			    LogDir, Name, State#state.levels,
			    State#state.reject_io_reqs,
			    State#state.create_priv_dir,
			    State#state.testcase_callback, ExtraTools1),
		    NewJobs = [{Name,Pid}|State#state.jobs],
		    {reply, ok, State#state{jobs=NewJobs}};
		TopCase ->
		    case State#state.get_totals of
			{CliPid,Fun} ->
			    Result = count_test_cases(TopCase, Skip),
			    Fun(CliPid, Result),
			    {reply, ok, State};
			_ ->
			    Cfg = make_config([]),
			    Pid = spawn_tester(
				    ?MODULE, do_test_cases,
				    [TopCase,Skip,Cfg,
				     {State#state.multiply_timetraps,
				      State#state.scale_timetraps}],
				    LogDir, Name, State#state.levels,
				    State#state.reject_io_reqs,
				    State#state.create_priv_dir,
				    State#state.testcase_callback, ExtraTools1),
			    NewJobs = [{Name,Pid}|State#state.jobs],
			    {reply, ok, State#state{jobs=NewJobs}}
		    end
	    end;
	_ ->
	    {reply,{error,name_already_in_use},State}
    end;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call(jobs, _, State) -> JobList
%% JobList = [{Name,Pid}, ...]
%% Name = string()
%% Pid = pid()
%%
%% Return the list of current jobs.

handle_call(jobs, _From, State) ->
    {reply,State#state.jobs,State};


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({abort_current_testcase,Reason}, _, State) -> Result
%% Reason = term()
%% Result = ok | {error,no_testcase_running}
%%
%% Attempts to abort the test case that's currently running.

handle_call({abort_current_testcase,Reason}, _From, State) ->
    case State#state.jobs of
	[{_,Pid}|_] ->
	    Pid ! {abort_current_testcase,Reason,self()},
	    receive
		{Pid,abort_current_testcase,Result} ->
		    {reply, Result, State}
	    after 10000 ->
		    {reply, {error,no_testcase_running}, State}
	    end;
	_ ->
	    {reply, {error,no_testcase_running}, State}
    end;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({finish,Fini}, _, State) -> {ok,Pid}
%% Fini = true | abort
%%
%% Tells the test_server to stop as soon as there are no test suites
%% running. Immediately if none are running. Abort is handled as soon
%% as current test finishes.

handle_call({finish,Fini}, _From, State) ->
    case State#state.jobs of
	[] ->
	    lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Fini) end,
			  State#state.idle_notify),
	    State2 = State#state{finish=false},
	    {stop,shutdown,{ok,self()}, State2};
	_SomeJobs ->
	    State2 = State#state{finish=Fini},
	    {reply, {ok,self()}, State2}
    end;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({idle_notify,Fun}, From, State) -> {ok,Pid}
%%
%% Lets a test client subscribe to receive a notification when the
%% test server becomes idle (can be used to syncronize jobs).
%% test_server calls Fun(From) when idle.

handle_call({idle_notify,Fun}, {Cli,_Ref}, State) ->
    case State#state.jobs of
	[] -> self() ! report_idle;
	_  -> ok
    end,
    Subscribed = State#state.idle_notify,
    {reply, {ok,self()}, State#state{idle_notify=[{Cli,Fun}|Subscribed]}};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call(start_get_totals, From, State) -> {ok,Pid}
%%
%% Switch on the mode where the test server will only
%% report back the number of tests it would execute
%% given some subsequent jobs.

handle_call({start_get_totals,Fun}, {Cli,_Ref}, State) ->
    {reply, {ok,self()}, State#state{get_totals={Cli,Fun}}};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call(stop_get_totals, From, State) -> ok
%%
%% Lets a test client subscribe to receive a notification when the
%% test server becomes idle (can be used to syncronize jobs).
%% test_server calls Fun(From) when idle.

handle_call(stop_get_totals, {_Cli,_Ref}, State) ->
    {reply, ok, State#state{get_totals=false}};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call(get_levels, _, State) -> {Show,Major,Minor}
%% Show = integer()
%% Major = integer()
%% Minor = integer()
%%
%% Returns a 3-tuple with the logging thresholds.
%% All output and information from a test suite is tagged with a detail
%% level. Lower values are more "important". Text that is output using
%% io:format or similar is automatically tagged with detail level 50.
%%
%% All output with detail level:
%% less or equal to Show is displayed on the screen (default 1)
%% less or equal to Major is logged in the major log file (default 19)
%% greater or equal to Minor is logged in the minor log files (default 10)

handle_call(get_levels, _From, State) ->
    {reply,State#state.levels,State};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({set_levels,Show,Major,Minor}, _, State) -> ok
%% Show = integer()
%% Major = integer()
%% Minor = integer()
%%
%% Sets the logging thresholds, see handle_call(get_levels,...) above.

handle_call({set_levels,Show,Major,Minor}, _From, State) ->
    {reply,ok,State#state{levels={Show,Major,Minor}}};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({reject_io_reqs,Bool}, _, State) -> ok
%% Bool = bool()
%%
%% May be used to switch off stdout printouts to the minor log file

handle_call({reject_io_reqs,Bool}, _From, State) ->
    {reply,ok,State#state{reject_io_reqs=Bool}};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({multiply_timetraps,N}, _, State) -> ok
%% N = integer() | infinity
%%
%% Multiplies all timetraps set by test cases with N

handle_call({multiply_timetraps,N}, _From, State) ->
    {reply,ok,State#state{multiply_timetraps=N}};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({scale_timetraps,Bool}, _, State) -> ok
%% Bool = true | false
%%
%% Specifies if test_server should scale the timetrap value
%% automatically if e.g. cover is running.

handle_call({scale_timetraps,Bool}, _From, State) ->
    {reply,ok,State#state{scale_timetraps=Bool}};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call(get_timetrap_parameters, _, State) -> {Multiplier,Scale}
%% Multiplier = integer() | infinity
%% Scale = true | false
%%
%% Returns the parameter values that affect timetraps.

handle_call(get_timetrap_parameters, _From, State) ->
    {reply,{State#state.multiply_timetraps,State#state.scale_timetraps},State};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({trace,TraceFile}, _, State) -> ok | {error,Reason}
%%
%% Starts a separate node (trace control node) which
%% starts tracing on target and all slave nodes
%%
%% TraceFile is a text file with elements of type
%% {Trace,Mod,TracePattern}.
%% {Trace,Mod,Func,TracePattern}.
%% {Trace,Mod,Func,Arity,TracePattern}.
%%
%% Trace = tp | tpl;  local or global call trace
%% Mod,Func = atom(), Arity=integer(); defines what to trace
%% TracePattern = [] | match_spec()
%%
%% The 'call' trace flag is set on all processes, and then
%% the given trace patterns are set.

handle_call({trace,TraceFile}, _From, State=#state{trc=false}) ->
    TI = State#state.target_info,
    case test_server_node:start_tracer_node(TraceFile, TI) of
	{ok,Tracer} -> {reply,ok,State#state{trc=Tracer}};
	Error -> {reply,Error,State}
    end;
handle_call({trace,_TraceFile}, _From, State) ->
    {reply,{error,already_tracing},State};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call(stop_trace, _, State) -> ok | {error,Reason}
%%
%% Stops tracing on target and all slave nodes and
%% terminates trace control node

handle_call(stop_trace, _From, State=#state{trc=false}) ->
    {reply,{error,not_tracing},State};
handle_call(stop_trace, _From, State) ->
    R = test_server_node:stop_tracer_node(State#state.trc),
    {reply,R,State#state{trc=false}};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({cover,CoverInfo}, _, State) -> ok | {error,Reason}
%%
%% Set specification of cover analysis to be used when running tests
%% (see start_extra_tools/1 and stop_extra_tools/1)

handle_call({cover,CoverInfo}, _From, State) ->
    {reply,ok,State#state{cover=CoverInfo}};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({create_priv_dir,Value}, _, State) -> ok | {error,Reason}
%%
%% Set create_priv_dir to either auto_per_run (create common priv dir once
%% per test run), manual_per_tc (the priv dir name will be unique for each
%% test case, but the user has to call test_server:make_priv_dir/0 to create
%% it), or auto_per_tc (unique priv dir created automatically for each test
%% case).

handle_call({create_priv_dir,Value}, _From, State) ->
    {reply,ok,State#state{create_priv_dir=Value}};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({testcase_callback,{Mod,Func}}, _, State) -> ok | {error,Reason}
%%
%% Add a callback function that will be called before and after every
%% test case (on the test case process):
%%
%% Mod:Func(Suite,TestCase,InitOrEnd,Config)
%%
%% InitOrEnd = init | 'end'.

handle_call({testcase_callback,ModFunc}, _From, State) ->
    case ModFunc of
	{Mod,Func} ->
	    case code:is_loaded(Mod) of
		{file,_} ->
		    ok;
		false ->
		    code:load_file(Mod)
	    end,
	    case erlang:function_exported(Mod,Func,4) of
		true ->
		    ok;
		false ->
		    io:format(user,
			      "WARNING! Callback function ~w:~w/4 undefined.~n~n",
			      [Mod,Func])
	    end;
	_ ->
	    ok
    end,
    {reply,ok,State#state{testcase_callback=ModFunc}};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({set_random_seed,Seed}, _, State) -> ok | {error,Reason}
%%
%% Let operator set a random seed value to be used e.g. for shuffling
%% test cases.

handle_call({set_random_seed,Seed}, _From, State) ->
    {reply,ok,State#state{random_seed=Seed}};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call(stop, _, State) -> ok
%%
%% Stops the test server immediately.
%% Some cleanup is done by terminate/2

handle_call(stop, _From, State) ->
    {stop, shutdown, ok, State};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call(get_target_info, _, State) -> TI
%%
%% TI = #target_info{}
%%
%% Returns information about target

handle_call(get_target_info, _From, State) ->
    {reply, State#state.target_info, State};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({start_node,Name,Type,Options}, _, State) ->
%%     ok | {error,Reason}
%%
%% Starts a new node (slave or peer)

handle_call({start_node, Name, Type, Options}, From, State) ->
    %% test_server_ctrl does gen_server:reply/2 explicitly
    test_server_node:start_node(Name, Type, Options, From,
				State#state.target_info),
    {noreply,State};


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({wait_for_node,Node}, _, State) -> ok
%%
%% Waits for a new node to take contact. Used if
%% node is started with option {wait,false}

handle_call({wait_for_node, Node}, From, State) ->
    NewWaitList =
	case ets:lookup(slave_tab,Node) of
	    [] ->
		[{Node,From}|State#state.wait_for_node];
	    _ ->
		gen_server:reply(From,ok),
		State#state.wait_for_node
	end,
    {noreply,State#state{wait_for_node=NewWaitList}};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({stop_node,Name}, _, State) -> ok | {error,Reason}
%%
%% Stops a slave or peer node. This is actually only some cleanup
%% - the node is really stopped by test_server when this returns.

handle_call({stop_node, Name}, _From, State) ->
    R = test_server_node:stop_node(Name),
    {reply, R, State};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({is_release_available,Name}, _, State) -> ok | {error,Reason}
%%
%% Tests if the release is available.

handle_call({is_release_available, Release}, _From, State) ->
    R = test_server_node:is_release_available(Release),
    {reply, R, State}.

%%--------------------------------------------------------------------
set_hosts(Hosts) ->
    put(test_server_hosts, Hosts).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_cast({node_started,Name}, _, State)
%%
%% Called by test_server_node when a slave/peer node is fully started.

handle_cast({node_started,Node}, State) ->
    case State#state.trc of
	false -> ok;
	Trc -> test_server_node:trace_nodes(Trc, [Node])
    end,
    NewWaitList =
	case lists:keysearch(Node,1,State#state.wait_for_node) of
	    {value,{Node,From}} ->
		gen_server:reply(From, ok),
		lists:keydelete(Node, 1, State#state.wait_for_node);
	    false ->
		State#state.wait_for_node
	end,
    {noreply, State#state{wait_for_node=NewWaitList}}.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_info({'EXIT',Pid,Reason}, State)
%% Pid = pid()
%% Reason = term()
%%
%% Handles exit messages from linked processes. Only test suites are
%% expected to be linked.  When a test suite terminates, it is removed
%% from the job queue.

handle_info(report_idle, State) ->
    Finish = State#state.finish,
    lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end,
		  State#state.idle_notify),
    {noreply,State#state{idle_notify=[]}};


handle_info({'EXIT',Pid,Reason}, State) ->
    case lists:keysearch(Pid,2,State#state.jobs) of
	false ->
	    %% not our problem
	    {noreply,State};
	{value,{Name,_}} ->
	    NewJobs = lists:keydelete(Pid, 2, State#state.jobs),
	    case Reason of
		normal ->
		    fine;
		killed ->
		    io:format("Suite ~ts was killed\n", [Name]);
		_Other ->
		    io:format("Suite ~ts was killed with reason ~p\n",
			      [Name,Reason])
	    end,
	    State2 = State#state{jobs=NewJobs},
	    Finish = State2#state.finish,
	    case NewJobs of
		[] ->
		    lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end,
				  State2#state.idle_notify),
		    case Finish of
			false ->
			    {noreply,State2#state{idle_notify=[]}};
			_ ->			% true | abort
			    %% test_server:finish() has been called and
			    %% there are no jobs in the job queue =>
			    %% stop the test_server_ctrl
			    {stop,shutdown,State2#state{finish=false}}
		    end;
		_ ->				% pending jobs
		    case Finish of
			abort ->		% abort test now!
			    lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end,
					  State2#state.idle_notify),
			    {stop,shutdown,State2#state{finish=false}};
			_ ->			% true | false
			    {noreply, State2}
		    end
	    end
    end;


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_info({tcp_closed,Sock}, State)
%%
%% A Socket was closed. This indicates that a node died.
%% This can be
%% *Slave or peer node started by a test suite
%% *Trace controll node

handle_info({tcp_closed,Sock}, State=#state{trc=Sock}) ->
    %% Tracer node died - can't really do anything
    %%! Maybe print something???
    {noreply,State#state{trc=false}};
handle_info({tcp_closed,Sock}, State) ->
    test_server_node:nodedown(Sock),
    {noreply,State};
handle_info(_, State) ->
    %% dummy; accept all, do nothing.
    {noreply, State}.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% terminate(Reason, State) -> ok
%% Reason = term()
%%
%% Cleans up when the test_server is terminating. Kills the running
%% test suites (if any) and any possible remainting slave node

terminate(_Reason, State) ->
    test_server_sup:util_stop(),
    case State#state.trc of
	false -> ok;
	Sock -> test_server_node:stop_tracer_node(Sock)
    end,
    kill_all_jobs(State#state.jobs),
    test_server_node:kill_nodes(),
    ok.

kill_all_jobs([{_Name,JobPid}|Jobs]) ->
    exit(JobPid, kill),
    kill_all_jobs(Jobs);
kill_all_jobs([]) ->
    ok.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%----------------------- INTERNAL FUNCTIONS -----------------------%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% spawn_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs,
%%              CreatePrivDir, TestCaseCallback, ExtraTools) -> Pid
%% Mod = atom()
%% Func = atom()
%% Args = [term(),...]
%% Dir = string()
%% Name = string()
%% Levels = {integer(),integer(),integer()}
%% RejectIoReqs = bool()
%% CreatePrivDir = auto_per_run | manual_per_tc | auto_per_tc
%% TestCaseCallback = {CBMod,CBFunc} | undefined
%% ExtraTools = [ExtraTool,...]
%% ExtraTool = CoverInfo | TraceInfo | RandomSeed
%%
%% Spawns a test suite execute-process, just an ordinary spawn, except
%% that it will set a lot of dictionary information before starting the
%% named function. Also, the execution is timed and protected by a catch.
%% When the named function is done executing, a summary of the results
%% is printed to the log files.

spawn_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs,
	     CreatePrivDir, TCCallback, ExtraTools) ->
    spawn_link(fun() ->
	      init_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs,
			   CreatePrivDir, TCCallback, ExtraTools)
      end).

init_tester(Mod, Func, Args, Dir, Name, {_,_,MinLev}=Levels,
	    RejectIoReqs, CreatePrivDir, TCCallback, ExtraTools) ->
    process_flag(trap_exit, true),
    test_server_io:start_link(),
    put(test_server_name, Name),
    put(test_server_dir, Dir),
    put(test_server_total_time, 0),
    put(test_server_ok, 0),
    put(test_server_failed, 0),
    put(test_server_skipped, {0,0}),
    put(test_server_minor_level, MinLev),
    put(test_server_create_priv_dir, CreatePrivDir),
    put(test_server_random_seed, proplists:get_value(random_seed, ExtraTools)),
    put(test_server_testcase_callback, TCCallback),
    case os:getenv("TEST_SERVER_FRAMEWORK") of
	FW when FW =:= false; FW =:= "undefined" ->
	    put(test_server_framework, '$none');	
	FW ->
	    put(test_server_framework_name, list_to_atom(FW)),
	    case os:getenv("TEST_SERVER_FRAMEWORK_NAME") of
		FWName when FWName =:= false; FWName =:= "undefined" ->
		    put(test_server_framework_name, '$none');	
		FWName ->
		    put(test_server_framework_name, list_to_atom(FWName))
	    end
    end,

    %% before first print, read and set logging options
    LogOpts = test_server_sup:framework_call(get_logopts, [], []),
    put(test_server_logopts, LogOpts),

    StartedExtraTools = start_extra_tools(ExtraTools),

    test_server_io:set_job_name(Name),
    test_server_io:set_gl_props([{levels,Levels},
				 {auto_nl,not lists:member(no_nl, LogOpts)},
				 {reject_io_reqs,RejectIoReqs}]),
    group_leader(test_server_io:get_gl(true), self()),
    {TimeMy,Result} = ts_tc(Mod, Func, Args),
    set_io_buffering(undefined),
    test_server_io:set_job_name(undefined),
    catch stop_extra_tools(StartedExtraTools),
    case Result of
	{'EXIT',test_suites_done} ->
	    ok;
	{'EXIT',_Pid,Reason} ->
	    print(1, "EXIT, reason ~p", [Reason]);
	{'EXIT',Reason} ->
	    report_severe_error(Reason),
	    print(1, "EXIT, reason ~p", [Reason])
    end,
    Time = TimeMy/1000000,
    SuccessStr =
	case get(test_server_failed) of
	    0 -> "Ok";
	    _ -> "FAILED"
	end,
    {SkippedN,SkipStr} =
	case get(test_server_skipped) of
	    {0,0} -> 
		{0,""};
	    {USkipped,ASkipped} ->
		Skipped = USkipped+ASkipped,
		{Skipped,io_lib:format(", ~w Skipped", [Skipped])}
	end,
    OkN = get(test_server_ok),
    FailedN = get(test_server_failed),
    print(html,"\n</tbody>\n<tfoot>\n"
	  "<tr><td></td><td><b>TOTAL</b></td><td></td><td></td><td></td>"
	  "<td>~.3fs</td><td><b>~ts</b></td><td>~w Ok, ~w Failed~ts of ~w</td></tr>\n"
	  "</tfoot>\n",
	  [Time,SuccessStr,OkN,FailedN,SkipStr,OkN+FailedN+SkippedN]),

    test_server_io:stop([major,html,unexpected_io]),
    {UnexpectedIoName,UnexpectedIoFooter} = get(test_server_unexpected_footer),
    {ok,UnexpectedIoFd} = open_html_file(UnexpectedIoName, [append]),
    io:put_chars(UnexpectedIoFd, "\n</pre>\n"++UnexpectedIoFooter),
    file:close(UnexpectedIoFd),
    ok.

report_severe_error(Reason) ->
    test_server_sup:framework_call(report, [severe_error,Reason]).

ts_tc(M,F,A) ->
    Before = erlang:monotonic_time(),
    Result = (catch apply(M, F, A)),
    After   = erlang:monotonic_time(),
    Elapsed = erlang:convert_time_unit(After-Before,
				       native,
				       micro_seconds),
    {Elapsed, Result}.

start_extra_tools(ExtraTools) ->
    start_extra_tools(ExtraTools, []).
start_extra_tools([{cover,CoverInfo} | ExtraTools], Started) ->
    case start_cover(CoverInfo) of
	{ok,NewCoverInfo} ->
	    start_extra_tools(ExtraTools,[{cover,NewCoverInfo}|Started]);
	{error,_} ->
	    start_extra_tools(ExtraTools, Started)
    end;
start_extra_tools([_ | ExtraTools], Started) ->
    start_extra_tools(ExtraTools, Started);
start_extra_tools([], Started) ->
    Started.

stop_extra_tools(ExtraTools) ->
    TestDir = get(test_server_log_dir_base),
    case lists:keymember(cover, 1, ExtraTools) of
	false ->
	    write_default_coverlog(TestDir);
	true ->
	    ok
    end,
    stop_extra_tools(ExtraTools, TestDir).

stop_extra_tools([{cover,CoverInfo}|ExtraTools], TestDir) ->
    stop_cover(CoverInfo,TestDir),
    stop_extra_tools(ExtraTools, TestDir);
%%stop_extra_tools([_ | ExtraTools], TestDir) ->
%%    stop_extra_tools(ExtraTools, TestDir);
stop_extra_tools([], _) ->
    ok.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% do_spec(SpecName, TimetrapSpec) -> {error,Reason} | exit(Result)
%% SpecName = string()
%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap}
%% MultiplyTimetrap = integer() | infinity
%% ScaleTimetrap = bool()
%%
%% Reads the named test suite specification file, and executes it.
%%
%% This function is meant to be called by a process created by
%% spawn_tester/10, which sets up some necessary dictionary values.

do_spec(SpecName, TimetrapSpec) when is_list(SpecName) ->
    case file:consult(SpecName) of
	{ok,TermList} ->
	    do_spec_list(TermList,TimetrapSpec);
	{error,Reason} ->
	    io:format("Can't open ~ts: ~p\n", [SpecName,Reason]),
	    {error,{cant_open_spec,Reason}}
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% do_spec_list(TermList, TimetrapSpec) -> exit(Result)
%% TermList = [term()|...]
%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap}
%% MultiplyTimetrap = integer() | infinity
%% ScaleTimetrap = bool()
%%
%% Executes a list of test suite specification commands. The following
%% commands are available, and may occur zero or more times (if several,
%% the contents is appended):
%%
%% {topcase,TopCase} Specifies top level test goals. TopCase has the syntax
%% specified by collect_cases/3.
%%
%% {skip,Skip} Specifies test cases to skip, and lists requirements that
%% cannot be granted during the test run. Skip has the syntax specified
%% by collect_cases/3.
%%
%% {nodes,Nodes} Lists node names avaliable to the test suites. Nodes have
%% the syntax specified by collect_cases/3.
%%
%% {require_nodenames, Num} Specifies how many nodenames the test suite will
%% need. Theese are automaticly generated and inserted into the Config by the
%% test_server. The caller may specify other hosts to run theese nodes by
%% using the {hosts, Hosts} option. If there are no hosts specified, all
%% nodenames will be generated from the local host.
%%
%% {hosts, Hosts} Specifies a list of available hosts on which to start
%% slave nodes. It is used when the {remote, true} option is given to the
%% test_server:start_node/3 function. Also, if {require_nodenames, Num} is
%% contained in the TermList, the generated nodenames will be spread over
%% all hosts given in this Hosts list. The hostnames are given as atoms or
%% strings.
%%
%% {diskless, true}</c></tag> is kept for backwards compatiblilty and
%% should not be used. Use a configuration test case instead.
%%
%% This function is meant to be called by a process created by
%% spawn_tester/10, which sets up some necessary dictionary values.

do_spec_list(TermList0, TimetrapSpec) ->
    Nodes = [],
    TermList =
	case lists:keysearch(hosts, 1, TermList0) of
	    {value, {hosts, Hosts0}} ->
		Hosts = lists:map(fun(H) -> cast_to_list(H) end, Hosts0),
		controller_call({set_hosts, Hosts}),
		lists:keydelete(hosts, 1, TermList0);
	    _ ->
		TermList0
	end,
    DefaultConfig = make_config([{nodes,Nodes}]),
    {TopCases,SkipList,Config} = do_spec_terms(TermList, [], [], DefaultConfig),
    do_test_cases(TopCases, SkipList, Config, TimetrapSpec).

do_spec_terms([], TopCases, SkipList, Config) ->
    {TopCases,SkipList,Config};
do_spec_terms([{topcase,TopCase}|Terms], TopCases, SkipList, Config) ->
    do_spec_terms(Terms,[TopCase|TopCases], SkipList, Config);
do_spec_terms([{skip,Skip}|Terms], TopCases, SkipList, Config) ->
    do_spec_terms(Terms, TopCases, [Skip|SkipList], Config);
do_spec_terms([{nodes,Nodes}|Terms], TopCases, SkipList, Config) ->
    do_spec_terms(Terms, TopCases, SkipList,
		  update_config(Config, {nodes,Nodes}));
do_spec_terms([{diskless,How}|Terms], TopCases, SkipList, Config) ->
    do_spec_terms(Terms, TopCases, SkipList,
		  update_config(Config, {diskless,How}));
do_spec_terms([{config,MoreConfig}|Terms], TopCases, SkipList, Config) ->
    do_spec_terms(Terms, TopCases, SkipList, Config++MoreConfig);
do_spec_terms([{default_timeout,Tmo}|Terms], TopCases, SkipList, Config) ->
    do_spec_terms(Terms, TopCases, SkipList,
		  update_config(Config, {default_timeout,Tmo}));

do_spec_terms([{require_nodenames,NumNames}|Terms], TopCases, SkipList, Config) ->
    NodeNames0=generate_nodenames(NumNames),
    NodeNames=lists:delete([], NodeNames0),
    do_spec_terms(Terms, TopCases, SkipList,
		  update_config(Config, {nodenames,NodeNames}));
do_spec_terms([Other|Terms], TopCases, SkipList, Config) ->
    io:format("** WARNING: Spec file contains unknown directive ~p\n",
	      [Other]),
    do_spec_terms(Terms, TopCases, SkipList, Config).



generate_nodenames(Num) ->
    Hosts = case controller_call(get_hosts) of
		[] ->
		    TI = controller_call(get_target_info),
		    [TI#target_info.host];
		List ->
		    List
	    end,
    generate_nodenames2(Num, Hosts, []).

generate_nodenames2(0, _Hosts, Acc) ->
    Acc;
generate_nodenames2(N, Hosts, Acc) ->
    Host=lists:nth((N rem (length(Hosts)))+1, Hosts),
    Name=list_to_atom(temp_nodename("nod", []) ++ "@" ++ Host),
    generate_nodenames2(N-1, Hosts, [Name|Acc]).

temp_nodename([], Acc) ->
    lists:flatten(Acc);
temp_nodename([Chr|Base], Acc) ->
    {A,B,C} = ?now,
    New = [Chr | integer_to_list(Chr bxor A bxor B+A bxor C+B)],
    temp_nodename(Base, [New|Acc]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% count_test_cases(TopCases, SkipCases) -> {Suites,NoOfCases} | error
%% TopCases = term()      (See collect_cases/3)
%% SkipCases = term()     (See collect_cases/3)
%% Suites = list()
%% NoOfCases = integer() | unknown
%%
%% Counts the test cases that are about to run and returns that number.
%% If there's a conf group in TestSpec with a repeat property, the total number
%% of cases can not be calculated and NoOfCases = unknown.
count_test_cases(TopCases, SkipCases) when is_list(TopCases) ->
    case collect_all_cases(TopCases, SkipCases) of
	{error,_Why} = Error ->
	    Error;
	TestSpec ->
	    {get_suites(TestSpec, []),
	     case remove_conf(TestSpec) of
		 {repeats,_} ->
		     unknown;
		 TestSpec1 ->
		     length(TestSpec1)
	     end}
    end;

count_test_cases(TopCase, SkipCases) ->
    count_test_cases([TopCase], SkipCases).


remove_conf(Cases) ->
    remove_conf(Cases, [], false).

remove_conf([{conf, _Ref, Props, _MF}|Cases], NoConf, Repeats) ->
    case get_repeat(Props) of
	undefined ->
	    remove_conf(Cases, NoConf, Repeats);
	{_RepType,1} ->
	    remove_conf(Cases, NoConf, Repeats);
	_ ->
	    remove_conf(Cases, NoConf, true)
    end;
remove_conf([{make,_Ref,_MF}|Cases], NoConf, Repeats) ->
    remove_conf(Cases, NoConf, Repeats);
remove_conf([{skip_case,{{_M,all},_Cmt},_Mode}|Cases], NoConf, Repeats) ->
    remove_conf(Cases, NoConf, Repeats);
remove_conf([{skip_case,{Type,_Ref,_MF,_Cmt}}|Cases],
	    NoConf, Repeats) when Type==conf;
				   Type==make ->
    remove_conf(Cases, NoConf, Repeats);
remove_conf([{skip_case,{Type,_Ref,_MF,_Cmt},_Mode}|Cases],
	    NoConf, Repeats) when Type==conf;
				  Type==make ->
    remove_conf(Cases, NoConf, Repeats);
remove_conf([C={Mod,error_in_suite,_}|Cases], NoConf, Repeats) ->
    FwMod = get_fw_mod(?MODULE),
    if Mod == FwMod ->
	    remove_conf(Cases, NoConf, Repeats);
       true ->
	    remove_conf(Cases, [C|NoConf], Repeats)
    end;
remove_conf([C|Cases], NoConf, Repeats) ->
    remove_conf(Cases, [C|NoConf], Repeats);
remove_conf([], NoConf, true) ->
    {repeats,lists:reverse(NoConf)};
remove_conf([], NoConf, false) ->
    lists:reverse(NoConf).

get_suites([{skip_case,{{Mod,_F},_Cmt},_Mode}|Tests], Mods) when is_atom(Mod) ->
    case add_mod(Mod, Mods) of
	true ->  get_suites(Tests, [Mod|Mods]);
	false -> get_suites(Tests, Mods)
    end;
get_suites([{Mod,_Case}|Tests], Mods) when is_atom(Mod) ->
    case add_mod(Mod, Mods) of
	true ->  get_suites(Tests, [Mod|Mods]);
	false -> get_suites(Tests, Mods)
    end;
get_suites([{Mod,_Func,_Args}|Tests], Mods) when is_atom(Mod) ->
    case add_mod(Mod, Mods) of
	true ->  get_suites(Tests, [Mod|Mods]);
	false -> get_suites(Tests, Mods)
    end;
get_suites([_|Tests], Mods) ->
    get_suites(Tests, Mods);

get_suites([], Mods) ->
    lists:reverse(Mods).

add_mod(Mod, Mods) ->
    case string:rstr(atom_to_list(Mod), "_SUITE") of
	0 -> false;
	_ ->					% test suite
	     case lists:member(Mod, Mods) of
		 true ->  false;
		 false -> true
	     end
    end.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% do_test_cases(TopCases, SkipCases, Config, TimetrapSpec) ->
%%    exit(Result)
%%
%% TopCases = term()      (See collect_cases/3)
%% SkipCases = term()     (See collect_cases/3)
%% Config = term()        (See collect_cases/3)
%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap}
%% MultiplyTimetrap = integer() | infinity
%% ScaleTimetrap = bool()
%%
%% Initializes and starts the test run, for "ordinary" test suites.
%% Creates log directories and log files, inserts initial timestamps and
%% configuration information into the log files.
%%
%% This function is meant to be called by a process created by
%% spawn_tester/10, which sets up some necessary dictionary values.
do_test_cases(TopCases, SkipCases,
	      Config, MultiplyTimetrap) when is_integer(MultiplyTimetrap);
					     MultiplyTimetrap == infinity ->
    do_test_cases(TopCases, SkipCases, Config, {MultiplyTimetrap,true});

do_test_cases(TopCases, SkipCases,
	      Config, TimetrapData) when is_list(TopCases),
					 is_tuple(TimetrapData) ->
    {ok,TestDir} = start_log_file(),
    FwMod = get_fw_mod(?MODULE),
    case collect_all_cases(TopCases, SkipCases) of
	{error,Why} ->
	    print(1, "Error starting: ~p", [Why]),
	    exit(test_suites_done);
	TestSpec0 ->
	    N = case remove_conf(TestSpec0) of
		    {repeats,_} -> unknown;
		    TS -> length(TS)
		end,
	    put(test_server_cases, N),
	    put(test_server_case_num, 0),

	    TestSpec =
		add_init_and_end_per_suite(TestSpec0, undefined, undefined, FwMod),

	    TI = get_target_info(),
	    print(1, "Starting test~ts",
		  [print_if_known(N, {", ~w test cases",[N]},
				  {" (with repeated test cases)",[]})]),
	    Test = get(test_server_name),
	    TestName = 	if is_list(Test) -> 
				lists:flatten(io_lib:format("~ts", [Test]));
			   true ->
				lists:flatten(io_lib:format("~tp", [Test]))
			end,			  
	    TestDescr = "Test " ++ TestName ++ " results",

	    test_server_sup:framework_call(report, [tests_start,{Test,N}]),

	    {Header,Footer} =
		case test_server_sup:framework_call(get_html_wrapper,
						    [TestDescr,true,TestDir,
						    {[],[2,3,4,7,8],[1,6]}], "") of
		    Empty when (Empty == "") ; (element(2,Empty) == "")  ->
			put(basic_html, true),
			{[html_header(TestDescr),
			  "<h2>Results for test ", TestName, "</h2>\n"],
			 "\n</body>\n</html>\n"};
		    {basic_html,Html0,Html1} ->
			put(basic_html, true),
			{Html0++["<h1>Results for <i>",TestName,"</i></h1>\n"],
			 Html1};
		    {xhtml,Html0,Html1} ->
			put(basic_html, false),
			{Html0++["<h1>Results for <i>",TestName,"</i></h1>\n"],
			 Html1}
		end,

	    print(html, Header),

	    print(html, xhtml("<p>", "<h4>")),
	    print_timestamp(html, "Test started at "),
	    print(html, xhtml("</p>", "</h4>")),
	    
	    print(html, xhtml("\n<p><b>Host info:</b><br>\n",
			      "\n<p><b>Host info:</b><br />\n")),
	    print_who(test_server_sup:hoststr(), test_server_sup:get_username()),
	    print(html, xhtml("<br>Used Erlang v~ts in <tt>~ts</tt></p>\n",
			      "<br />Used Erlang v~ts in \"~ts\"</p>\n"),
		  [erlang:system_info(version), code:root_dir()]),
	    
	    if FwMod == ?MODULE ->
		    print(html, xhtml("\n<p><b>Target Info:</b><br>\n",
				      "\n<p><b>Target Info:</b><br />\n")),
		    print_who(TI#target_info.host, TI#target_info.username),
		    print(html,xhtml("<br>Used Erlang v~ts in <tt>~ts</tt></p>\n",
				     "<br />Used Erlang v~ts in \"~ts\"</p>\n"),
			  [TI#target_info.version, TI#target_info.root_dir]);
	       true ->
		    case test_server_sup:framework_call(target_info, []) of
			TargetInfo when is_list(TargetInfo),
			                length(TargetInfo) > 0 ->
			    print(html, xhtml("\n<p><b>Target info:</b><br>\n",
					      "\n<p><b>Target info:</b><br />\n")),
			    print(html, "~ts</p>\n", [TargetInfo]);
			_ ->
			    ok
		    end
	    end,
	    CoverLog =
		case get(test_server_cover_log_dir) of
		    undefined ->
			?coverlog_name;
		    AbsLogDir ->
			AbsLog = filename:join(AbsLogDir,?coverlog_name),
			make_relative(AbsLog, TestDir)
		end,
	    print(html,
		  "<p><ul>\n"
		  "<li><a href=\"~ts\">Full textual log</a></li>\n"
		  "<li><a href=\"~ts\">Coverage log</a></li>\n"
		  "<li><a href=\"~ts\">Unexpected I/O log</a></li>\n</ul></p>\n",
		  [?suitelog_name,CoverLog,?unexpected_io_log]),
	    print(html,
		  "<p>~ts</p>\n" ++
		  xhtml(["<table bgcolor=\"white\" border=\"3\" cellpadding=\"5\">\n",
			 "<thead>\n"],
			["<table id=\"",?sortable_table_name,"\">\n",
			 "<thead>\n"]) ++
		      "<tr><th>Num</th><th>Module</th><th>Group</th>" ++
		      "<th>Case</th><th>Log</th><th>Time</th><th>Result</th>" ++
		      "<th>Comment</th></tr>\n</thead>\n<tbody>\n",
		  [print_if_known(N, {"<i>Executing <b>~w</b> test cases...</i>"
				      ++ xhtml("\n<br>\n", "\n<br />\n"),[N]},
				  {"",[]})]),

	    print(major, "=cases         ~w", [get(test_server_cases)]),
	    print(major, "=user          ~ts", [TI#target_info.username]),
	    print(major, "=host          ~ts", [TI#target_info.host]),

	    %% If there are no hosts specified,use only the local host
	    case controller_call(get_hosts) of
		[] ->
		    print(major, "=hosts         ~ts", [TI#target_info.host]),
		    controller_call({set_hosts, [TI#target_info.host]});
		Hosts ->
		    Str = lists:flatten(lists:map(fun(X) -> [X," "] end, Hosts)),
		    print(major, "=hosts         ~ts", [Str])
	    end,
	    print(major, "=emulator_vsn  ~ts", [TI#target_info.version]),
	    print(major, "=emulator      ~ts", [TI#target_info.emulator]),
	    print(major, "=otp_release   ~ts", [TI#target_info.otp_release]),
	    print(major, "=started       ~s",
		   [lists:flatten(timestamp_get(""))]),

	    test_server_io:set_footer(Footer),

	    run_test_cases(TestSpec, Config, TimetrapData)
    end;

do_test_cases(TopCase, SkipCases, Config, TimetrapSpec) ->
    %% when not list(TopCase)
    do_test_cases([TopCase], SkipCases, Config, TimetrapSpec).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% start_log_file() -> {ok,TestDirName} | exit({Error,Reason})
%% Stem = string()
%%
%% Creates the log directories, the major log file and the html log file.
%% The log files are initialized with some header information.
%%
%% The name of the log directory will be <Name>.logs/run.<Date>/ where
%% Name is the test suite name and Date is the current date and time.

start_log_file() ->
    Dir  = get(test_server_dir),
    case file:make_dir(Dir) of
	ok ->
	    ok;
	{error, eexist} ->
	    ok;
	MkDirError ->
	    log_file_error(MkDirError, Dir)
    end,
    TestDir = timestamp_filename_get(filename:join(Dir, "run.")),
    TestDir1 =
	case file:make_dir(TestDir) of
	    ok ->
		TestDir;
	    {error,eexist} ->
		timer:sleep(1000),
		%% we need min 1 second between timestamps unfortunately
		TestDirX = timestamp_filename_get(filename:join(Dir, "run.")),
		case file:make_dir(TestDirX) of
		    ok ->
			TestDirX;
		    MkDirError2 ->
			log_file_error(MkDirError2, TestDirX)
		end;
	    MkDirError2 ->
		log_file_error(MkDirError2, TestDir)
	end,
    FilenameMode = file:native_name_encoding(),
    ok = write_file(filename:join(Dir, ?last_file),
		    TestDir1 ++ "\n",
		    FilenameMode),
    ok = write_file(?last_file, TestDir1 ++ "\n", FilenameMode),
    put(test_server_log_dir_base,TestDir1),

    MajorName = filename:join(TestDir1, ?suitelog_name),
    HtmlName = MajorName ++ ?html_ext,
    UnexpectedName = filename:join(TestDir1, ?unexpected_io_log),

    {ok,Major} = open_utf8_file(MajorName),
    {ok,Html}  = open_html_file(HtmlName),

    {UnexpHeader,UnexpFooter} =
	case test_server_sup:framework_call(get_html_wrapper,
					    ["Unexpected I/O log",false,
					     TestDir, undefined],"") of
	    UEmpty when (UEmpty == "") ; (element(2,UEmpty) == "")  ->
		{html_header("Unexpected I/O log"),"\n</body>\n</html>\n"};
	    {basic_html,UH,UF} ->
		{UH,UF};
	    {xhtml,UH,UF} ->
		{UH,UF}
	end,

    {ok,Unexpected} = open_html_file(UnexpectedName),
    io:put_chars(Unexpected, [UnexpHeader,			      
			      xhtml("<br>\n<h2>Unexpected I/O</h2>",
				    "<br />\n<h3>Unexpected I/O</h3>"),
			      "\n<pre>\n"]),
    put(test_server_unexpected_footer,{UnexpectedName,UnexpFooter}),

    test_server_io:set_fd(major, Major),
    test_server_io:set_fd(html, Html),
    test_server_io:set_fd(unexpected_io, Unexpected),

    make_html_link(filename:absname(?last_test ++ ?html_ext),
		   HtmlName, filename:basename(Dir)),
    LinkName = filename:join(Dir, ?last_link),
    make_html_link(LinkName ++ ?html_ext, HtmlName,
		   filename:basename(Dir)),

    PrivDir = filename:join(TestDir1, ?priv_dir),
    ok = file:make_dir(PrivDir),
    put(test_server_priv_dir,PrivDir++"/"),
    print_timestamp(major, "Suite started at "),

    LogInfo = [{topdir,Dir},{rundir,lists:flatten(TestDir1)}],
    test_server_sup:framework_call(report, [loginfo,LogInfo]),
    {ok,TestDir1}.

log_file_error(Error, Dir) ->
    exit({cannot_create_log_dir,{Error,lists:flatten(Dir)}}).

make_html_link(LinkName, Target, Explanation) ->
    %% if possible use a relative reference to Target.
    TargetL = filename:split(Target),
    PwdL = filename:split(filename:dirname(LinkName)),
    Href = case lists:prefix(PwdL, TargetL) of
	       true ->
		   uri_encode(filename:join(lists:nthtail(length(PwdL),TargetL)));
	       false ->
		   "file:" ++ uri_encode(Target)
	   end,
    H = [html_header(Explanation),
	 "<h1>Last test</h1>\n"
	 "<a href=\"",Href,"\">",Explanation,"</a>\n"
	 "</body>\n</html>\n"],
    ok = write_html_file(LinkName, H).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% start_minor_log_file(Mod, Func, ParallelTC) -> AbsName
%% Mod = atom()
%% Func = atom()
%% ParallelTC = bool()
%% AbsName = string()
%%
%% Create a minor log file for the test case Mod,Func,Args. The log file
%% will be stored in the log directory under the name <Mod>.<Func>.html.
%% Some header info will also be inserted into the log file. If the test
%% case runs in a parallel group, then to avoid clashing file names if the
%% case is executed more than once, the name <Mod>.<Func>.<Timestamp>.html
%% is used.

start_minor_log_file(Mod, Func, ParallelTC) ->
    MFA = {Mod,Func,1},
    LogDir = get(test_server_log_dir_base),
    Name0 = lists:flatten(io_lib:format("~w.~w~ts", [Mod,Func,?html_ext])),
    Name = downcase(Name0),
    AbsName = filename:join(LogDir, Name),
    case (ParallelTC orelse (element(1,file:read_file_info(AbsName))==ok)) of
	false ->                           %% normal case, unique name
	    start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA);
	true ->                            %% special case, duplicate names
	    Tag = test_server_sup:unique_name(),
	    Name1_0 =
		lists:flatten(io_lib:format("~w.~w.~ts~ts", [Mod,Func,Tag,
							      ?html_ext])),
	    Name1 = downcase(Name1_0),
	    AbsName1 = filename:join(LogDir, Name1),
	    start_minor_log_file1(Mod, Func, LogDir, AbsName1, MFA)
    end.

start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA) ->
    {ok,Fd} = open_html_file(AbsName),
    Lev = get(test_server_minor_level)+1000, %% far down in the minor levels
    put(test_server_minor_fd, Fd),
    test_server_gl:set_minor_fd(group_leader(), Fd, MFA),

    TestDescr = io_lib:format("Test ~w:~w result", [Mod,Func]),
    {Header,Footer} =
	case test_server_sup:framework_call(get_html_wrapper,
					    [TestDescr,false,
					     filename:dirname(AbsName),
					     undefined], "") of
	    Empty when (Empty == "") ; (element(2,Empty) == "")  ->
		put(basic_html, true),
		{html_header(TestDescr), "\n</body>\n</html>\n"};
	    {basic_html,Html0,Html1} ->
		put(basic_html, true),
		{Html0,Html1};
	    {xhtml,Html0,Html1} ->
		put(basic_html, false),
		{Html0,Html1}
	end,
    put(test_server_minor_footer, Footer),
    io:put_chars(Fd, Header),

    io:put_chars(Fd, "<a name=\"top\"></a>"),
    io:put_chars(Fd, "<pre>\n"),

    SrcListing = downcase(atom_to_list(Mod)) ++ ?src_listing_ext,

    case get_fw_mod(?MODULE) of
	Mod when Func == error_in_suite ->
	    ok;
	_ ->
	    {Info,Arity} =
		if Func == init_per_suite; Func == end_per_suite ->
			{"Config function: ", 1};
		   Func == init_per_group; Func == end_per_group ->
			{"Config function: ", 2};
		   true ->
			{"Test case: ", 1}
		end,
	    
	    case {filelib:is_file(filename:join(LogDir, SrcListing)),
		  lists:member(no_src, get(test_server_logopts))} of
		{true,false} ->
		    print(Lev, Info ++ "<a href=\"~ts#~ts\">~w:~w/~w</a> "
			  "(click for source code)\n",
			  [uri_encode(SrcListing),
			   uri_encode(atom_to_list(Func)++"-1",utf8),
			   Mod,Func,Arity]);
		_ ->
		    print(Lev, Info ++ "~w:~w/~w\n", [Mod,Func,Arity])
	    end
    end,

    AbsName.

stop_minor_log_file() ->
    test_server_gl:unset_minor_fd(group_leader()),
    Fd = get(test_server_minor_fd),
    Footer = get(test_server_minor_footer),
    io:put_chars(Fd, "</pre>\n" ++ Footer),
    ok = file:close(Fd),
    put(test_server_minor_fd, undefined).

downcase(S) -> downcase(S, []).
downcase([Uc|Rest], Result) when $A =< Uc, Uc =< $Z ->
    downcase(Rest, [Uc-$A+$a|Result]);
downcase([C|Rest], Result) ->
    downcase(Rest, [C|Result]);
downcase([], Result) ->
    lists:reverse(Result).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% html_convert_modules(TestSpec, Config) -> ok
%%  Isolate the modules affected by TestSpec and
%%  make sure they are converted to html.
%%
%%  Errors are silently ignored.

html_convert_modules(TestSpec, _Config, FwMod) ->
    Mods = html_isolate_modules(TestSpec, FwMod),
    html_convert_modules(Mods),
    copy_html_files(get(test_server_dir), get(test_server_log_dir_base)).

%% Retrieve a list of modules out of the test spec.
html_isolate_modules(List, FwMod) ->
    html_isolate_modules(List, sets:new(), FwMod).

html_isolate_modules([], Set, _) -> sets:to_list(Set);
html_isolate_modules([{skip_case,{_Case,_Cmt},_Mode}|Cases], Set, FwMod) ->
    html_isolate_modules(Cases, Set, FwMod);
html_isolate_modules([{conf,_Ref,Props,{FwMod,_Func}}|Cases], Set, FwMod) ->
    Set1 = case proplists:get_value(suite, Props) of
	       undefined -> Set;
	       Mod -> sets:add_element(Mod, Set)
	   end,
    html_isolate_modules(Cases, Set1, FwMod);
html_isolate_modules([{conf,_Ref,_Props,{Mod,_Func}}|Cases], Set, FwMod) ->
    html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod);
html_isolate_modules([{skip_case,{conf,_Ref,{FwMod,_Func},_Cmt},Mode}|Cases],
		     Set, FwMod) ->
    Set1 = case proplists:get_value(suite, get_props(Mode)) of
	       undefined -> Set;
	       Mod -> sets:add_element(Mod, Set)
	   end,
    html_isolate_modules(Cases, Set1, FwMod);
html_isolate_modules([{skip_case,{conf,_Ref,{Mod,_Func},_Cmt},_Props}|Cases],
		     Set, FwMod) ->
    html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod);
html_isolate_modules([{Mod,_Case}|Cases], Set, FwMod) ->
    html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod);
html_isolate_modules([{Mod,_Case,_Args}|Cases], Set, FwMod) ->
    html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod).

%% Given a list of modules, convert each module's source code to HTML.
html_convert_modules([Mod|Mods]) ->
    case code:which(Mod) of
	Path when is_list(Path) ->
	    SrcFile = filename:rootname(Path) ++ ".erl",
	    FoundSrcFile =
		case file:read_file_info(SrcFile) of
		    {ok,SInfo} ->
			{SrcFile,SInfo};
		    {error,_} ->
			ModInfo = Mod:module_info(compile),
			case proplists:get_value(source, ModInfo) of
			    undefined ->
				undefined;
			    OtherSrcFile ->
				case file:read_file_info(OtherSrcFile) of
				    {ok,SInfo} ->
					{OtherSrcFile,SInfo};
				    {error,_} ->
					undefined
				end
			end
		end,
	    case FoundSrcFile of
		undefined ->
		    html_convert_modules(Mods);
		{SrcFile1,SrcFileInfo} ->
		    DestDir = get(test_server_dir),
		    Name = atom_to_list(Mod),
		    DestFile = filename:join(DestDir,
					     downcase(Name)++?src_listing_ext),
		    html_possibly_convert(SrcFile1, SrcFileInfo, DestFile),
		    html_convert_modules(Mods)
	    end;
	_Other ->
	    html_convert_modules(Mods)
    end;
html_convert_modules([]) -> ok.

%% Convert source code to HTML if possible and needed.
html_possibly_convert(Src, SrcInfo, Dest) ->
    case file:read_file_info(Dest) of
	{ok,DestInfo} when DestInfo#file_info.mtime >= SrcInfo#file_info.mtime ->
	    ok;					% dest file up to date
	_ ->
	    InclPath = case application:get_env(test_server, include) of
			   {ok,Incls} -> Incls;
			   _ -> []
		       end,

	    OutDir = get(test_server_log_dir_base),
	    case test_server_sup:framework_call(get_html_wrapper,
						["Module "++Src,false,
						 OutDir,undefined,
						 encoding(Src)], "") of
		Empty when (Empty == "") ; (element(2,Empty) == "")  ->
		    erl2html2:convert(Src, Dest, InclPath);
		{_,Header,_} ->
		    erl2html2:convert(Src, Dest, InclPath, Header)
	    end
    end.

%% Copy all HTML files in InDir to OutDir.
copy_html_files(InDir, OutDir) ->
    Files = filelib:wildcard(filename:join(InDir, "*" ++ ?src_listing_ext)),
    lists:foreach(fun (Src) -> copy_html_file(Src, OutDir) end, Files).

copy_html_file(Src, DestDir) ->
    Dest = filename:join(DestDir, filename:basename(Src)),
    case file:read_file(Src) of
	{ok,Bin} ->
	    ok = write_binary_file(Dest, Bin);
	{error,_Reason} ->
	    io:format("File ~ts: read failed\n", [Src])
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% add_init_and_end_per_suite(TestSpec, Mod, Ref, FwMod) -> NewTestSpec
%%
%% Expands TestSpec with an initial init_per_suite, and a final
%% end_per_suite element, per each discovered suite in the list.

add_init_and_end_per_suite([{make,_,_}=Case|Cases], LastMod, LastRef, FwMod) ->
    [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
add_init_and_end_per_suite([{skip_case,{{Mod,all},_},_}=Case|Cases], LastMod,
			   LastRef, FwMod) when Mod =/= LastMod ->
    {PreCases, NextMod, NextRef} =
	do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod),
    PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
						 NextRef, FwMod)];
add_init_and_end_per_suite([{skip_case,{{Mod,_},_Cmt},_Mode}=Case|Cases],
			   LastMod, LastRef, FwMod) when Mod =/= LastMod ->
    {PreCases, NextMod, NextRef} =
	do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
    PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
						 NextRef, FwMod)];
add_init_and_end_per_suite([{skip_case,{conf,_,{Mod,_},_},_}=Case|Cases],
			   LastMod, LastRef, FwMod) when Mod =/= LastMod ->
    {PreCases, NextMod, NextRef} =
	do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
    PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
						 NextRef, FwMod)];
add_init_and_end_per_suite([{skip_case,{conf,_,{Mod,_},_}}=Case|Cases], LastMod,
			   LastRef, FwMod) when Mod =/= LastMod ->
    {PreCases, NextMod, NextRef} =
	do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
    PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
						 NextRef, FwMod)];
add_init_and_end_per_suite([{conf,Ref,Props,{FwMod,Func}}=Case|Cases], LastMod,
			   LastRef, FwMod) ->
    %% if Mod == FwMod, this conf test is (probably) a test case group where
    %% the init- and end-functions are missing in the suite, and if so,
    %% the suite name should be stored as {suite,Suite} in Props
    case proplists:get_value(suite, Props) of
	Suite when Suite =/= undefined, Suite =/= LastMod ->
	    {PreCases, NextMod, NextRef} =
		do_add_init_and_end_per_suite(LastMod, LastRef, Suite, FwMod),
	    Case1 = {conf,Ref,[{suite,NextMod}|proplists:delete(suite,Props)],
		     {FwMod,Func}},
	    PreCases ++ [Case1|add_init_and_end_per_suite(Cases, NextMod,
							  NextRef, FwMod)];
	_ ->
	    [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)]
    end;
add_init_and_end_per_suite([{conf,_,_,{Mod,_}}=Case|Cases], LastMod,
			   LastRef, FwMod) when Mod =/= LastMod, Mod =/= FwMod ->
    {PreCases, NextMod, NextRef} =
	do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
    PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
						 NextRef, FwMod)];
add_init_and_end_per_suite([SkipCase|Cases], LastMod, LastRef, FwMod)
  when element(1,SkipCase) == skip_case;  element(1,SkipCase) == auto_skip_case->
    [SkipCase|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
add_init_and_end_per_suite([{conf,_,_,_}=Case|Cases], LastMod, LastRef, FwMod) ->
    [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
add_init_and_end_per_suite([{Mod,_}=Case|Cases], LastMod, LastRef, FwMod)
  when Mod =/= LastMod, Mod =/= FwMod ->
    {PreCases, NextMod, NextRef} =
	do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
    PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
						 NextRef, FwMod)];
add_init_and_end_per_suite([{Mod,_,_}=Case|Cases], LastMod, LastRef, FwMod)
  when Mod =/= LastMod, Mod =/= FwMod ->
    {PreCases, NextMod, NextRef} =
	do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
    PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
						 NextRef, FwMod)];
add_init_and_end_per_suite([Case|Cases], LastMod, LastRef, FwMod)->
    [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
add_init_and_end_per_suite([], _LastMod, undefined, _FwMod) ->
    [];
add_init_and_end_per_suite([], _LastMod, skipped_suite, _FwMod) ->
    [];
add_init_and_end_per_suite([], LastMod, LastRef, FwMod) ->
    %% we'll add end_per_suite here even if it's not exported
    %% (and simply let the call fail if it's missing)
    case erlang:function_exported(LastMod, end_per_suite, 1) of
	true ->
	    [{conf,LastRef,[],{LastMod,end_per_suite}}];
	false ->
	    %% let's call a "fake" end_per_suite if it exists			
	    case erlang:function_exported(FwMod, end_per_suite, 1) of
		true ->					
		    [{conf,LastRef,[{suite,LastMod}],{FwMod,end_per_suite}}];
		false ->		
		    [{conf,LastRef,[],{LastMod,end_per_suite}}]
	    end
    end.    

do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) ->
    case code:is_loaded(Mod) of
	false -> code:load_file(Mod);
	_ -> ok
    end,
    {Init,NextMod,NextRef} =
	case erlang:function_exported(Mod, init_per_suite, 1) of
	    true ->
		Ref = make_ref(),
		{[{conf,Ref,[],{Mod,init_per_suite}}],Mod,Ref};
	    false ->
		%% let's call a "fake" init_per_suite if it exists
		case erlang:function_exported(FwMod, init_per_suite, 1) of
		    true ->
			Ref = make_ref(),
			{[{conf,Ref,[{suite,Mod}],
			   {FwMod,init_per_suite}}],Mod,Ref};
		    false ->
			{[],Mod,undefined}
		end

	end,
    Cases =
	if LastRef==undefined ->
		Init;
	   LastRef==skipped_suite ->
		Init;
	   true ->
		%% we'll add end_per_suite here even if it's not exported
		%% (and simply let the call fail if it's missing)
		case erlang:function_exported(LastMod, end_per_suite, 1) of
		    true ->
			[{conf,LastRef,[],{LastMod,end_per_suite}}|Init];
		    false ->
			%% let's call a "fake" end_per_suite if it exists
			case erlang:function_exported(FwMod, end_per_suite, 1) of
			    true ->				
				[{conf,LastRef,[{suite,Mod}],
				  {FwMod,end_per_suite}}|Init];
			    false ->
				[{conf,LastRef,[],{LastMod,end_per_suite}}|Init]
			end
		end
	end,
    {Cases,NextMod,NextRef}.

do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) ->
    case LastRef of
	No when No==undefined ; No==skipped_suite ->
	    {[],Mod,skipped_suite};
	_Ref ->
	    case erlang:function_exported(LastMod, end_per_suite, 1) of
		true ->
		    {[{conf,LastRef,[],{LastMod,end_per_suite}}],
		     Mod,skipped_suite};
		false ->
		    case erlang:function_exported(FwMod, end_per_suite, 1) of
			true ->				
			    %% let's call "fake" end_per_suite if it exists
			    {[{conf,LastRef,[],{FwMod,end_per_suite}}],
			     Mod,skipped_suite};
			false ->
			    {[{conf,LastRef,[],{LastMod,end_per_suite}}],
			     Mod,skipped_suite}
		    end
	    end    	    
    end.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% run_test_cases(TestSpec, Config, TimetrapData) -> exit(Result)
%%
%% Runs the specified tests, then displays/logs the summary.

run_test_cases(TestSpec, Config, TimetrapData) ->
    test_server:init_purify(),
    case lists:member(no_src, get(test_server_logopts)) of
	true ->
	    ok;
	false ->
	    FwMod = get_fw_mod(?MODULE),
	    html_convert_modules(TestSpec, Config, FwMod)
    end,

    run_test_cases_loop(TestSpec, [Config], TimetrapData, [], []),

    {AllSkippedN,UserSkipN,AutoSkipN,SkipStr} =
	case get(test_server_skipped) of
	    {0,0} -> {0,0,0,""};
	    {US,AS} -> {US+AS,US,AS,io_lib:format(", ~w skipped", [US+AS])}
	end,
    OkN = get(test_server_ok),
    FailedN = get(test_server_failed),
    print(1, "TEST COMPLETE, ~w ok, ~w failed~ts of ~w test cases\n",
	  [OkN,FailedN,SkipStr,OkN+FailedN+AllSkippedN]),
    test_server_sup:framework_call(report, [tests_done,
					    {OkN,FailedN,{UserSkipN,AutoSkipN}}]),
    print(major, "=finished      ~s", [lists:flatten(timestamp_get(""))]),
    print(major, "=failed        ~w", [FailedN]),
    print(major, "=successful    ~w", [OkN]),
    print(major, "=user_skipped  ~w", [UserSkipN]),
    print(major, "=auto_skipped  ~w", [AutoSkipN]),
    exit(test_suites_done).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% run_test_cases_loop(TestCases, Config, TimetrapData, Mode, Status) -> ok
%% TestCases = [Test,...]
%% Config = [[{Key,Val},...],...]
%% TimetrapData = {MultiplyTimetrap,ScaleTimetrap}
%% MultiplyTimetrap = integer() | infinity
%% ScaleTimetrap = bool()
%% Mode = [{Ref,[Prop,..],StartTime}]
%% Ref = reference()
%% Prop = {name,Name} | sequence | parallel |
%%        shuffle | {shuffle,Seed} |
%%        repeat | {repeat,N} |
%%        repeat_until_all_ok | {repeat_until_all_ok,N} |
%%        repeat_until_any_ok | {repeat_until_any_ok,N} |
%%        repeat_until_any_fail | {repeat_until_any_fail,N} |
%%        repeat_until_all_fail | {repeat_until_all_fail,N}
%% Status = [{Ref,{{Ok,Skipped,Failed},CopiedCases}}]
%% Ok = Skipped = Failed = [Case,...]
%%
%% Execute the TestCases under configuration Config. Config is a list
%% of lists, where hd(Config) holds the config tuples for the current
%% conf case and tl(Config) is the data for the higher level conf cases.
%% Config data is "inherited" from top to nested conf cases, but
%% never the other way around. if length(Config) == 1, Config contains
%% only the initial config data for the suite.
%%
%% Test may be one of the following:
%%
%% {conf,Ref,Props,{Mod,Func}} Mod:Func is a configuration modification
%% function, call it with the current configuration as argument. It will
%% return a new configuration.
%%
%% {make,Ref,{Mod,Func,Args}} Mod:Func is a make function, and it is called
%% with the given arguments.
%%
%% {Mod,Case} This is a normal test case. Determine the correct
%% configuration, and insert {Mod,Case,Config} as head of the list,
%% then reiterate.
%%
%% {Mod,Case,Args} A test case with predefined argument (usually a normal
%% test case which just got a fresh configuration (see above)).
%%
%% {skip_case,{conf,Ref,Case,Comment}} An init conf case gets skipped
%% by the user. This will also cause the end conf case to be skipped.
%% Note that it is not possible to skip an end conf case directly (it
%% can only be skipped indirectly by a skipped init conf case). The
%% comment (which gets printed in the log files) describes why the case
%% was skipped.
%%
%% {skip_case,{Case,Comment},Mode} A normal test case skipped by the user.
%% The comment (which gets printed in the log files) describes why the
%% case was skipped.
%%
%% {auto_skip_case,{conf,Ref,Case,Comment},Mode} This is the result of
%% an end conf case being automatically skipped due to a failing init
%% conf case. It could also be a nested conf case that gets skipped
%% because of a failed or skipped top level conf.
%%
%% {auto_skip_case,{Case,Comment},Mode} This is a normal test case which
%% gets automatically skipped because of a failing init conf case or
%% because of a failing previous test case in a sequence.
%%
%% -------------------------------------------------------------------
%% Description of IO handling during execution of parallel test cases:
%% -------------------------------------------------------------------
%%
%% A conf group can have an associated list of properties. If the
%% parallel property is specified for a group, it means the test cases
%% should be spawned and run in parallel rather than called sequentially
%% (which is always the default mode). Test cases that execute in parallel
%% also write to their respective minor log files in parallel. Printouts
%% to common log files, such as the summary html file and the major log
%% file on text format, still have to be processed sequentially. For this
%% reason, the Mode argument specifies if a parallel group is currently
%% being executed.
%%
%% The low-level mechanism for buffering IO for the common log files
%% is handled by the test_server_io module. Buffering is turned on by
%% test_server_io:start_transaction/0 and off by calling
%% test_server_io:end_transaction/0. The buffered data for the transaction
%% can printed by calling test_server_io:print_buffered/1.
%%
%% This module is responsible for turning on IO buffering and to later
%% test_server_io:print_buffered/1 to print the data. To help with this,
%% two variables in the process dictionary are used:
%% 'test_server_common_io_handler' and 'test_server_queued_io'. The values
%% are set to as follwing:
%%
%%   Value	Meaning
%%   -----     -------
%%   undefined	No parallel test cases running
%%   {tc,Pid}	Running test cases in a top-level parallel group
%%   {Ref,Pid}	Running sequential test case inside a parallel group
%%
%% FIXME: The Pid is no longer used.
%%
%% If a conf group nested under a parallel group in the test
%% specification should be started, the 'test_server_common_io_handler'
%% value gets set also on the main process.
%%
%% During execution of a parallel group (or of a group nested under a
%% parallel group), *any* new test case being started gets registered
%% in a list saved in the dictionary with 'test_server_queued_io' as key.
%% When the top level parallel group is finished (only then can we be
%% sure all parallel test cases have finished and "reported in"), the
%% list of test cases is traversed in order and test_server_io:print_buffered/1
%% can be called for each test case. See handle_test_case_io_and_status/0
%% for details.
%%
%% To be able to handle nested conf groups with different properties,
%% the Mode argument specifies a list of {Ref,Properties} tuples.
%% The head of the Mode list at any given time identifies the group
%% currently being processed. The tail of the list identifies groups
%% on higher level.
%%
%% -------------------------------------------------------------------
%% Notes on parallel execution of test cases
%% -------------------------------------------------------------------
%%
%% A group nested under a parallel group will start executing in
%% parallel with previous (parallel) test cases (no matter what
%% properties the nested group has). Test cases are however never
%% executed in parallel with the start or end conf case of the same
%% group! Because of this, the test_server_ctrl loop waits at
%% the end conf of a group for all parallel cases to finish
%% before the end conf case actually executes. This has the effect
%% that it's only after a nested group has finished that any
%% remaining parallel cases in the previous group get spawned (*).
%% Example (all parallel cases):
%%
%% group1_init   |---->
%% group1_case1        | --------->
%% group1_case2        | --------------------------------->
%% group2_init         | ---->
%% group2_case1               | ------>
%% group2_case2               | ---------->
%% group2_end                              | --->
%% group1_case3                               (*)| ---->
%% group1_case4                               (*)| -->
%% group1_end                                              | --->
%%

run_test_cases_loop([{SkipTag,CaseData={Type,_Ref,_Case,_Comment}}|Cases],
		    Config, TimetrapData, Mode, Status) when
      ((SkipTag==auto_skip_case) or (SkipTag==skip_case)) and
      ((Type==conf) or (Type==make)) ->
    run_test_cases_loop([{SkipTag,CaseData,Mode}|Cases],
			Config, TimetrapData, Mode, Status);

run_test_cases_loop([{SkipTag,{Type,Ref,Case,Comment},SkipMode}|Cases],
		    Config, TimetrapData, Mode, Status) when
      ((SkipTag==auto_skip_case) or (SkipTag==skip_case)) and
      ((Type==conf) or (Type==make)) ->
    file:set_cwd(filename:dirname(get(test_server_dir))),
    CurrIOHandler = get(test_server_common_io_handler),
    ParentMode = tl(Mode),

    {AutoOrUser,ReportTag} = 
	if SkipTag == auto_skip_case -> {auto,tc_auto_skip};
	   SkipTag == skip_case      -> {user,tc_user_skip}
	end,

    %% check and update the mode for test case execution and io msg handling
    case {curr_ref(Mode),check_props(parallel, Mode)} of
	{Ref,Ref} ->
	    case check_props(parallel, ParentMode) of
		false ->
		    %% this is a skipped end conf for a top level parallel
		    %% group, buffered io can be flushed
		    handle_test_case_io_and_status(),
		    set_io_buffering(undefined),
		    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
					   false, SkipMode),
		    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
		    test_server_sup:framework_call(report,
						   [ReportTag,ConfData]),
		    run_test_cases_loop(Cases, Config, TimetrapData, ParentMode,
					delete_status(Ref, Status));
		_ ->
		    %% this is a skipped end conf for a parallel group nested
		    %% under a parallel group (io buffering is active)
		    wait_for_cases(Ref),
		    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
					   true, SkipMode),
		    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
		    test_server_sup:framework_call(report, [ReportTag,ConfData]),
		    case CurrIOHandler of
			{Ref,_} ->
			    %% current_io_handler was set by start conf of this
			    %% group, so we can unset it now (no more io from main
			    %% process needs to be buffered)
			    set_io_buffering(undefined);
			_ ->
			    ok
		    end,
		    run_test_cases_loop(Cases, Config,
					TimetrapData, ParentMode,
					delete_status(Ref, Status))
	    end;
	{Ref,false} ->
	    %% this is a skipped end conf for a non-parallel group that's not
	    %% nested under a parallel group
	    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
				   false, SkipMode),
	    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
	    test_server_sup:framework_call(report, [ReportTag,ConfData]),

	    %% Check if this group is auto skipped because of error in the
	    %% init conf. If so, check if the parent group is a sequence,
	    %% and if it is, skip all proceeding tests in that group.
	    GrName = get_name(Mode),
	    Cases1 =
		case get_tc_results(Status) of
		    {_,_,Fails} when length(Fails) > 0 ->
			case lists:member({group_result,GrName}, Fails) of
			    true ->
				case check_prop(sequence, ParentMode) of
				    false ->
					Cases;
				    ParentRef ->
					Reason = {group_result,GrName,failed},
					skip_cases_upto(ParentRef, Cases,
							Reason, tc, ParentMode,
							SkipTag)
				end;
			    false ->
				Cases
			end;
		    _ ->
			Cases
		end,
	    run_test_cases_loop(Cases1, Config, TimetrapData, ParentMode,
				delete_status(Ref, Status));
	{Ref,_} ->
	    %% this is a skipped end conf for a non-parallel group nested under
	    %% a parallel group (io buffering is active)
	    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
				   true, SkipMode),
	    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
	    test_server_sup:framework_call(report, [ReportTag,ConfData]),
	    case CurrIOHandler of
		{Ref,_} ->
		    %% current_io_handler was set by start conf of this
		    %% group, so we can unset it now (no more io from main
		    %% process needs to be buffered)
		    set_io_buffering(undefined);
		_ ->
		    ok
	    end,
	    run_test_cases_loop(Cases, Config, TimetrapData, tl(Mode),
				delete_status(Ref, Status));
	{_,false} ->
	    %% this is a skipped start conf for a group which is not nested
	    %% under a parallel group
	    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
				   false, SkipMode),
	    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
	    test_server_sup:framework_call(report, [ReportTag,ConfData]),
	    run_test_cases_loop(Cases, Config, TimetrapData,
				[conf(Ref,[])|Mode], Status);
	{_,Ref0} when is_reference(Ref0) ->
	    %% this is a skipped start conf for a group nested under a parallel
	    %% group and if this is the first nested group, io buffering must
	    %% be activated
	    if CurrIOHandler == undefined ->
		    set_io_buffering({Ref,self()});
	       true ->
		    ok
	    end,
	    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
				   true, SkipMode),
	    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
	    test_server_sup:framework_call(report, [ReportTag,ConfData]),
	    run_test_cases_loop(Cases, Config, TimetrapData,
				[conf(Ref,[])|Mode], Status)
    end;

run_test_cases_loop([{auto_skip_case,{Case,Comment},SkipMode}|Cases],
		    Config, TimetrapData, Mode, Status) ->
    {Mod,Func} = skip_case(auto, undefined, get(test_server_case_num)+1,
			   Case, Comment, is_io_buffered(), SkipMode),
    test_server_sup:framework_call(report, [tc_auto_skip,
					    {Mod,{Func,get_name(SkipMode)},
					     Comment}]),
    run_test_cases_loop(Cases, Config, TimetrapData, Mode,
			update_status(skipped, Mod, Func, Status));

run_test_cases_loop([{skip_case,{{Mod,all}=Case,Comment},SkipMode}|Cases],
		    Config, TimetrapData, Mode, Status) ->
    skip_case(user, undefined, 0, Case, Comment, false, SkipMode),
    test_server_sup:framework_call(report, [tc_user_skip,
					    {Mod,{all,get_name(SkipMode)},
					     Comment}]),
    run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status);

run_test_cases_loop([{skip_case,{Case,Comment},SkipMode}|Cases],
		    Config, TimetrapData, Mode, Status) ->
    {Mod,Func} = skip_case(user, undefined, get(test_server_case_num)+1,
			   Case, Comment, is_io_buffered(), SkipMode),
    test_server_sup:framework_call(report, [tc_user_skip,
					    {Mod,{Func,get_name(SkipMode)},
					     Comment}]),
    run_test_cases_loop(Cases, Config, TimetrapData, Mode,
			update_status(skipped, Mod, Func, Status));

%% a start *or* end conf case, wrapping test cases or other conf cases
run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
		    Config, TimetrapData, Mode0, Status) ->
    CurrIOHandler = get(test_server_common_io_handler),
    %% check and update the mode for test case execution and io msg handling
    {StartConf,Mode,IOHandler,ConfTime,Status1} =
	case {curr_ref(Mode0),check_props(parallel, Mode0)} of
	    {Ref,Ref} ->
		case check_props(parallel, tl(Mode0)) of
		    false ->
			%% this is an end conf for a top level parallel group,
			%% collect results from the test case processes
			%% and calc total time
			OkSkipFail = handle_test_case_io_and_status(),
			file:set_cwd(filename:dirname(get(test_server_dir))),
			After = ?now,
			Before = get(test_server_parallel_start_time),
			Elapsed = timer:now_diff(After, Before)/1000000,
			put(test_server_total_time, Elapsed),
			{false,tl(Mode0),undefined,Elapsed,
			 update_status(Ref, OkSkipFail, Status)};
		    _ ->
			%% this is an end conf for a parallel group nested under a
			%% parallel group (io buffering is active)
			OkSkipFail = wait_for_cases(Ref),
			queue_test_case_io(Ref, self(), 0, Mod, Func),
			Elapsed = timer:now_diff(?now, conf_start(Ref, Mode0))/1000000,
			case CurrIOHandler of
			    {Ref,_} ->
				%% current_io_handler was set by start conf of this
				%% group, so we can unset it after this case (no
				%% more io from main process needs to be buffered)
				{false,tl(Mode0),undefined,Elapsed,
				 update_status(Ref, OkSkipFail, Status)};
			    _ ->
				{false,tl(Mode0),CurrIOHandler,Elapsed,
				 update_status(Ref, OkSkipFail, Status)}
			end
		end;
	    {Ref,false} ->
		%% this is an end conf for a non-parallel group that's not
		%% nested under a parallel group, so no need to buffer io
		{false,tl(Mode0),undefined,
		 timer:now_diff(?now, conf_start(Ref, Mode0))/1000000, Status};
	    {Ref,_} ->
		%% this is an end conf for a non-parallel group nested under
		%% a parallel group (io buffering is active)
		queue_test_case_io(Ref, self(), 0, Mod, Func),
		Elapsed = timer:now_diff(?now, conf_start(Ref, Mode0))/1000000,
		case CurrIOHandler of
		    {Ref,_} ->
			%% current_io_handler was set by start conf of this
			%% group, so we can unset it after this case (no
			%% more io from main process needs to be buffered)
			{false,tl(Mode0),undefined,Elapsed,Status};
		    _ ->
			{false,tl(Mode0),CurrIOHandler,Elapsed,Status}
		end;
	    {_,false} ->
		%% this is a start conf for a group which is not nested under a
		%% parallel group, check if this case starts a new parallel group
		case lists:member(parallel, Props) of
		    true ->
			%% prepare for execution of parallel group
			put(test_server_parallel_start_time, ?now),
			put(test_server_queued_io, []);
		    false ->
			ok
		end,
		{true,[conf(Ref,Props)|Mode0],undefined,0,Status};
	    {_,_Ref0} ->
		%% this is a start conf for a group nested under a parallel group, the
		%% parallel_start_time and parallel_test_cases values have already been set
		queue_test_case_io(Ref, self(), 0, Mod, Func),
		%% if this is the first nested group under a parallel group, io
		%% buffering must be activated
		IOHandler1 = if CurrIOHandler == undefined ->
				     IOH = {Ref,self()},
				     set_io_buffering(IOH),
				     IOH;
				true ->
				     CurrIOHandler
			     end,
		{true,[conf(Ref,Props)|Mode0],IOHandler1,0,Status}
	end,

    %% if this is a start conf we check if cases should be shuffled
    {[_Conf|Cases1]=Cs1,Shuffle} =
	if StartConf ->
		case get_shuffle(Props) of
		    undefined ->
			{Cs0,undefined};
		    {_,repeated} ->
			%% if group is repeated, a new seed should not be set every
			%% turn - last one is saved in dictionary
			CurrSeed = get(test_server_curr_random_seed),
			{shuffle_cases(Ref, Cs0, CurrSeed),{shuffle,CurrSeed}};
		    {_,Seed} ->
			UseSeed=
			    %% Determine which seed to use by:
			    %% 1. check the TS_RANDOM_SEED env variable
			    %% 2. check random_seed in process state
			    %% 3. use value provided with shuffle option
			    %% 4. use timestamp() values for seed
			    case os:getenv("TS_RANDOM_SEED") of
				Undef when Undef == false ; Undef == "undefined" ->
				    case get(test_server_random_seed) of
					undefined -> Seed;
					TSRS -> TSRS
				    end;
				NumStr ->
				    %% Ex: "123 456 789" or "123,456,789" -> {123,456,789}
				    list_to_tuple([list_to_integer(NS) ||
						   NS <- string:tokens(NumStr, [$ ,$:,$,])])
			    end,
			{shuffle_cases(Ref, Cs0, UseSeed),{shuffle,UseSeed}}
		end;
	   not StartConf ->
		{Cs0,undefined}
	end,

    %% if this is a start conf we check if Props specifies repeat and if so
    %% we copy the group and carry the copy until the end conf where we
    %% decide to perform the repetition or not
    {Repeating,Status2,Cases,ReportRepeatStop} =
	if StartConf ->
		case get_repeat(Props) of
		    undefined ->
			%% we *must* have a status entry for every conf since we
			%% will continously update status with test case results
			%% without knowing the Ref (but update hd(Status))
			{false,new_status(Ref, Status1),Cases1,?void_fun};
		    {_RepType,N} when N =< 1 ->
			{false,new_status(Ref, Status1),Cases1,?void_fun};
		    _ ->
			{Copied,_} = copy_cases(Ref, make_ref(), Cs1),
			{true,new_status(Ref, Copied, Status1),Cases1,?void_fun}
		end;
	   not StartConf ->
		RepVal = get_repeat(get_props(Mode0)),
		ReportStop =
		    fun() ->
			    print(minor, "~n*** Stopping repeat operation ~w", [RepVal]),
			    print(1, "Stopping repeat operation ~w", [RepVal])
		    end,
		CopiedCases = get_copied_cases(Status1),
		EndStatus = delete_status(Ref, Status1),
		%% check in Mode0 if this is a repeat conf
		case RepVal of
		    undefined ->
			{false,EndStatus,Cases1,?void_fun};
		    {_RepType,N} when N =< 1 ->
			{false,EndStatus,Cases1,?void_fun};
		    {repeat,_} ->
			{true,EndStatus,CopiedCases++Cases1,?void_fun};
		    {repeat_until_all_ok,_} ->
			{RestCs,Fun} = case get_tc_results(Status1) of
					   {_,_,[]} ->
					       {Cases1,ReportStop};
					   _ ->
					       {CopiedCases++Cases1,?void_fun}
				       end,
			{true,EndStatus,RestCs,Fun};
		    {repeat_until_any_ok,_} ->
			{RestCs,Fun} = case get_tc_results(Status1) of
					   {Ok,_,_Fails} when length(Ok) > 0 ->
					       {Cases1,ReportStop};
					   _ ->
					       {CopiedCases++Cases1,?void_fun}
				       end,
			{true,EndStatus,RestCs,Fun};
		    {repeat_until_any_fail,_} ->
			{RestCs,Fun} = case get_tc_results(Status1) of
					   {_,_,Fails} when length(Fails) > 0 ->
					       {Cases1,ReportStop};
					   _ ->
					       {CopiedCases++Cases1,?void_fun}
				 end,
			{true,EndStatus,RestCs,Fun};
		    {repeat_until_all_fail,_} ->
			{RestCs,Fun} = case get_tc_results(Status1) of
					   {[],_,_} ->
					       {Cases1,ReportStop};
					   _ ->
					       {CopiedCases++Cases1,?void_fun}
				       end,
			{true,EndStatus,RestCs,Fun}
		end
	end,

    ReportAbortRepeat = fun(What) when Repeating ->
				print(minor, "~n*** Aborting repeat operation "
				      "(configuration case ~w)", [What]),
				print(1, "Aborting repeat operation "
				      "(configuration case ~w)", [What]);
			   (_) -> ok
			end,
    CfgProps = if StartConf ->
		       if Shuffle == undefined ->
			       [{tc_group_properties,Props}];
			  true ->
			       [{tc_group_properties,
				 [Shuffle|delete_shuffle(Props)]}]
		       end;
		  not StartConf ->
		       {TcOk,TcSkip,TcFail} = get_tc_results(Status1),
		       [{tc_group_properties,get_props(Mode0)},
			{tc_group_result,[{ok,TcOk},
					  {skipped,TcSkip},
					  {failed,TcFail}]}]
	       end,

    SuiteName = proplists:get_value(suite, Props),
    case get(test_server_create_priv_dir) of
	auto_per_run ->				% use common priv_dir
	    TSDirs = [{priv_dir,get(test_server_priv_dir)},
		      {data_dir,get_data_dir(Mod, SuiteName)}];    
	_ ->
	    TSDirs = [{data_dir,get_data_dir(Mod, SuiteName)}]
    end,

    ActualCfg = 
	if not StartConf ->
		update_config(hd(Config), TSDirs ++ CfgProps);
	   true ->
		GroupPath = lists:flatmap(fun({_Ref,[],_T}) -> [];
					     ({_Ref,GrProps,_T}) -> [GrProps]
					  end, Mode0),
		update_config(hd(Config), 
			      TSDirs ++ [{tc_group_path,GroupPath} | CfgProps])
	end,

    CurrMode = curr_mode(Ref, Mode0, Mode),
    ConfCaseResult = run_test_case(Ref, 0, Mod, Func, [ActualCfg], skip_init,
				   TimetrapData, CurrMode),

    case ConfCaseResult of
	{_,NewCfg,_} when Func == init_per_suite, is_list(NewCfg) ->
	    %% check that init_per_suite returned data on correct format
	    case lists:filter(fun({_,_}) -> false;
				 (_) -> true end, NewCfg) of
		[] ->
		    set_io_buffering(IOHandler),
		    stop_minor_log_file(),
		    run_test_cases_loop(Cases, [NewCfg|Config],
					TimetrapData, Mode, Status2);
		Bad ->
		    print(minor,
			  "~n*** ~w returned bad elements in Config: ~p.~n",
			  [Func,Bad]),
		    Reason = {failed,{Mod,init_per_suite,bad_return}},
		    Cases2 = skip_cases_upto(Ref, Cases, Reason, conf, CurrMode,
					     auto_skip_case),
		    set_io_buffering(IOHandler),
		    stop_minor_log_file(),
		    run_test_cases_loop(Cases2, Config, TimetrapData, Mode,
					delete_status(Ref, Status2))
	    end;
	{_,NewCfg,_} when StartConf, is_list(NewCfg) ->
	    print_conf_time(ConfTime),
	    set_io_buffering(IOHandler),
	    stop_minor_log_file(),
	    run_test_cases_loop(Cases, [NewCfg|Config], TimetrapData, Mode, Status2);
	{_,{framework_error,{FwMod,FwFunc},Reason},_} ->
	    print(minor, "~n*** ~w failed in ~w. Reason: ~p~n",
		  [FwMod,FwFunc,Reason]),
	    print(1, "~w failed in ~w. Reason: ~p~n", [FwMod,FwFunc,Reason]),
	    exit(framework_error);
	{_,Fail,_} when element(1,Fail) == 'EXIT';
			element(1,Fail) == timetrap_timeout;
			element(1,Fail) == user_timetrap_error;
			element(1,Fail) == failed ->
	    {Cases2,Config1,Status3} =
		if StartConf ->
			ReportAbortRepeat(failed),
			print(minor, "~n*** ~w failed.~n"
			      "    Skipping all cases.", [Func]),
			Reason = {failed,{Mod,Func,Fail}},
			{skip_cases_upto(Ref, Cases, Reason, conf, CurrMode,
					 auto_skip_case),
			 Config,
			 update_status(failed, group_result, get_name(Mode),
				       delete_status(Ref, Status2))};
		   not StartConf ->
			ReportRepeatStop(),
			print_conf_time(ConfTime),
			{Cases,tl(Config),delete_status(Ref, Status2)}
		end,
	    set_io_buffering(IOHandler),
	    stop_minor_log_file(),
	    run_test_cases_loop(Cases2, Config1, TimetrapData, Mode, Status3);

	{_,{auto_skip,SkipReason},_} ->
	    %% this case can only happen if the framework (not the user)
	    %% decides to skip execution of a conf function
	    {Cases2,Config1,Status3} =
		if StartConf ->
			ReportAbortRepeat(auto_skipped),
			print(minor, "~n*** ~w auto skipped.~n"
			      "    Skipping all cases.", [Func]),
			{skip_cases_upto(Ref, Cases, SkipReason, conf, CurrMode,
					 auto_skip_case),
			 Config,
			 delete_status(Ref, Status2)};
		   not StartConf ->
			ReportRepeatStop(),
			print_conf_time(ConfTime),
			{Cases,tl(Config),delete_status(Ref, Status2)}
		end,
	    set_io_buffering(IOHandler),
	    stop_minor_log_file(),
	    run_test_cases_loop(Cases2, Config1, TimetrapData, Mode, Status3);

	{_,{Skip,Reason},_} when StartConf and ((Skip==skip) or (Skip==skipped)) ->
	    ReportAbortRepeat(skipped),
	    print(minor, "~n*** ~w skipped.~n"
		  "    Skipping all cases.", [Func]),
	    set_io_buffering(IOHandler),
	    stop_minor_log_file(),
	    run_test_cases_loop(skip_cases_upto(Ref, Cases, Reason, conf,
						CurrMode, skip_case),
				[hd(Config)|Config], TimetrapData, Mode,
				delete_status(Ref, Status2));
	{_,{skip_and_save,Reason,_SavedConfig},_} when StartConf ->
	    ReportAbortRepeat(skipped),
	    print(minor, "~n*** ~w skipped.~n"
		  "    Skipping all cases.", [Func]),
	    set_io_buffering(IOHandler),
	    stop_minor_log_file(),
	    run_test_cases_loop(skip_cases_upto(Ref, Cases, Reason, conf,
						CurrMode, skip_case),
				[hd(Config)|Config], TimetrapData, Mode,
				delete_status(Ref, Status2));
	{_,_Other,_} when Func == init_per_suite ->
	    print(minor, "~n*** init_per_suite failed to return a Config list.~n", []),
	    Reason = {failed,{Mod,init_per_suite,bad_return}},
	    Cases2 = skip_cases_upto(Ref, Cases, Reason, conf, CurrMode,
				     auto_skip_case),
	    set_io_buffering(IOHandler),
	    stop_minor_log_file(),
	    run_test_cases_loop(Cases2, Config, TimetrapData, Mode,
				delete_status(Ref, Status2));
	{_,_Other,_} when StartConf ->
	    print_conf_time(ConfTime),
	    set_io_buffering(IOHandler),
	    ReportRepeatStop(),
	    stop_minor_log_file(),
	    run_test_cases_loop(Cases, [hd(Config)|Config], TimetrapData,
				Mode, Status2);
	{_,_EndConfRetVal,Opts} ->
	    %% Check if return_group_result is set (ok, skipped or failed) and
	    %% if so:
	    %% 1) *If* the parent group is a sequence, skip all proceeding tests
	    %%    in that group.
	    %% 2) Return the value to the group "above" so that result may be
	    %%    used for evaluating a 'repeat_until_*' property.
	    GrName = get_name(Mode0, Func),
	    {Cases2,Status3} =
		case lists:keysearch(return_group_result, 1, Opts) of
		    {value,{_,failed}} ->
			case {curr_ref(Mode),check_prop(sequence, Mode)} of
			    {ParentRef,ParentRef} ->
				Reason = {group_result,GrName,failed},
				{skip_cases_upto(ParentRef, Cases, Reason, tc,
						 Mode, auto_skip_case),
				 update_status(failed, group_result, GrName,
					       delete_status(Ref, Status2))};
			    _ ->
				{Cases,update_status(failed, group_result, GrName,
						     delete_status(Ref, Status2))}
			end;
		    {value,{_,GroupResult}} ->
			{Cases,update_status(GroupResult, group_result, GrName,
					     delete_status(Ref, Status2))};
		    false ->
			{Cases,update_status(ok, group_result, GrName,
					     delete_status(Ref, Status2))}
		end,
	    print_conf_time(ConfTime),
	    ReportRepeatStop(),
	    set_io_buffering(IOHandler),
	    stop_minor_log_file(),
	    run_test_cases_loop(Cases2, tl(Config), TimetrapData,
				Mode, Status3)
    end;

run_test_cases_loop([{make,Ref,{Mod,Func,Args}}|Cases0], Config, TimetrapData,
		    Mode, Status) ->
    case run_test_case(Ref, 0, Mod, Func, Args, skip_init, TimetrapData) of
	{_,Why={'EXIT',_},_} ->
	    print(minor, "~n*** ~w failed.~n"
 		  "    Skipping all cases.", [Func]),
	    Reason = {failed,{Mod,Func,Why}},
	    Cases = skip_cases_upto(Ref, Cases0, Reason, conf, Mode,
				    auto_skip_case),
	    stop_minor_log_file(),
	    run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status);
	{_,_Whatever,_} ->
	    stop_minor_log_file(),
	    run_test_cases_loop(Cases0, Config, TimetrapData, Mode, Status)
    end;

run_test_cases_loop([{conf,_Ref,_Props,_X}=Conf|_Cases0],
		    Config, _TimetrapData, _Mode, _Status) ->
    erlang:error(badarg, [Conf,Config]);

run_test_cases_loop([{Mod,Case}|Cases], Config, TimetrapData, Mode, Status) ->
    ActualCfg =
	case get(test_server_create_priv_dir) of
	    auto_per_run ->
		update_config(hd(Config), [{priv_dir,get(test_server_priv_dir)},
					   {data_dir,get_data_dir(Mod)}]);
	    _ ->
		update_config(hd(Config), [{data_dir,get_data_dir(Mod)}])
	end,
    run_test_cases_loop([{Mod,Case,[ActualCfg]}|Cases], Config,
			TimetrapData, Mode, Status);

run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) ->
    {Num,RunInit} =
	case FwMod = get_fw_mod(?MODULE) of
	    Mod when Func == error_in_suite ->
		{-1,skip_init};
	    _ ->
		{put(test_server_case_num, get(test_server_case_num)+1),
		 run_init}
	end,

    %% check the current execution mode and save info about the case if
    %% detected that printouts to common log files is handled later

    case check_prop(parallel, Mode) =:= false andalso is_io_buffered() of
	true ->
	    %% sequential test case nested in a parallel group;
	    %% io is buffered, so we must queue this test case
	    queue_test_case_io(undefined, self(), Num+1, Mod, Func);
	false ->
	    ok
    end,

    case run_test_case(undefined, Num+1, Mod, Func, Args,
		       RunInit, TimetrapData, Mode) of
	%% callback to framework module failed, exit immediately
	{_,{framework_error,{FwMod,FwFunc},Reason},_} ->
	    print(minor, "~n*** ~w failed in ~w. Reason: ~p~n",
		  [FwMod,FwFunc,Reason]),
	    print(1, "~w failed in ~w. Reason: ~p~n", [FwMod,FwFunc,Reason]),
	    stop_minor_log_file(),
	    exit(framework_error);
	%% sequential execution of test case finished
	{Time,RetVal,_} ->
	    {Failed,Status1} =
		case Time of
		    died ->
			{true,update_status(failed, Mod, Func, Status)};
		    _ when is_tuple(RetVal) ->
			case element(1, RetVal) of
			    R when R=='EXIT'; R==failed ->
				{true,update_status(failed, Mod, Func, Status)};
			    R when R==skip; R==skipped ->
				{false,update_status(skipped, Mod, Func, Status)};
			    _ ->
				{false,update_status(ok, Mod, Func, Status)}
			end;
		    _ ->
			{false,update_status(ok, Mod, Func, Status)}
		end,
	    case check_prop(sequence, Mode) of
		false ->
		    stop_minor_log_file(),
		    run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status1);
		Ref ->
		    %% the case is in a sequence; we must check the result and
		    %% determine if the following cases should run or be skipped
		    if not Failed ->	      % proceed with next case
			    stop_minor_log_file(),
			    run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status1);
		       true ->	              % skip rest of cases in sequence
			    print(minor, "~n*** ~w failed.~n"
				  "    Skipping all other cases in sequence.",
				  [Func]),
			    Reason = {failed,{Mod,Func}},
			    Cases2 = skip_cases_upto(Ref, Cases, Reason, tc,
						     Mode, auto_skip_case),
			    stop_minor_log_file(),
			    run_test_cases_loop(Cases2, Config, TimetrapData, Mode, Status1)
		    end
	    end;
	%% the test case is being executed in parallel with the main process (and
	%% other test cases) and Pid is the dedicated process executing the case
	Pid ->
	    %% io from Pid will be buffered by the test_server_io process and
	    %% handled later, so we have to save info about the case
	    queue_test_case_io(undefined, Pid, Num+1, Mod, Func),
	    run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status)
    end;

%% TestSpec processing finished
run_test_cases_loop([], _Config, _TimetrapData, _, _) ->
    ok.

%%--------------------------------------------------------------------
%% various help functions

new_status(Ref, Status) ->
    [{Ref,{{[],[],[]},[]}} | Status].

new_status(Ref, CopiedCases, Status) ->
    [{Ref,{{[],[],[]},CopiedCases}} | Status].

delete_status(Ref, Status) ->
    lists:keydelete(Ref, 1, Status).

update_status(ok, Mod, Func, [{Ref,{{Ok,Skip,Fail},Cs}} | Status]) ->
    [{Ref,{{Ok++[{Mod,Func}],Skip,Fail},Cs}} | Status];

update_status(skipped, Mod, Func, [{Ref,{{Ok,Skip,Fail},Cs}} | Status]) ->
    [{Ref,{{Ok,Skip++[{Mod,Func}],Fail},Cs}} | Status];

update_status(failed, Mod, Func, [{Ref,{{Ok,Skip,Fail},Cs}} | Status]) ->
    [{Ref,{{Ok,Skip,Fail++[{Mod,Func}]},Cs}} | Status];

update_status(_, _, _, []) ->
    [].

update_status(Ref, {Ok,Skip,Fail}, [{Ref,{{Ok0,Skip0,Fail0},Cs}} | Status]) ->
    [{Ref,{{Ok0++Ok,Skip0++Skip,Fail0++Fail},Cs}} | Status].

get_copied_cases([{_,{_,Cases}} | _Status]) ->
    Cases.

get_tc_results([{_,{OkSkipFail,_}} | _Status]) ->
    OkSkipFail;
get_tc_results([]) ->		      % in case init_per_suite crashed
    {[],[],[]}.

conf(Ref, Props) ->
    {Ref,Props,?now}.

curr_ref([{Ref,_Props,_}|_]) ->
    Ref;
curr_ref([]) ->
    undefined.

curr_mode(Ref, Mode0, Mode1) ->
    case curr_ref(Mode1) of
	Ref -> Mode1;
	_   -> Mode0
    end.

get_props([{_,Props,_} | _]) ->
    Props;
get_props([]) ->
    [].

check_prop(_Attrib, []) ->
    false;
check_prop(Attrib, [{Ref,Props,_}|_]) ->
    case lists:member(Attrib, Props) of
	true -> Ref;
	false -> false
    end.

check_props(Attrib, Mode) ->
    case [R || {R,Ps,_} <- Mode, lists:member(Attrib, Ps)] of
	[] -> false;
	[Ref|_] -> Ref
    end.

get_name(Mode, Def) ->
    case get_name(Mode) of
	undefined -> Def;
	Name      -> Name
    end.

get_name([{_Ref,Props,_}|_]) ->
    proplists:get_value(name, Props);
get_name([]) ->
    undefined.

conf_start(Ref, Mode) ->
    case lists:keysearch(Ref, 1, Mode) of
	{value,{_,_,T}} -> T;
	false -> 0
    end.


get_data_dir(Mod) ->
    get_data_dir(Mod, undefined).

get_data_dir(Mod, Suite) ->
    UseMod = if Suite == undefined -> Mod;
		true               -> Suite
	     end,
    case code:which(UseMod) of
	non_existing ->
	    print(12, "The module ~w is not loaded", [Mod]),
	    [];
	cover_compiled ->
	    MainCoverNode = cover:get_main_node(),
	    {file,File} = rpc:call(MainCoverNode,cover,is_compiled,[UseMod]),
	    do_get_data_dir(UseMod,File);
	FullPath ->
	    do_get_data_dir(UseMod,FullPath)
    end.

do_get_data_dir(Mod,File) ->
    filename:dirname(File) ++ "/" ++ atom_to_list(Mod) ++ ?data_dir_suffix.

print_conf_time(0) ->
    ok;
print_conf_time(ConfTime) ->
    print(major, "=group_time    ~.3fs", [ConfTime]),
    print(minor, "~n=== Total execution time of group: ~.3fs~n", [ConfTime]).

print_props([]) ->
    ok;
print_props(Props) ->
    print(major, "=group_props   ~p", [Props]),
    print(minor, "Group properties: ~p~n", [Props]).

%% repeat N times:                                  {repeat,N}
%% repeat N times or until all successful:          {repeat_until_all_ok,N}
%% repeat N times or until at least one successful: {repeat_until_any_ok,N}
%% repeat N times or until at least one case fails: {repeat_until_any_fail,N}
%% repeat N times or until all fails:               {repeat_until_all_fail,N}
%% N      = integer() | forever
get_repeat(Props) ->
    get_prop([repeat,repeat_until_all_ok,repeat_until_any_ok,
	      repeat_until_any_fail,repeat_until_all_fail], forever, Props).

update_repeat(Props) ->
    case get_repeat(Props) of
	undefined ->
	    Props;
	{RepType,N} ->
	    Props1 =
		if N == forever ->
			[{RepType,N}|lists:keydelete(RepType, 1, Props)];
		   N < 3 ->
			lists:keydelete(RepType, 1, Props);
		   N >= 3 ->
			[{RepType,N-1}|lists:keydelete(RepType, 1, Props)]
		end,
	    %% if shuffle is used in combination with repeat, a new
	    %% seed shouldn't be set every new turn
	    case get_shuffle(Props1) of
		undefined ->
		    Props1;
		_ ->
		    [{shuffle,repeated}|delete_shuffle(Props1)]
	    end
    end.

get_shuffle(Props) ->
    get_prop([shuffle], ?now, Props).

delete_shuffle(Props) ->
    delete_prop([shuffle], Props).

%% Return {Item,Value} if found, else if Item alone
%% is found, return {Item,Default}
get_prop([Item|Items], Default, Props) ->
    case lists:keysearch(Item, 1, Props) of
	{value,R} ->
	    R;
	false ->
	    case lists:member(Item, Props) of
		true ->
		    {Item,Default};
		false ->
		    get_prop(Items, Default, Props)
	    end
    end;
get_prop([], _Def, _Props) ->
    undefined.

delete_prop([Item|Items], Props) ->
    Props1 = lists:delete(Item, lists:keydelete(Item, 1, Props)),
    delete_prop(Items, Props1);
delete_prop([], Props) ->
    Props.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% shuffle_cases(Ref, Cases, Seed) -> Cases1
%%
%% Shuffles the order of Cases.

shuffle_cases(Ref, Cases, undefined) ->
    shuffle_cases(Ref, Cases, ?now);

shuffle_cases(Ref, [{conf,Ref,_,_}=Start | Cases], Seed) ->
    {N,CasesToShuffle,Rest} = cases_to_shuffle(Ref, Cases),
    ShuffledCases = random_order(N, random:uniform_s(N, Seed), CasesToShuffle, []),
    [Start|ShuffledCases] ++ Rest.

cases_to_shuffle(Ref, Cases) ->
    cases_to_shuffle(Ref, Cases, 1, []).

cases_to_shuffle(Ref, [{conf,Ref,_,_} | _]=Cs, N, Ix) ->          % end
    {N-1,Ix,Cs};
cases_to_shuffle(Ref, [{skip_case,{_,Ref,_,_},_} | _]=Cs, N, Ix) -> % end
    {N-1,Ix,Cs};

cases_to_shuffle(Ref, [{conf,Ref1,_,_}=C | Cs], N, Ix) ->          % nested group
    {Cs1,Rest} = get_subcases(Ref1, Cs, []),
    cases_to_shuffle(Ref, Rest, N+1, [{N,[C|Cs1]} | Ix]);
cases_to_shuffle(Ref, [{skip_case,{_,Ref1,_,_},_}=C | Cs], N, Ix) -> % nested group
    {Cs1,Rest} = get_subcases(Ref1, Cs, []),
    cases_to_shuffle(Ref, Rest, N+1, [{N,[C|Cs1]} | Ix]);

cases_to_shuffle(Ref, [C | Cs], N, Ix) ->
    cases_to_shuffle(Ref, Cs, N+1, [{N,[C]} | Ix]).

get_subcases(SubRef, [{conf,SubRef,_,_}=C | Cs], SubCs) ->
    {lists:reverse([C|SubCs]),Cs};
get_subcases(SubRef, [{skip_case,{_,SubRef,_,_},_}=C | Cs], SubCs) ->
    {lists:reverse([C|SubCs]),Cs};
get_subcases(SubRef, [C|Cs], SubCs) ->
    get_subcases(SubRef, Cs, [C|SubCs]).

random_order(1, {_Pos,Seed}, [{_Ix,CaseOrGroup}], Shuffled) ->
    %% save current seed to be used if test cases are repeated
    put(test_server_curr_random_seed, Seed),
    Shuffled++CaseOrGroup;
random_order(N, {Pos,NewSeed}, IxCases, Shuffled) ->
    {First,[{_Ix,CaseOrGroup}|Rest]} = lists:split(Pos-1, IxCases),
    random_order(N-1, random:uniform_s(N-1, NewSeed),
		 First++Rest, Shuffled++CaseOrGroup).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% skip_case(Type, Ref, CaseNum, Case, Comment, SendSync) -> {Mod,Func}
%%
%% Prints info about a skipped case in the major and html log files.
%% SendSync determines if start and finished messages must be sent so
%% that the printouts can be buffered and handled in order with io from
%% parallel processes.
skip_case(Type, Ref, CaseNum, Case, Comment, SendSync, Mode) ->
    MF = {Mod,Func} = case Case of
			  {M,F,_A} -> {M,F};
			  {M,F} -> {M,F}
		      end,
    if SendSync ->
	    queue_test_case_io(Ref, self(), CaseNum, Mod, Func),
	    self() ! {started,Ref,self(),CaseNum,Mod,Func},
	    test_server_io:start_transaction(),
	    skip_case1(Type, CaseNum, Mod, Func, Comment, Mode),
	    test_server_io:end_transaction(),
	    self() ! {finished,Ref,self(),CaseNum,Mod,Func,skipped,{0,skipped,[]}};
       not SendSync ->
	    skip_case1(Type, CaseNum, Mod, Func, Comment, Mode)
    end,
    MF.

skip_case1(Type, CaseNum, Mod, Func, Comment, Mode) ->
    {{Col0,Col1},_} = get_font_style((CaseNum > 0), Mode),
    ResultCol = if Type == auto -> ?auto_skip_color;
		   Type == user -> ?user_skip_color
		end,
    print(major, "~n=case          ~w:~w", [Mod,Func]),
    GroupName =	case get_name(Mode) of
		    undefined ->
			"";
		    GrName ->
			GrName1 = cast_to_list(GrName),
			print(major, "=group_props   ~p", [[{name,GrName1}]]),
			GrName1
		end,
    print(major, "=started       ~s", [lists:flatten(timestamp_get(""))]),
    Comment1 = reason_to_string(Comment),
    if Type == auto ->
	    print(major, "=result        auto_skipped: ~ts", [Comment1]);
       Type == user ->
	    print(major, "=result        skipped: ~ts", [Comment1])
    end,
    if CaseNum == 0 ->
	    print(2,"*** Skipping ~w ***", [{Mod,Func}]);
       true ->
	    print(2,"*** Skipping test case #~w ~w ***", [CaseNum,{Mod,Func}])
    end,
    TR = xhtml("<tr valign=\"top\">", ["<tr class=\"",odd_or_even(),"\">"]),	       
    GroupName =	case get_name(Mode) of
		    undefined -> "";
		    Name      -> cast_to_list(Name)
		end,
    print(html,
	  TR ++ "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>"
	  "<td>" ++ Col0 ++ "~w" ++ Col1 ++ "</td>"
	  "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>"
	  "<td>" ++ Col0 ++ "~w" ++ Col1 ++ "</td>"
	  "<td>" ++ Col0 ++ "< >" ++ Col1 ++ "</td>"
	  "<td>" ++ Col0 ++ "0.000s" ++ Col1 ++ "</td>"
	  "<td><font color=\"~ts\">SKIPPED</font></td>"
	  "<td>~ts</td></tr>\n",
	  [num2str(CaseNum),fw_name(Mod),GroupName,Func,ResultCol,Comment1]),

    if CaseNum > 0 ->
	    {US,AS} = get(test_server_skipped),
	    case Type of
		user -> put(test_server_skipped, {US+1,AS});
		auto -> put(test_server_skipped, {US,AS+1})
	    end,
	    put(test_server_case_num, CaseNum);
       true ->					% conf
	    ok
    end.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% skip_cases_upto(Ref, Cases, Reason, Origin, Mode, SkipType) -> Cases1
%%
%% SkipType = skip_case | auto_skip_case
%% Mark all cases tagged with Ref as skipped.

skip_cases_upto(Ref, Cases, Reason, Origin, Mode, SkipType) ->    
    {_,Modified,Rest} =
	modify_cases_upto(Ref, {skip,Reason,Origin,Mode,SkipType}, Cases),
    Modified++Rest.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% copy_cases(OrigRef, NewRef, Cases) -> Cases1
%%
%% Copy the test cases marked with OrigRef and tag the copies with NewRef.
%% The start conf case copy will also get its repeat property updated.

copy_cases(OrigRef, NewRef, Cases) ->
    {Original,Altered,Rest} = modify_cases_upto(OrigRef, {copy,NewRef}, Cases),
    {Altered,Original++Altered++Rest}.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% modify_cases_upto(Ref, ModOp, Cases) -> {Original,Altered,Remaining}
%%
%% ModOp = {skip,Reason,Origin,Mode} | {copy,NewRef}
%% Origin = conf | tc
%%
%% Modifies Cases according to ModOp and returns the original elements,
%% the modified versions of these elements and the remaining (untouched)
%% cases.

modify_cases_upto(Ref, ModOp, Cases) ->
    {Original,Altered,Rest} = modify_cases_upto(Ref, ModOp, Cases, [], []),
    {lists:reverse(Original),lists:reverse(Altered),Rest}.

%% first case of a copy operation is the start conf
modify_cases_upto(Ref, {copy,NewRef}=Op, [{conf,Ref,Props,MF}=C|T], Orig, Alt) ->
    modify_cases_upto(Ref, Op, T, [C|Orig], [{conf,NewRef,update_repeat(Props),MF}|Alt]);

modify_cases_upto(Ref, ModOp, Cases, Orig, Alt) ->
    %% we need to check if there's an end conf case with the
    %% same ref in the list, if not, this *is* an end conf case
    case lists:any(fun({_,R,_,_}) when R == Ref -> true;
		      ({_,R,_})   when R == Ref -> true;
		      ({skip_case,{_,R,_,_},_}) when R == Ref -> true;
		      ({skip_case,{_,R,_,_}}) when R == Ref -> true;
		      (_) -> false
		   end, Cases) of
	true ->
	    modify_cases_upto1(Ref, ModOp, Cases, Orig, Alt);
	false ->
	    {[],[],Cases}
    end.

%% next case is a conf with same ref, must be end conf = we're done
modify_cases_upto1(Ref, {skip,Reason,conf,Mode,skip_case},
		   [{conf,Ref,_Props,MF}|T], Orig, Alt) ->
    {Orig,[{skip_case,{conf,Ref,MF,Reason},Mode}|Alt],T};
modify_cases_upto1(Ref, {skip,Reason,conf,Mode,auto_skip_case},
		   [{conf,Ref,_Props,MF}|T], Orig, Alt) ->
    {Orig,[{auto_skip_case,{conf,Ref,MF,Reason},Mode}|Alt],T};
modify_cases_upto1(Ref, {copy,NewRef}, [{conf,Ref,Props,MF}=C|T], Orig, Alt) ->
    {[C|Orig],[{conf,NewRef,update_repeat(Props),MF}|Alt],T};

%% we've skipped all remaining cases in a sequence
modify_cases_upto1(Ref, {skip,_,tc,_,_},
		   [{conf,Ref,_Props,_MF}|_]=Cs, Orig, Alt) ->
    {Orig,Alt,Cs};

%% next is a make case
modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType},
		   [{make,Ref,MF}|T], Orig, Alt) ->
    {Orig,[{SkipType,{make,Ref,MF,Reason},Mode}|Alt],T};
modify_cases_upto1(Ref, {copy,NewRef}, [{make,Ref,MF}=M|T], Orig, Alt) ->
    {[M|Orig],[{make,NewRef,MF}|Alt],T};

%% next case is a user skipped end conf with the same ref = we're done
modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType},
		   [{skip_case,{Type,Ref,MF,_Cmt},_}|T], Orig, Alt) ->
    {Orig,[{SkipType,{Type,Ref,MF,Reason},Mode}|Alt],T};
modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType},
		   [{skip_case,{Type,Ref,MF,_Cmt}}|T], Orig, Alt) ->
    {Orig,[{SkipType,{Type,Ref,MF,Reason},Mode}|Alt],T};
modify_cases_upto1(Ref, {copy,NewRef},
		   [{skip_case,{Type,Ref,MF,Cmt},Mode}=C|T], Orig, Alt) ->
    {[C|Orig],[{skip_case,{Type,NewRef,MF,Cmt},Mode}|Alt],T};
modify_cases_upto1(Ref, {copy,NewRef},
		   [{skip_case,{Type,Ref,MF,Cmt}}=C|T], Orig, Alt) ->
    {[C|Orig],[{skip_case,{Type,NewRef,MF,Cmt}}|Alt],T};

%% next is a skip_case, could be one test case or 'all' in suite, we must proceed
modify_cases_upto1(Ref, ModOp, [{skip_case,{_F,_Cmt},_Mode}=MF|T], Orig, Alt) ->
    modify_cases_upto1(Ref, ModOp, T, [MF|Orig], [MF|Alt]);

%% next is a normal case (possibly in a sequence), mark as skipped, or copy, and proceed
modify_cases_upto1(Ref, {skip,Reason,_,Mode,skip_case}=Op,
		   [{_M,_F}=MF|T], Orig, Alt) ->
    modify_cases_upto1(Ref, Op, T, Orig, [{skip_case,{MF,Reason},Mode}|Alt]);
modify_cases_upto1(Ref, {skip,Reason,_,Mode,auto_skip_case}=Op,
		   [{_M,_F}=MF|T], Orig, Alt) ->
    modify_cases_upto1(Ref, Op, T, Orig, [{auto_skip_case,{MF,Reason},Mode}|Alt]);
modify_cases_upto1(Ref, CopyOp, [{_M,_F}=MF|T], Orig, Alt) ->
    modify_cases_upto1(Ref, CopyOp, T, [MF|Orig], [MF|Alt]);

%% next is a conf case, modify the Mode arg to keep track of sub groups
modify_cases_upto1(Ref, {skip,Reason,FType,Mode,SkipType},
		   [{conf,OtherRef,Props,_MF}|T], Orig, Alt) ->
    case hd(Mode) of
	{OtherRef,_,_} ->			% end conf
	    modify_cases_upto1(Ref, {skip,Reason,FType,tl(Mode),SkipType},
			       T, Orig, Alt);
	_ ->					% start conf
	    Mode1 = [conf(OtherRef,Props)|Mode],
	    modify_cases_upto1(Ref, {skip,Reason,FType,Mode1,SkipType},
			       T, Orig, Alt)
    end;

%% next is some other case, ignore or copy
modify_cases_upto1(Ref, {skip,_,_,_,_}=Op, [_Other|T], Orig, Alt) ->
    modify_cases_upto1(Ref, Op, T, Orig, Alt);
modify_cases_upto1(Ref, CopyOp, [C|T], Orig, Alt) ->
    modify_cases_upto1(Ref, CopyOp, T, [C|Orig], [C|Alt]).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% set_io_buffering(IOHandler) -> PrevIOHandler
%%
%% Save info about current process (always the main process) buffering
%% io printout messages from parallel test case processes (*and* possibly
%% also the main process).

set_io_buffering(IOHandler) ->
    put(test_server_common_io_handler, IOHandler).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% is_io_buffered() -> true|false
%%
%% Test whether is being buffered.

is_io_buffered() ->
    get(test_server_common_io_handler) =/= undefined.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% queue_test_case_io(Pid, Num, Mod, Func) -> ok
%%
%% Save info about test case that gets its io buffered. This can
%% be a parallel test case or it can be a test case (conf or normal)
%% that belongs to a group nested under a parallel group. The queue
%% is processed after io buffering is disabled. See run_test_cases_loop/4
%% and handle_test_case_io_and_status/0 for more info.

queue_test_case_io(Ref, Pid, Num, Mod, Func) ->
    Entry = {Ref,Pid,Num,Mod,Func},
    %% the order of the test cases is very important!
    put(test_server_queued_io,
	get(test_server_queued_io)++[Entry]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% wait_for_cases(Ref) -> {Ok,Skipped,Failed}
%%
%% At the end of a nested parallel group, we have to wait for the test
%% cases to terminate before we can go on (since test cases never execute
%% in parallel with the end conf case of the group). When a top level
%% parallel group is finished, buffered io messages must be handled and
%% this is taken care of by handle_test_case_io_and_status/0.

wait_for_cases(Ref) ->
    case get(test_server_queued_io) of
	[] ->
	    {[],[],[]};
	Cases ->
	    [_Start|TCs] =
		lists:dropwhile(fun({R,_,_,_,_}) when R == Ref -> false;
				   (_) -> true
				end, Cases),
	    wait_and_resend(Ref, TCs, [],[],[])
    end.

wait_and_resend(Ref, [{OtherRef,_,0,_,_}|Ps],
		Ok,Skip,Fail) when is_reference(OtherRef),
				   OtherRef /= Ref ->
    %% ignore cases that belong to nested group
    Ps1 = rm_cases_upto(OtherRef, Ps),
    wait_and_resend(Ref, Ps1, Ok,Skip,Fail);

wait_and_resend(Ref, [{_,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) ->
    receive
	{finished,_Ref,CurrPid,CaseNum,Mod,Func,Result,_RetVal} = Msg ->
	    %% resend message to main process so that it can be used
	    %% to test_server_io:print_buffered/1 later
	    self() ! Msg,
	    MF = {Mod,Func},
	    {Ok1,Skip1,Fail1} =
		case Result of
		    ok -> {[MF|Ok],Skip,Fail};
		    skipped -> {Ok,[MF|Skip],Fail};
		    failed -> {Ok,Skip,[MF|Fail]}
		end,
	    wait_and_resend(Ref, Ps, Ok1,Skip1,Fail1);
	{'EXIT',CurrPid,Reason} when Reason /= normal ->
	    %% unexpected termination of test case process
	    {value,{_,_,CaseNum,Mod,Func}} = lists:keysearch(CurrPid, 2, Cases),
	    print(1, "Error! Process for test case #~w (~w:~w) died! Reason: ~p",
		  [CaseNum, Mod, Func, Reason]),
	    exit({unexpected_termination,{CaseNum,Mod,Func},{CurrPid,Reason}})
    end;

wait_and_resend(_, [], Ok,Skip,Fail) ->
    {lists:reverse(Ok),lists:reverse(Skip),lists:reverse(Fail)}.

rm_cases_upto(Ref, [{Ref,_,0,_,_}|Ps]) ->
    Ps;
rm_cases_upto(Ref, [_|Ps]) ->
    rm_cases_upto(Ref, Ps).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_test_case_io_and_status() -> [Ok,Skipped,Failed}
%%
%% Each parallel test case process prints to its own minor log file during
%% execution. The common log files (major, html etc) must however be
%% written to sequentially. This is handled by calling
%% test_server_io:start_transaction/0 to tell the test_server_io process
%% to buffer all print requests.
%%
%% An io session is always started with a
%% {started,Ref,Pid,Num,Mod,Func} message (and
%% test_server_io:start_transaction/0 will be called) and terminated
%% with {finished,Ref,Pid,Num,Mod,Func,Result,RetVal} (and
%% test_server_io:end_transaction/0 will be called).  The result
%% shipped with the finished message from a parallel process is used
%% to update status data of the current test run. An 'EXIT' message
%% from each parallel test case process (after finishing and
%% terminating) is also received and handled here.
%%
%% During execution of a parallel group, any cases (conf or normal)
%% belonging to a nested group will also get its io printouts buffered.
%% This is necessary to get the major and html log files written in
%% correct sequence. This function handles also the print messages
%% generated by nested group cases that have been executed sequentially
%% by the main process (note that these cases do not generate 'EXIT'
%% messages, only 'start' and 'finished' messages).
%%
%% See the header comment for run_test_cases_loop/4 for more
%% info about IO handling.
%%
%% Note: It is important that the type of messages handled here
%% do not get consumed by test_server:run_test_case_msgloop/5
%% during the test case execution (e.g. in the catch clause of
%% the receive)!

handle_test_case_io_and_status() ->
    case get(test_server_queued_io) of
	[] ->
	    {[],[],[]};
	Cases ->
	    %% Cases = [{Ref,Pid,CaseNum,Mod,Func} | ...]
	    Result = handle_io_and_exit_loop([], Cases, [],[],[]),
	    Main = self(),
	    %% flush normal exit messages
	    lists:foreach(fun({_,Pid,_,_,_}) when Pid /= Main ->
				  receive
				      {'EXIT',Pid,normal} -> ok
				  after
				      1000 -> ok
				  end;
			     (_) ->
				  ok
		  end, Cases),
	    Result
    end.

%% Handle cases (without Ref) that belong to the top parallel group (i.e. when Refs = [])
handle_io_and_exit_loop([], [{undefined,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) ->
    %% retrieve the start message for the current io session (= testcase)
    receive
	{started,_,CurrPid,CaseNum,Mod,Func} ->
	    {Ok1,Skip1,Fail1} =
		case handle_io_and_exits(self(), CurrPid, CaseNum, Mod, Func, Cases) of
		    {ok,MF} -> {[MF|Ok],Skip,Fail};
		    {skipped,MF} -> {Ok,[MF|Skip],Fail};
		    {failed,MF} -> {Ok,Skip,[MF|Fail]}
		end,
	    handle_io_and_exit_loop([], Ps, Ok1,Skip1,Fail1)
    after
	1000 ->
	    exit({testcase_failed_to_start,Mod,Func})
    end;

%% Handle cases that belong to groups nested under top parallel group
handle_io_and_exit_loop(Refs, [{Ref,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) ->
    receive
	{started,_,CurrPid,CaseNum,Mod,Func} ->
	    handle_io_and_exits(self(), CurrPid, CaseNum, Mod, Func, Cases),
	    Refs1 =
		case Refs of
		    [Ref|Rs] ->	                % must be end conf case for subgroup
			Rs;
		    _ when is_reference(Ref) -> % must be start of new subgroup
			[Ref|Refs];
		    _ -> 			% must be normal subgroup testcase
			Refs
		end,
	    handle_io_and_exit_loop(Refs1, Ps, Ok,Skip,Fail)
    after
	1000 ->
	    exit({testcase_failed_to_start,Mod,Func})
    end;

handle_io_and_exit_loop(_, [], Ok,Skip,Fail) ->
    {lists:reverse(Ok),lists:reverse(Skip),lists:reverse(Fail)}.

handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) ->
    receive
	{abort_current_testcase=Tag,_Reason,From} ->
	    %% If a parallel group is executing, there is no unique
	    %% current test case, so we must generate an error.
	    From ! {self(),Tag,{error,parallel_group}},
	    handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases);
	%% end of io session from test case executed by main process
	{finished,_,Main,CaseNum,Mod,Func,Result,_RetVal} ->
	    test_server_io:print_buffered(CurrPid),
	    {Result,{Mod,Func}};
	%% end of io session from test case executed by parallel process
	{finished,_,CurrPid,CaseNum,Mod,Func,Result,RetVal} ->
	    test_server_io:print_buffered(CurrPid),
	    case Result of
		ok ->
		    put(test_server_ok, get(test_server_ok)+1);
		failed ->
		    put(test_server_failed, get(test_server_failed)+1);
		skipped ->
		    SkipCounters =
			update_skip_counters(RetVal, get(test_server_skipped)),
		    put(test_server_skipped, SkipCounters)
	    end,
	    {Result,{Mod,Func}};

	%% unexpected termination of test case process
	{'EXIT',TCPid,Reason} when Reason /= normal ->
	    test_server_io:print_buffered(CurrPid),
	    {value,{_,_,Num,M,F}} = lists:keysearch(TCPid, 2, Cases),
	    print(1, "Error! Process for test case #~w (~w:~w) died! Reason: ~p",
		  [Num, M, F, Reason]),
	    exit({unexpected_termination,{Num,M,F},{TCPid,Reason}})
    end.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% run_test_case(Ref, Num, Mod, Func, Args, RunInit,
%%               TimetrapData, Mode) -> RetVal
%%
%% Creates the minor log file and inserts some test case specific headers
%% and footers into the log files. Then the test case is executed and the
%% result is printed to the log files (also info about lingering processes
%% & slave nodes in the system is presented).
%%
%% RunInit decides if the per test case init is to be run (true for all
%% but conf cases).
%%
%% Mode specifies if the test case should be executed by a dedicated,
%% parallel, process rather than sequentially by the main process. If
%% the former, the new process is spawned and the dictionary of the main
%% process is copied to the test case process.
%%
%% RetVal is the result of executing the test case. It contains info
%% about the execution time and the return value of the test case function.

run_test_case(Ref, Num, Mod, Func, Args, RunInit, TimetrapData) ->
    file:set_cwd(filename:dirname(get(test_server_dir))),
    run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
		   TimetrapData, [], self()).

run_test_case(Ref, Num, Mod, Func, Args, skip_init, TimetrapData, Mode) ->
    %% a conf case is always executed by the main process
    run_test_case1(Ref, Num, Mod, Func, Args, skip_init,
		   TimetrapData, Mode, self());

run_test_case(Ref, Num, Mod, Func, Args, RunInit, TimetrapData, Mode) ->
    file:set_cwd(filename:dirname(get(test_server_dir))),
    Main = self(),
    case check_prop(parallel, Mode) of
	false ->
	    %% this is a sequential test case
	    run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
			   TimetrapData, Mode, Main);
	_Ref ->
	    %% this a parallel test case, spawn the new process
	    Dictionary = get(),
	    {dictionary,Dictionary} = process_info(self(), dictionary),
	    spawn_link(
	      fun() ->
		      process_flag(trap_exit, true),
		      [put(Key, Val) || {Key,Val} <- Dictionary],
		      set_io_buffering({tc,Main}),
		      run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
				     TimetrapData, Mode, Main)
	      end)
    end.

run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
	       TimetrapData, Mode, Main) ->
    group_leader(test_server_io:get_gl(Main == self()), self()),

    %% if io is being buffered, send start io session message
    %% (no matter if case runs on parallel or main process)
    case is_io_buffered() of
	false -> ok;
	true ->
	    test_server_io:start_transaction(),
	    Main ! {started,Ref,self(),Num,Mod,Func}
    end,
    TSDir = get(test_server_dir),

    print(major, "=case          ~w:~w", [Mod, Func]),
    MinorName = start_minor_log_file(Mod, Func, self() /= Main),
    MinorBase = filename:basename(MinorName),
    print(major, "=logfile       ~ts", [filename:basename(MinorName)]),

    UpdatedArgs =
	%% maybe create unique private directory for test case or config func
	case get(test_server_create_priv_dir) of
	    auto_per_run ->
		update_config(hd(Args), [{tc_logfile,MinorName}]);
	    PrivDirMode ->
		%% create unique private directory for test case
		RunDir = filename:dirname(MinorName),
		Ext =
		    if Num == 0 ->
			    Int = erlang:unique_integer([positive,monotonic]),
			    lists:flatten(io_lib:format(".cfg.~w", [Int]));
		       true ->
			    lists:flatten(io_lib:format(".~w", [Num]))
		    end,
		PrivDir = filename:join(RunDir, ?priv_dir) ++ Ext,
		if PrivDirMode == auto_per_tc ->
			ok = file:make_dir(PrivDir);
		   PrivDirMode == manual_per_tc ->
			ok
		end,
		update_config(hd(Args), [{priv_dir,PrivDir++"/"},
					 {tc_logfile,MinorName}])
	end,
    GrName = get_name(Mode),
    test_server_sup:framework_call(report,
				   [tc_start,{{Mod,{Func,GrName}},
					      MinorName}]),

    {ok,Cwd} = file:get_cwd(),
    Args2Print = if is_list(UpdatedArgs) ->
			 lists:keydelete(tc_group_result, 1, UpdatedArgs);
		     true ->
			 UpdatedArgs
		 end,
    if RunInit == skip_init ->
	    print_props(get_props(Mode));
       true ->
	    ok
    end,

    print(minor,
	  escape_chars(io_lib:format("Config value:\n\n    ~tp\n", [Args2Print])),
	  []),
    print(minor, "Current directory is ~tp\n", [Cwd]),

    GrNameStr =	case GrName of
		    undefined -> "";
		    Name      -> cast_to_list(Name)
		end,
    print(major, "=started       ~s", [lists:flatten(timestamp_get(""))]),
    {{Col0,Col1},Style} = get_font_style((RunInit==run_init), Mode),
    TR = xhtml("<tr valign=\"top\">", ["<tr class=\"",odd_or_even(),"\">"]),
    EncMinorBase = uri_encode(MinorBase),
    print(html,	TR ++ "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>"
	  "<td>" ++ Col0 ++ "~w" ++ Col1 ++ "</td>"
	  "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>"
	  "<td><a href=\"~ts\">~w</a></td>"
	  "<td><a href=\"~ts#top\">&lt;</a> <a href=\"~ts#end\">&gt;</a></td>",
	  [num2str(Num),fw_name(Mod),GrNameStr,EncMinorBase,Func,
	   EncMinorBase,EncMinorBase]),

    do_unless_parallel(Main, fun erlang:yield/0),

    %% run the test case
    {Result,DetectedFail,ProcsBefore,ProcsAfter} =
	run_test_case_apply(Num, Mod, Func, [UpdatedArgs], GrName,
			    RunInit, TimetrapData),
    {Time,RetVal,Loc,Opts,Comment} =
	case Result of
	    Normal={_Time,_RetVal,_Loc,_Opts,_Comment} -> Normal;
	    {died,DReason,DLoc,DCmt} -> {died,DReason,DLoc,[],DCmt}
	end,

    print(minor, "<a name=\"end\"></a>", [], internal_raw),
    print(minor, "\n", [], internal_raw),
    print_timestamp(minor, "Ended at "),
    print(major, "=ended         ~s", [lists:flatten(timestamp_get(""))]),

    do_unless_parallel(Main, fun() -> file:set_cwd(filename:dirname(TSDir)) end),

    %% call the appropriate progress function clause to print the results to log
    Status =
	case {Time,RetVal} of
	    {died,{timetrap_timeout,TimetrapTimeout}} ->
		progress(failed, Num, Mod, Func, GrName, Loc,
			 timetrap_timeout, TimetrapTimeout, Comment, Style);
	    {died,Reason} ->
		progress(failed, Num, Mod, Func, GrName, Loc, Reason,
			 Time, Comment, Style);
	    {_,{'EXIT',{Skip,Reason}}} when Skip==skip; Skip==skipped;
					    Skip==auto_skip ->
		progress(skip, Num, Mod, Func, GrName, Loc, Reason,
			 Time, Comment, Style);
	    {_,{'EXIT',_Pid,{Skip,Reason}}} when Skip==skip; Skip==skipped ->
		progress(skip, Num, Mod, Func, GrName, Loc, Reason,
			 Time, Comment, Style);
	    {_,{'EXIT',_Pid,Reason}} ->
		progress(failed, Num, Mod, Func, GrName, Loc, Reason,
			 Time, Comment, Style);
	    {_,{'EXIT',Reason}} ->
		progress(failed, Num, Mod, Func, GrName, Loc, Reason,
			 Time, Comment, Style);
	    {_,{Fail,Reason}} when Fail =:= fail; Fail =:= failed ->
		progress(failed, Num, Mod, Func, GrName, Loc, Reason,
			 Time, Comment, Style);
	    {_,Reason={auto_skip,_Why}} ->
		progress(skip, Num, Mod, Func, GrName, Loc, Reason,
			 Time, Comment, Style);		
	    {_,{Skip,Reason}} when Skip==skip; Skip==skipped ->
		progress(skip, Num, Mod, Func, GrName, Loc, Reason,
			 Time, Comment, Style);
	    {Time,RetVal} ->
		case DetectedFail of
		    [] ->
			progress(ok, Num, Mod, Func, GrName, Loc, RetVal,
				 Time, Comment, Style);

		    Reason ->
			progress(failed, Num, Mod, Func, GrName, Loc, Reason,
				 Time, Comment, Style)
		end
	end,
    %% if the test case was executed sequentially, this updates the
    %% status count on the main process (status of parallel test cases
    %% is updated later by the handle_test_case_io_and_status/0 function)
    case {RunInit,Status} of
	{skip_init,_} ->			% conf doesn't count
	    ok;
	{_,ok} ->
	    put(test_server_ok, get(test_server_ok)+1);
	{_,failed} ->
	    put(test_server_failed, get(test_server_failed)+1);
	{_,skip} ->
	    {US,AS} = get(test_server_skipped),
	    put(test_server_skipped, {US+1,AS});
	{_,auto_skip} ->
	    {US,AS} = get(test_server_skipped),
	    put(test_server_skipped, {US,AS+1})
    end,
    %% only if test case execution is sequential do we care about the
    %% remaining processes and slave nodes count
    case self() of
	Main ->
	    case test_server_sup:framework_call(warn, [processes], true) of
		true ->
		    if ProcsBefore < ProcsAfter ->
			    print(minor,
				  "WARNING: ~w more processes in system after test case",
				  [ProcsAfter-ProcsBefore]);
		       ProcsBefore > ProcsAfter ->
			    print(minor,
				  "WARNING: ~w less processes in system after test case",
				  [ProcsBefore-ProcsAfter]);
		       true -> ok
		    end;
		false ->
		    ok
	    end,
	    case test_server_sup:framework_call(warn, [nodes], true) of
		true ->
		    case catch controller_call(kill_slavenodes) of
			{'EXIT',_} = Exit ->
			    print(minor,
				  "WARNING: There might be slavenodes left in the"
				  " system. I tried to kill them, but I failed: ~p\n",
				  [Exit]);
			[] -> ok;
			List ->
			    print(minor, "WARNING: ~w slave nodes in system after test"++
				  "case. Tried to killed them.~n"++
				  "         Names:~p",
				  [length(List),List])
		    end;
		false ->
		    ok
	    end;
	_ ->
	    ok
    end,
    %% if the test case was executed sequentially, this updates the execution
    %% time count on the main process (adding execution time of parallel test
    %% case groups is done in run_test_cases_loop/4)
    if is_number(Time) ->
	    put(test_server_total_time, get(test_server_total_time)+Time);
       true ->
	    ok
    end,
    test_server_sup:check_new_crash_dumps(),

    %% if io is being buffered, send finished message
    %% (no matter if case runs on parallel or main process)
    case is_io_buffered() of
	false ->
	    ok;
	true ->
	    test_server_io:end_transaction(),
	    Main ! {finished,Ref,self(),Num,Mod,Func,
		    ?mod_result(Status),{Time,RetVal,Opts}}
    end,
    {Time,RetVal,Opts}.


%%--------------------------------------------------------------------
%% various help functions

%% Call Action if we are running on the main process (not parallel).
do_unless_parallel(Main, Action) when is_function(Action, 0) ->
    case self() of
	Main -> Action();
	_ -> ok
    end.

num2str(0) -> "";
num2str(N) -> integer_to_list(N).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% progress(Result, CaseNum, Mod, Func, Location, Reason, Time,
%%	    Comment, TimeFormat) -> Result
%%
%% Prints the result of the test case to log file.
%% Note: Strings that are to be written to the minor log must
%% be prefixed with "=== " here, or the indentation will be wrong.

progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time,
	 Comment, {St0,St1}) ->
    {Reason1,{Color,Ret,ReportTag}} = 
	if_auto_skip(Reason,
		     fun() -> {?auto_skip_color,auto_skip,auto_skipped} end,
		     fun() -> {?user_skip_color,skip,skipped} end),
    print(major, "=result        ~w: ~p", [ReportTag,Reason1]),
    print(1, "*** SKIPPED ~ts ***",
	  [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
    test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},
						     {ReportTag,Reason1}}]),
    ReasonStr = escape_chars(reason_to_string(Reason1)),
    ReasonStr1 = lists:flatten([string:strip(S,left) ||
				S <- string:tokens(ReasonStr,[$\n])]),
    ReasonStr2 =
	if length(ReasonStr1) > 80 ->
		string:substr(ReasonStr1, 1, 77) ++ "...";
	   true ->
		ReasonStr1
	end,
    Comment1 = case Comment of
		   "" -> "";
		   _ -> xhtml("<br>(","<br />(") ++ to_string(Comment) ++ ")"
	       end,
    print(html,
	  "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>"
	  "<td><font color=\"~ts\">SKIPPED</font></td>"
	  "<td>~ts~ts</td></tr>\n",
	  [Time,Color,ReasonStr2,Comment1]),
    FormatLoc = test_server_sup:format_loc(Loc),
    print(minor, "=== Location: ~ts", [FormatLoc]),
    print(minor, "=== Reason: ~ts", [ReasonStr1]),
    Ret;

progress(failed, CaseNum, Mod, Func, GrName, Loc, timetrap_timeout, T,
	 Comment0, {St0,St1}) ->
    print(major, "=result        failed: timeout, ~p", [Loc]),
    print(1, "*** FAILED ~ts ***",
	  [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
    test_server_sup:framework_call(report,
				   [tc_done,{Mod,{Func,GrName},
					     {failed,timetrap_timeout}}]),
    FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)),
    ErrorReason = io_lib:format("{timetrap_timeout,~ts}", [FormatLastLoc]),
    Comment =
	case Comment0 of
	    "" -> "<font color=\"red\">" ++ ErrorReason ++ "</font>";
	    _ -> "<font color=\"red\">" ++ ErrorReason ++ 
		 xhtml("</font><br>","</font><br />") ++ to_string(Comment0)
	end,
    print(html,
	  "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>"
	  "<td><font color=\"red\">FAILED</font></td>"
	  "<td>~ts</td></tr>\n",
	  [T/1000,Comment]),
    FormatLoc = test_server_sup:format_loc(Loc),
    print(minor, "=== Location: ~ts", [FormatLoc]),
    print(minor, "=== Reason: timetrap timeout", []),
    failed;

progress(failed, CaseNum, Mod, Func, GrName, Loc, {testcase_aborted,Reason}, _T,
	 Comment0, {St0,St1}) ->
    print(major, "=result        failed: testcase_aborted, ~p", [Loc]),
    print(1, "*** FAILED ~ts ***",
	  [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
    test_server_sup:framework_call(report,
				   [tc_done,{Mod,{Func,GrName},
					     {failed,testcase_aborted}}]),
    FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)),
    ErrorReason = io_lib:format("{testcase_aborted,~ts}", [FormatLastLoc]),
    Comment =
	case Comment0 of
	    "" -> "<font color=\"red\">" ++ ErrorReason ++ "</font>";
	    _ -> "<font color=\"red\">" ++ ErrorReason ++ 
		 xhtml("</font><br>","</font><br />") ++ to_string(Comment0)
	end,
    print(html,
	  "<td>" ++ St0 ++ "died" ++ St1 ++ "</td>"
	  "<td><font color=\"red\">FAILED</font></td>"
	  "<td>~ts</td></tr>\n",
	  [Comment]),
    FormatLoc = test_server_sup:format_loc(Loc),
    print(minor, "=== Location: ~ts", [FormatLoc]),
    print(minor,
	  escape_chars(io_lib:format("=== Reason: {testcase_aborted,~p}",
				     [Reason])),
	  []),
    failed;

progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time,
	 Comment0, {St0,St1}) ->
    print(major, "=result        failed: ~p, ~w", [Reason,unknown_location]),
    print(1, "*** FAILED ~ts ***",
	  [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
    test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},
						     {failed,Reason}}]),
    TimeStr = io_lib:format(if is_float(Time) -> "~.3fs";
			       true -> "~w"
			    end, [Time]),
    ErrorReason = escape_chars(lists:flatten(io_lib:format("~p", [Reason]))),
    ErrorReason1 = lists:flatten([string:strip(S,left) ||
				  S <- string:tokens(ErrorReason,[$\n])]),
    ErrorReason2 =
	if length(ErrorReason1) > 63 ->
		string:substr(ErrorReason1, 1, 60) ++ "...";
	   true ->
		ErrorReason1
	end,
    Comment =
	case Comment0 of
	    "" -> "<font color=\"red\">" ++ ErrorReason2 ++ "</font>";
	    _ -> "<font color=\"red\">" ++ ErrorReason2 ++ 
		 xhtml("</font><br>","</font><br />") ++
		 to_string(Comment0)
	end,
    print(html,
	  "<td>" ++ St0 ++ "~ts" ++ St1 ++ "</td>"
	  "<td><font color=\"red\">FAILED</font></td>"
	  "<td>~ts</td></tr>\n",
	  [TimeStr,Comment]),
    print(minor, "=== Location: ~w", [unknown]),
    {FStr,FormattedReason} = format_exception(Reason),
    print(minor,
	  escape_chars(io_lib:format("=== Reason: " ++ FStr, [FormattedReason])),
	  []),
    failed;

progress(failed, CaseNum, Mod, Func, GrName, Loc, Reason, Time,
	 Comment0, {St0,St1}) ->
    {LocMaj,LocMin} = if Func == error_in_suite ->
			      case get_fw_mod(undefined) of
				  Mod -> {unknown_location,unknown};
				  _   -> {Loc,Loc}
			      end;
			 true -> {Loc,Loc}
		       end,
    print(major, "=result        failed: ~p, ~p", [Reason,LocMaj]),
    print(1, "*** FAILED ~ts ***",
	  [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
    test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},
						     {failed,Reason}}]),
    TimeStr = io_lib:format(if is_float(Time) -> "~.3fs";
			       true -> "~w"
			    end, [Time]),
    Comment =
	case Comment0 of
	    "" -> "";
	    _ -> xhtml("<br>","<br />") ++ to_string(Comment0)
	end,
    FormatLastLoc = test_server_sup:format_loc(get_last_loc(LocMaj)),
    print(html,
	  "<td>" ++ St0 ++ "~ts" ++ St1 ++ "</td>"
	  "<td><font color=\"red\">FAILED</font></td>"
	  "<td><font color=\"red\">~ts</font>~ts</td></tr>\n",
	  [TimeStr,FormatLastLoc,Comment]),
    FormatLoc = test_server_sup:format_loc(LocMin),
    print(minor, "=== Location: ~ts", [FormatLoc]),
    {FStr,FormattedReason} = format_exception(Reason),
    print(minor, "=== Reason: " ++
	      escape_chars(io_lib:format(FStr, [FormattedReason])), []),
    failed;

progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time,
	 Comment0, {St0,St1}) ->
    print(minor, "successfully completed test case", []),
    test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},ok}]),
    Comment =
	case RetVal of
	    {comment,RetComment} ->
		String = to_string(RetComment),
		HtmlCmt = test_server_sup:framework_call(format_comment,
							 [String],
							 String),
		print(major, "=result        ok: ~ts", [String]),
		"<td>" ++ HtmlCmt ++ "</td>";
	    _ ->
		print(major, "=result        ok", []),
		case Comment0 of
		    "" -> "<td></td>";
		    _ -> "<td>" ++ to_string(Comment0) ++ "</td>"
		end
	end,
    print(major, "=elapsed       ~p", [Time]),
    print(html,
	  "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>"
	  "<td><font color=\"green\">Ok</font></td>"
	  "~ts</tr>\n",
	  [Time,Comment]),
    print(minor,
	  escape_chars(io_lib:format("=== Returned value: ~tp", [RetVal])),
	  []),
    ok.

%%--------------------------------------------------------------------
%% various help functions
escape_chars(Term) when not is_list(Term), not is_binary(Term) ->
    esc_chars_in_list(io_lib:format("~tp", [Term]));
escape_chars(List = [Term | _]) when not is_list(Term), not is_integer(Term) ->
    esc_chars_in_list(io_lib:format("~tp", [List]));
escape_chars(List) ->
    esc_chars_in_list(List).

esc_chars_in_list([Bin | Io]) when is_binary(Bin) ->
    [Bin | esc_chars_in_list(Io)];
esc_chars_in_list([List | Io]) when is_list(List) ->
    [esc_chars_in_list(List) | esc_chars_in_list(Io)];
esc_chars_in_list([$< | Io]) ->
    ["&lt;" | esc_chars_in_list(Io)];
esc_chars_in_list([$> | Io]) ->
    ["&gt;" | esc_chars_in_list(Io)];
esc_chars_in_list([$& | Io]) ->
    ["&amp;" | esc_chars_in_list(Io)];
esc_chars_in_list([Char | Io]) when is_integer(Char) ->
    [Char | esc_chars_in_list(Io)];
esc_chars_in_list([]) ->
    [];
esc_chars_in_list(Bin) ->
    Bin.

get_fw_mod(Mod) ->
    case get(test_server_framework) of
	undefined ->
	    case os:getenv("TEST_SERVER_FRAMEWORK") of
		FW when FW =:= false; FW =:= "undefined" ->
		    Mod;
		FW ->
		    list_to_atom(FW)
	    end;
	'$none' -> Mod;
	FW      -> FW
    end.

fw_name(?MODULE) ->
    test_server;
fw_name(Mod) ->
    case get(test_server_framework_name) of
	undefined ->
	    case get_fw_mod(undefined) of
		undefined ->
		    Mod;
		Mod ->
		    case os:getenv("TEST_SERVER_FRAMEWORK_NAME") of
			FWName when FWName =:= false; FWName =:= "undefined" ->
			    Mod;
			FWName ->
			    list_to_atom(FWName)
		    end;
		_ ->
		    Mod
	    end;
	'$none' ->
	    Mod;
	FWName ->
	    case get_fw_mod(Mod) of
		Mod -> FWName;
		_ -> Mod
	    end	
    end.

if_auto_skip(Reason={failed,{_,init_per_testcase,_}}, True, _False) ->
    {Reason,True()};
if_auto_skip({skip,Reason={failed,{_,init_per_testcase,_}}}, True, _False) ->
    {Reason,True()};
if_auto_skip({auto_skip,Reason}, True, _False) ->
    {Reason,True()};
if_auto_skip(Reason, _True, False) ->
    {Reason,False()}.

update_skip_counters({_T,Pat,_Opts}, {US,AS}) ->
    {_,Result} = if_auto_skip(Pat, fun() -> {US,AS+1} end, fun() -> {US+1,AS} end),
    Result;    
update_skip_counters(Pat, {US,AS}) ->
    {_,Result} = if_auto_skip(Pat, fun() -> {US,AS+1} end, fun() -> {US+1,AS} end),
    Result.

get_info_str(Mod,Func, 0, _Cases) ->
    io_lib:format("~w", [{Mod,Func}]);
get_info_str(_Mod,_Func, CaseNum, unknown) ->
    "test case " ++ integer_to_list(CaseNum);
get_info_str(_Mod,_Func, CaseNum, Cases) ->
    "test case " ++ integer_to_list(CaseNum) ++
	" of " ++ integer_to_list(Cases).

print_if_known(Known, {SK,AK}, {SU,AU}) ->
    {S,A} = if Known == unknown -> {SU,AU};
	       true -> {SK,AK}
	    end,
    io_lib:format(S, A).

to_string(Term) when is_list(Term) ->
    case (catch io_lib:format("~ts", [Term])) of
	{'EXIT',_} -> lists:flatten(io_lib:format("~p", [Term]));
	String     -> lists:flatten(String)
    end;
to_string(Term) ->
    lists:flatten(io_lib:format("~p", [Term])).

get_last_loc(Loc) when is_tuple(Loc) ->
    Loc;
get_last_loc([Loc|_]) when is_tuple(Loc) ->
    [Loc];
get_last_loc(Loc) ->
    Loc.

reason_to_string({failed,{_,FailFunc,bad_return}}) ->
    atom_to_list(FailFunc) ++ " bad return value";
reason_to_string({failed,{_,FailFunc,{timetrap_timeout,_}}}) ->
    atom_to_list(FailFunc) ++ " timed out";
reason_to_string(FWInitFail = {failed,{_CB,init_tc,_Reason}}) ->
    to_string(FWInitFail);
reason_to_string({failed,{_,FailFunc,_}}) ->
    atom_to_list(FailFunc) ++ " failed";
reason_to_string(Other) ->
    to_string(Other).

%get_font_style(Prop) ->
%    {Col,St0,St1} = get_font_style1(Prop),
%    {{"<font color="++Col++">","</font>"},
%     {"<font color="++Col++">"++St0,St1++"</font>"}}.

get_font_style(NormalCase, Mode) ->
    Prop = if not NormalCase ->
		   default;
	      true ->
		   case check_prop(parallel, Mode) of
		       false ->
			   case check_prop(sequence, Mode) of
			       false ->
				   default;
			       _ ->
				   sequence
			   end;
		       _ ->
			   parallel
		   end
	   end,
    {Col,St0,St1} = get_font_style1(Prop),
    {{"<font color="++Col++">","</font>"},
     {"<font color="++Col++">"++St0,St1++"</font>"}}.

get_font_style1(parallel) ->
    {"\"darkslategray\"","<i>","</i>"};
get_font_style1(sequence) ->
%    {"\"darkolivegreen\"","",""};
    {"\"saddlebrown\"","",""};
get_font_style1(default) ->
    {"\"black\"","",""}.
%%get_font_style1(skipped) ->
%%    {"\"lightgray\"","",""}.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% format_exception({Error,Stack}) -> {CtrlSeq,Term}
%%
%% The default behaviour is that error information gets formatted
%% (like in the erlang shell) before printed to the minor log file.
%% The framework application can switch this feature off by setting
%% *its* application environment variable 'format_exception' to false.
%% It is also possible to switch formatting off by starting the
%% test_server node with init argument 'test_server_format_exception'
%% set to false.

format_exception(Reason={_Error,Stack}) when is_list(Stack) ->
    case get_fw_mod(undefined) of
	undefined ->
	    case application:get_env(test_server, format_exception) of
		{ok,false} ->
		    {"~p",Reason};
		_ ->
		    do_format_exception(Reason)
	    end;
	FW ->
	    case application:get_env(FW, format_exception) of
		{ok,false} ->
		    {"~p",Reason};
		_ ->
		    do_format_exception(Reason)
	    end
    end;
format_exception(Error) ->
    format_exception({Error,[]}).

do_format_exception(Reason={Error,Stack}) ->
    StackFun = fun(_, _, _) -> false end,
    PF = fun(Term, I) ->
		 io_lib:format("~." ++ integer_to_list(I) ++ "p", [Term])
	 end,
    case catch lib:format_exception(1, error, Error, Stack, StackFun, PF) of
	{'EXIT',_} ->
	    {"~p",Reason};
	Formatted  ->
	    Formatted1 = re:replace(Formatted, "exception error: ", "", [{return,list}]),
	    {"~ts",lists:flatten(Formatted1)}
    end.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit,
%%                     TimetrapData) ->
%%  {{Time,RetVal,Loc,Opts,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} |
%%  {{died,Reason,unknown,Comment},DetectedFail,ProcessesBefore,ProcessesAfter}
%% Name = atom()
%% Time = float()   (seconds)
%% RetVal = term()
%% Loc = term()
%% Comment = string()
%% Reason = term()
%% DetectedFail = [{File,Line}]
%% ProcessesBefore = ProcessesAfter = integer()
%%

run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit,
		    TimetrapData) ->
    test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,
				     TimetrapData}).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% 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) ->
    print(Detail, Format, []).

print(Detail, Format, Args) ->
    print(Detail, Format, Args, internal).

print(Detail, Format, Args, Printer) ->
    Msg = io_lib:format(Format, Args),
    print_or_buffer(Detail, Msg, Printer).

print_or_buffer(Detail, Msg, Printer) ->
    test_server_gl:print(group_leader(), Detail, Msg, Printer).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% print_timestamp(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) ->
    print(Detail, timestamp_get(Leader), []).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% print_who(Host, User) -> ok
%%
%% Logs who runs the suite.

print_who(Host, User) ->
    UserStr = case User of
		  "" -> "";
		  _ -> " by " ++ User
	      end,
    print(html, "Run~ts on ~ts", [UserStr,Host]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% 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,
    print_or_buffer(Detail, Str, self()).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% xhtml(BasicHtml, XHtml) -> BasicHtml | XHtml
%%
xhtml(HTML, XHTML) ->
    case get(basic_html) of
	true -> HTML;
	_ -> XHTML
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% odd_or_even() -> "odd" | "even"
%%
odd_or_even() ->
    case get(odd_or_even) of
	even ->
	    put(odd_or_even, odd),
	    "even";
	_ ->
	    put(odd_or_even, even),
	    "odd"
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timestamp_filename_get(Leader) -> string()
%% Leader = string()
%%
%% Returns a string consisting of Leader concatenated with the current
%% date and time. The resulting string is suitable as a filename.
timestamp_filename_get(Leader) ->
    timestamp_get_internal(Leader,
			   "~ts~w-~2.2.0w-~2.2.0w_~2.2.0w.~2.2.0w.~2.2.0w").

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timestamp_get(Leader) -> string()
%% Leader = string()
%%
%% Returns a string consisting of Leader concatenated with the current
%% date and time. The resulting string is suitable for display.
timestamp_get(Leader) ->
    timestamp_get_internal(Leader,
			   "~ts~w-~2.2.0w-~2.2.0w ~2.2.0w:~2.2.0w:~2.2.0w").

timestamp_get_internal(Leader, Format) ->
    {YY,MM,DD,H,M,S} = time_get(),
    io_lib:format(Format, [Leader,YY,MM,DD,H,M,S]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% time_get() -> {YY,MM,DD,H,M,S}
%% YY = integer()
%% MM = integer()
%% DD = integer()
%% H = integer()
%% M = integer()
%% S = integer()
%%
%% Returns the current Year,Month,Day,Hours,Minutes,Seconds.
%% The function checks that the date doesn't wrap while calling
%% getting the time.
time_get() ->
    {YY,MM,DD} = date(),
    {H,M,S} = time(),
    case date() of
	{YY,MM,DD} ->
	    {YY,MM,DD,H,M,S};
	_NewDay ->
	    %% date changed between call to date() and time(), try again
	    time_get()
    end.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% make_config(Config) -> NewConfig
%% Config = [{Key,Value},...]
%% NewConfig = [{Key,Value},...]
%%
%% Creates a configuration list (currently returns it's input)

make_config(Initial) ->
    Initial.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% update_config(Config, Update) -> NewConfig
%% Config = [{Key,Value},...]
%% Update = [{Key,Value},...] | {Key,Value}
%% NewConfig = [{Key,Value},...]
%%
%% Adds or replaces the key-value pairs in config with those in update.
%% Returns the updated list.

update_config(Config, {Key,Val}) ->
    case lists:keymember(Key, 1, Config) of
	true ->
	    lists:keyreplace(Key, 1, Config, {Key,Val});
	false ->
	    [{Key,Val}|Config]
    end;
update_config(Config, [Assoc|Assocs]) ->
    NewConfig = update_config(Config, Assoc),
    update_config(NewConfig, Assocs);
update_config(Config, []) ->
    Config.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% collect_cases(CurMod, TopCase, SkipList) ->
%%     BasicCaseList | {error,Reason}
%%
%% CurMod = atom()
%% TopCase = term()
%% SkipList = [term(),...]
%% BasicCaseList = [term(),...]
%%
%% Parses the given test goal(s) in TopCase, and transforms them to a
%% simple list of test cases to call, when executing the test suite.
%%
%% CurMod is the "current" module, that is, the module the last instruction
%% was read from. May be be set to 'none' initially.
%%
%% SkipList is the list of test cases to skip and requirements to deny.
%%
%% The BasicCaseList is built out of TopCase, which may be any of the
%% following terms:
%%
%% []                        Nothing is added
%% List list()               The list is decomposed, and each element is
%%                           treated according to this table
%% Case atom()               CurMod:Case(suite) is called
%% {module,Case}             CurMod:Case(suite) is called
%% {Module,Case}             Module:Case(suite) is called
%% {module,Module,Case}      Module:Case(suite) is called
%% {module,Module,Case,Args} Module:Case is called with Args as arguments
%% {dir,Dir}                 All modules *_SUITE in the named directory
%%                           are listed, and each Module:all(suite) is called
%% {dir,Dir,Pattern}         All modules <Pattern>_SUITE in the named dir
%%                           are listed, and each Module:all(suite) is called
%% {conf,InitMF,Cases,FinMF}
%% {conf,Props,InitMF,Cases,FinMF}
%%                           InitMF is placed in the BasicCaseList, then
%%                           Cases is treated according to this table, then
%%                           FinMF is placed in the BasicCaseList. InitMF
%%                           and FinMF are configuration manipulation
%%                           functions. See below.
%% {make,InitMFA,Cases,FinMFA}
%%                           InitMFA is placed in the BasicCaseList, then
%%                           Cases is treated according to this table, then
%%                           FinMFA is placed in the BasicCaseList. InitMFA
%%                           and FinMFA are make/unmake functions. If InitMFA
%%                           fails, Cases are not run.
%%
%% When a function is called, above, it means that the function is invoked
%% and the return is expected to be:
%%
%% []                        Leaf case
%% {req,ReqList}             Kept for backwards compatibility - same as []
%% {req,ReqList,Cases}       Kept for backwards compatibility -
%%                           Cases parsed recursively with collect_cases/3
%% Cases (list)              Recursively parsed with collect_cases/3
%%
%% Leaf cases are added to the BasicCaseList as Module:Case(Config). Each
%% case is checked against the SkipList. If present, a skip instruction
%% is inserted instead, which only prints the case name and the reason
%% why the case was skipped in the log files.
%%
%% Configuration manipulation functions are called with the current
%% configuration list as only argument, and are expected to return a new
%% configuration list. Such a pair of function may, for example, start a
%% server and stop it after a serie of test cases.
%%
%% SkipCases is expected to be in the format:
%%
%% Other                     Recursively parsed with collect_cases/3
%% {Mod,Comment}             Skip Mod, with Comment
%% {Mod,Funcs,Comment}       Skip listed functions in Mod with Comment
%% {Mod,Func,Comment}        Skip named function in Mod with Comment
%%
-record(cc, {mod,				% current module
	     skip}).				% skip list

collect_all_cases(Top, Skip) when is_list(Skip) ->
    Result =
	case collect_cases(Top, #cc{mod=[],skip=Skip}, []) of
	    {ok,Cases,_St} -> Cases;
	    Other          -> Other
	end,
    Result.


collect_cases([], St, _) -> {ok,[],St};
collect_cases([Case|Cs0], St0, Mode) ->
    case collect_cases(Case, St0, Mode) of
	{ok,FlatCases1,St1} ->
	    case collect_cases(Cs0, St1, Mode) of
		{ok,FlatCases2,St} ->
		    {ok,FlatCases1 ++ FlatCases2,St};
		{error,_Reason} = Error -> Error
	    end;
	{error,_Reason} = Error -> Error
    end;


collect_cases({module,Case}, St, Mode) when is_atom(Case), is_atom(St#cc.mod) ->
    collect_case({St#cc.mod,Case}, St, Mode);
collect_cases({module,Mod,Case}, St, Mode) ->
    collect_case({Mod,Case}, St, Mode);
collect_cases({module,Mod,Case,Args}, St, Mode) ->
    collect_case({Mod,Case,Args}, St, Mode);

collect_cases({dir,SubDir}, St, Mode) ->
    collect_files(SubDir, "*_SUITE", St, Mode);
collect_cases({dir,SubDir,Pattern}, St, Mode) ->
    collect_files(SubDir, Pattern++"*", St, Mode);

collect_cases({conf,InitF,CaseList,FinMF}, St, Mode) when is_atom(InitF) ->
    collect_cases({conf,[],{St#cc.mod,InitF},CaseList,FinMF}, St, Mode);
collect_cases({conf,InitMF,CaseList,FinF}, St, Mode) when is_atom(FinF) ->
    collect_cases({conf,[],InitMF,CaseList,{St#cc.mod,FinF}}, St, Mode);
collect_cases({conf,InitMF,CaseList,FinMF}, St0, Mode) ->
    collect_cases({conf,[],InitMF,CaseList,FinMF}, St0, Mode);
collect_cases({conf,Props,InitF,CaseList,FinMF}, St, Mode) when is_atom(InitF) ->
    case init_props(Props) of
	{error,_} ->
	    {ok,[],St};
	Props1 ->
	    collect_cases({conf,Props1,{St#cc.mod,InitF},CaseList,FinMF},
			  St, Mode)
    end;
collect_cases({conf,Props,InitMF,CaseList,FinF}, St, Mode) when is_atom(FinF) ->
    case init_props(Props) of
	{error,_} ->
	    {ok,[],St};
	Props1 ->
	    collect_cases({conf,Props1,InitMF,CaseList,{St#cc.mod,FinF}},
			  St, Mode)
    end;
collect_cases({conf,Props,InitMF,CaseList,FinMF} = Conf, St, Mode) ->
    case init_props(Props) of
	{error,_} ->
	    {ok,[],St};
	Props1 ->
	    Ref = make_ref(),
	    Skips = St#cc.skip,
	    Props2 = [{suite,St#cc.mod} | lists:delete(suite,Props1)],
	    Mode1 = [{Ref,Props2,undefined} | Mode],
	    case in_skip_list({St#cc.mod,Conf}, Skips) of
		{true,Comment} ->	    	           % conf init skipped
		    {ok,[{skip_case,{conf,Ref,InitMF,Comment},Mode1} |
			 [] ++ [{conf,Ref,[],FinMF}]],St};
		{true,Name,Comment} when is_atom(Name) ->  % all cases skipped
		    case collect_cases(CaseList, St, Mode1) of
			{ok,[],_St} = Empty ->
			    Empty;
			{ok,FlatCases,St1} ->
			    Cases2Skip = FlatCases ++ [{conf,Ref,
							keep_name(Props1),
							FinMF}],
			    Skipped = skip_cases_upto(Ref, Cases2Skip, Comment,
						      conf, Mode1, skip_case),
			    {ok,[{skip_case,{conf,Ref,InitMF,Comment},Mode1} |
				 Skipped],St1};
			{error,_Reason} = Error ->
			    Error
		    end;
		{true,ToSkip,_} when is_list(ToSkip) ->    % some cases skipped
		    case collect_cases(CaseList,
				       St#cc{skip=ToSkip++Skips}, Mode1) of
			{ok,[],_St} = Empty ->
			    Empty;
			{ok,FlatCases,St1} ->
			    {ok,[{conf,Ref,Props1,InitMF} |
				 FlatCases ++ [{conf,Ref,
						keep_name(Props1),
						FinMF}]],St1#cc{skip=Skips}};
			{error,_Reason} = Error ->
			    Error
		    end;
		false ->
		    case collect_cases(CaseList, St, Mode1) of
			{ok,[],_St} = Empty ->
			    Empty;
			{ok,FlatCases,St1} ->
			    {ok,[{conf,Ref,Props1,InitMF} |
				 FlatCases ++ [{conf,Ref,
						keep_name(Props1),
						FinMF}]],St1};
			{error,_Reason} = Error ->
			    Error
		    end
	    end
    end;

collect_cases({make,InitMFA,CaseList,FinMFA}, St0, Mode) ->
    case collect_cases(CaseList, St0, Mode) of
	{ok,[],_St} = Empty -> Empty;
	{ok,FlatCases,St} ->
	    Ref = make_ref(),
	    {ok,[{make,Ref,InitMFA}|FlatCases ++
		 [{make,Ref,FinMFA}]],St};
	{error,_Reason} = Error -> Error
    end;

collect_cases({Module, Cases}, St, Mode) when is_list(Cases)  ->
    case (catch collect_case(Cases, St#cc{mod=Module}, [], Mode)) of
	Result = {ok,_,_} ->
 	    Result;
 	Other ->
	    {error,Other}
     end;

collect_cases({_Mod,_Case}=Spec, St, Mode) ->
    collect_case(Spec, St, Mode);

collect_cases({_Mod,_Case,_Args}=Spec, St, Mode) ->
    collect_case(Spec, St, Mode);
collect_cases(Case, St, Mode) when is_atom(Case), is_atom(St#cc.mod) ->
    collect_case({St#cc.mod,Case}, St, Mode);
collect_cases(Other, St, _Mode) ->
    {error,{bad_subtest_spec,St#cc.mod,Other}}.

collect_case({Mod,{conf,_,_,_,_}=Conf}, St, Mode) ->
    collect_case_invoke(Mod, Conf, [], St, Mode);

collect_case(MFA, St, Mode) ->
    case in_skip_list(MFA, St#cc.skip) of
	{true,Comment} when Comment /= make_failed ->
	    {ok,[{skip_case,{MFA,Comment},Mode}],St};
	_ ->
	    case MFA of
		{Mod,Case} -> collect_case_invoke(Mod, Case, MFA, St, Mode);
		{_Mod,_Case,_Args} -> {ok,[MFA],St}
	    end
    end.

collect_case([], St, Acc, _Mode) ->
    {ok, Acc, St};

collect_case([Case | Cases], St, Acc, Mode) ->
    {ok, FlatCases, NewSt}  = collect_case({St#cc.mod, Case}, St, Mode),
    collect_case(Cases, NewSt, Acc ++ FlatCases, Mode).

collect_case_invoke(Mod, Case, MFA, St, Mode) ->
    case get_fw_mod(undefined) of
	undefined ->
	    case catch apply(Mod, Case, [suite]) of
		{'EXIT',_} ->
		    {ok,[MFA],St};
		Suite ->
		    collect_subcases(Mod, Case, MFA, St, Suite, Mode)
	    end;
	_ ->
	    Suite = test_server_sup:framework_call(get_suite,
						   [Mod,Case],
						   []),
	    collect_subcases(Mod, Case, MFA, St, Suite, Mode)
    end.

collect_subcases(Mod, Case, MFA, St, Suite, Mode) ->
    case Suite of
	[] when Case == all -> {ok,[],St};
	[] when element(1, Case) == conf -> {ok,[],St};
	[] -> {ok,[MFA],St};
%%%! --- START Kept for backwards compatibility ---
%%%! Requirements are not used
	{req,ReqList} ->
	    collect_case_deny(Mod, Case, MFA, ReqList, [], St, Mode);
	{req,ReqList,SubCases} ->
	    collect_case_deny(Mod, Case, MFA, ReqList, SubCases, St, Mode);
%%%! --- END Kept for backwards compatibility ---
	{Skip,Reason} when Skip==skip; Skip==skipped ->
	    {ok,[{skip_case,{MFA,Reason},Mode}],St};
	{error,Reason} ->
	    throw(Reason);
	SubCases ->
	    collect_case_subcases(Mod, Case, SubCases, St, Mode)
    end.

collect_case_subcases(Mod, Case, SubCases, St0, Mode) ->
    OldMod = St0#cc.mod,
    case collect_cases(SubCases, St0#cc{mod=Mod}, Mode) of
	{ok,FlatCases,St} ->
	    {ok,FlatCases,St#cc{mod=OldMod}};
	{error,Reason} ->
	    {error,{{Mod,Case},Reason}}
    end.

collect_files(Dir, Pattern, St, Mode) ->
    {ok,Cwd} = file:get_cwd(),
    Dir1 = filename:join(Cwd, Dir),
    Wc = filename:join([Dir1,Pattern++"{.erl,"++code:objfile_extension()++"}"]),
    case catch filelib:wildcard(Wc) of
	{'EXIT', Reason} ->
	    io:format("Could not collect files: ~p~n", [Reason]),
	    {error,{collect_fail,Dir,Pattern}};
	Files ->
	    %% convert to module names and remove duplicates
	    Mods = lists:foldl(fun(File, Acc) ->
				       Mod = fullname_to_mod(File),
				       case lists:member(Mod, Acc) of
					   true  -> Acc;
					   false -> [Mod | Acc]
				       end
			       end, [], Files),
	    Tests = [{Mod,all} || Mod <- lists:sort(Mods)],
	    collect_cases(Tests, St, Mode)
    end.

fullname_to_mod(Path) when is_list(Path) ->
    %% If this is called with a binary, then we are probably in +fnu
    %% mode and have found a beam file with name encoded as latin1. We
    %% will let this crash since it can not work to load such a module
    %% anyway. It should be removed or renamed!
    list_to_atom(filename:rootname(filename:basename(Path))).

collect_case_deny(Mod, Case, MFA, ReqList, SubCases, St, Mode) ->
    case {check_deny(ReqList, St#cc.skip),SubCases} of
	{{denied,Comment},_SubCases} ->
	    {ok,[{skip_case,{MFA,Comment},Mode}],St};
	{granted,[]} ->
	    {ok,[MFA],St};
	{granted,SubCases} ->
	    collect_case_subcases(Mod, Case, SubCases, St, Mode)
    end.

check_deny([Req|Reqs], DenyList) ->
    case check_deny_req(Req, DenyList) of
	{denied,_Comment}=Denied -> Denied;
	granted -> check_deny(Reqs, DenyList)
    end;
check_deny([], _DenyList) -> granted;
check_deny(Req, DenyList) -> check_deny([Req], DenyList).

check_deny_req({Req,Val}, DenyList) ->
    %%io:format("ValCheck ~p=~p in ~p\n", [Req,Val,DenyList]),
    case lists:keysearch(Req, 1, DenyList) of
	{value,{_Req,DenyVal}} when Val >= DenyVal ->
	    {denied,io_lib:format("Requirement ~p=~p", [Req,Val])};
	_ ->
	    check_deny_req(Req, DenyList)
    end;
check_deny_req(Req, DenyList) ->
    case lists:member(Req, DenyList) of
	true -> {denied,io_lib:format("Requirement ~p", [Req])};
	false -> granted
    end.

in_skip_list({Mod,{conf,Props,InitMF,_CaseList,_FinMF}}, SkipList) ->
    case in_skip_list(InitMF, SkipList) of
	{true,_} = Yes ->
	    Yes;
	_ ->
	    case proplists:get_value(name, Props) of
		undefined ->
		    false;
		Name ->
		    ToSkip =
			lists:flatmap(
			  fun({M,{conf,SProps,_,SCaseList,_},Cmt}) when
				    M == Mod ->
				  case proplists:get_value(name, SProps) of
				      all ->
					  [{M,all,Cmt}];
				      Name ->
					  case SCaseList of
					      all ->
						  [{M,all,Cmt}];
					      _ ->
						  [{M,F,Cmt} || F <- SCaseList]
					  end;
				      _ ->
					  []
				  end;
			     (_) ->
				  []
			  end, SkipList),
		    case ToSkip of
			[] ->
			    false;
			_ ->
			    case lists:keysearch(all, 2, ToSkip) of
				{value,{_,_,Cmt}} -> {true,Name,Cmt};
				_                 -> {true,ToSkip,""}
			    end
		    end
	    end
    end;

in_skip_list({Mod,Func,_Args}, SkipList) ->
    in_skip_list({Mod,Func}, SkipList);
in_skip_list({Mod,Func}, [{Mod,Funcs,Comment}|SkipList]) when is_list(Funcs) ->
    case lists:member(Func, Funcs) of
	true ->
	    {true,Comment};
	_ ->
	    in_skip_list({Mod,Func}, SkipList)
    end;
in_skip_list({Mod,Func}, [{Mod,Func,Comment}|_SkipList]) ->
    {true,Comment};
in_skip_list({Mod,_Func}, [{Mod,Comment}|_SkipList]) ->
    {true,Comment};
in_skip_list({Mod,Func}, [_|SkipList]) ->
    in_skip_list({Mod,Func}, SkipList);
in_skip_list(_, []) ->
    false.

%% remove unnecessary properties
init_props(Props) ->
    case get_repeat(Props) of
	Repeat = {_RepType,N} when N < 2 ->
	    if N == 0 ->
		    {error,{invalid_property,Repeat}};
	       true ->
		    lists:delete(Repeat, Props)
	    end;
	_ ->
	    Props
    end.

keep_name(Props) ->
    lists:filter(fun({name,_}) -> true;
		    ({suite,_}) -> true;
		    (_) -> false end, Props).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%                 Node handling functions                   %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% get_target_info() -> #target_info
%%
%% Returns a record containing system information for target

get_target_info() ->
    controller_call(get_target_info).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% start_node(SlaveName, Type, Options) ->
%%     {ok, Slave} | {error, Reason}
%%
%% Called by test_server. See test_server:start_node/3 for details

start_node(Name, Type, Options) ->
    T = 10 * ?ACCEPT_TIMEOUT * test_server:timetrap_scale_factor(),
    format(minor, "Attempt to start ~w node ~p with options ~p",
	   [Type, Name, Options]),
    case controller_call({start_node,Name,Type,Options}, T) of
	{{ok,Nodename}, Host, Cmd, Info, Warning} ->
	    format(minor,
		   "Successfully started node ~w on ~tp with command: ~ts",
		   [Nodename, Host, Cmd]),
	    format(major, "=node_start    ~w", [Nodename]),
	    case Info of
		[] -> ok;
		_ -> format(minor, Info)
	    end,
	    case Warning of
		[] -> ok;
		_ ->
		    format(1, Warning),
		    format(minor, Warning)
	    end,
	    {ok, Nodename};
	{fail,{Ret, Host, Cmd}}  ->
	    format(minor,
		   "Failed to start node ~tp on ~tp with command: ~ts~n"
		   "Reason: ~p",
		   [Name, Host, Cmd, Ret]),
	    {fail,Ret};
	{Ret, undefined, undefined} ->
	    format(minor, "Failed to start node ~tp: ~p", [Name,Ret]),
	    Ret;
	{Ret, Host, Cmd} ->
	    format(minor,
		   "Failed to start node ~tp on ~tp with command: ~ts~n"
		   "Reason: ~p",
		   [Name, Host, Cmd, Ret]),
	    Ret
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% wait_for_node(Node) -> ok | {error,timeout}
%%
%% Wait for a slave/peer node which has been started with
%% the option {wait,false}. This function returns when
%% when the new node has contacted test_server_ctrl again

wait_for_node(Slave) ->
    T = 10000 * test_server:timetrap_scale_factor(),
    case catch controller_call({wait_for_node,Slave},T) of
	{'EXIT',{timeout,_}} -> {error,timeout};
	ok -> ok
    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) ->
    controller_call({is_release_available,Release}).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% stop_node(Name) -> ok | {error,Reason}
%%
%% Clean up - test_server will stop this node

stop_node(Slave) ->
    controller_call({stop_node,Slave}).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%                        DEBUGGER INTERFACE                        %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

i() ->
    hformat("Pid", "Initial Call", "Current Function", "Reducts", "Msgs"),
    Line=lists:duplicate(27, "-"),
    hformat(Line, Line, Line, Line, Line),
    display_info(processes(), 0, 0).

p(A,B,C) ->
    pinfo(ts_pid(A,B,C)).
p(X) when is_atom(X) ->
    pinfo(whereis(X));
p({A,B,C}) ->
    pinfo(ts_pid(A,B,C));
p(X) ->
    pinfo(X).

t() ->
    t(wall_clock).
t(X) ->
    element(1, statistics(X)).

pi(Item,X) ->
    lists:keysearch(Item,1,p(X)).
pi(Item,A,B,C) ->
    lists:keysearch(Item,1,p(A,B,C)).

%% c:pid/3
ts_pid(X,Y,Z) when is_integer(X), is_integer(Y), is_integer(Z) ->
    list_to_pid("<" ++ integer_to_list(X) ++ "." ++
		integer_to_list(Y) ++ "." ++
		integer_to_list(Z) ++ ">").


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% display_info(Pids, Reductions, Messages) -> void
%% Pids = [pid(),...]
%% Reductions = integer()
%% Messaged = integer()
%%
%% Displays info, similar to c:i() about the processes in the list Pids.
%% Also counts the total number of reductions and msgs for the listed
%% processes, if called with Reductions = Messages = 0.

display_info([Pid|T], R, M) ->
    case pinfo(Pid) of
	undefined ->
	    display_info(T, R, M);
	Info ->
	    Call = fetch(initial_call, Info),
	    Curr = case fetch(current_function, Info) of
		       {Mod,F,Args} when is_list(Args) ->
			   {Mod,F,length(Args)};
		       Other ->
			   Other
		   end,
	    Reds  = fetch(reductions, Info),
	    LM = length(fetch(messages, Info)),
	    pformat(io_lib:format("~w", [Pid]),
		    io_lib:format("~w", [Call]),
		    io_lib:format("~w", [Curr]), Reds, LM),
	    display_info(T, R+Reds, M + LM)
    end;
display_info([], R, M) ->
    Line=lists:duplicate(27, "-"),
    hformat(Line, Line, Line, Line, Line),
    pformat("Total", "", "", R, M).

hformat(A1, A2, A3, A4, A5) ->
    io:format("~-10s ~-27s ~-27s ~8s ~4s~n", [A1,A2,A3,A4,A5]).

pformat(A1, A2, A3, A4, A5) ->
    io:format("~-10s ~-27s ~-27s ~8w ~4w~n", [A1,A2,A3,A4,A5]).

fetch(Key, Info) ->
    case lists:keysearch(Key, 1, Info) of
	{value, {_, Val}} ->
	    Val;
	_ ->
	    0
    end.

pinfo(P) ->
    Node = node(),
    case node(P) of
	Node ->
	    process_info(P);
	_ ->
	    rpc:call(node(P),erlang,process_info,[P])
    end.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%                   Support functions for COVER                    %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% A module is included in the cover analysis if
%% - it belongs to the tested application and is not listed in the
%%   {exclude,List} part of the App.cover file
%% - it does not belong to the application, but is listed in the
%%   {include,List} part of the App.cover file
%% - it does not belong to the application, but is listed in the
%%   {cross,[{Tag,List}]} part of the App.cover file
%%
%% The modules listed in the 'cross' part of the cover file are
%% modules that are heavily used by other tests than the one where
%% they are explicitly tested. They should then be listed as 'cross'
%% in the cover file for the test where they are used but do not
%% belong.
%%
%% After all tests are completed, the these modules can be analysed
%% with coverage data from all tests where they are compiled - see
%% cross_cover_analyse/2. The result is stored in a file called
%% cross_cover.html in the run.<timestamp> directory of the
%% test the modules belong to.
%%
%% Example:
%% If the module m1 belongs to system s1 but is heavily used also in
%% the tests for another system s2, then the cover files for the two
%% systems could be like this:
%%
%% s1.cover:
%%  {include,[m1]}.
%%
%% s2.cover:
%%  {include,[....]}. % modules belonging to system s2
%%  {cross,[{s1,[m1]}]}.
%%
%% When the tests for both s1 and s2 are completed, run
%% cross_cover_analyse(Level,[{s1,S1LogDir},{s2,S2LogDir}]), and
%% the accumulated cover data for m1 will be written to
%% S1LogDir/[run.<timestamp>/]cross_cover.html
%%
%% S1LogDir and S2LogDir are either the run.<timestamp> directories
%% for the two tests, or the parent directory of these, in which case
%% the latest run.<timestamp> directory will be chosen.
%%
%% Note that the m1 module will also be presented in the normal
%% coverage log for s1 (due to the include statement in s1.cover), but
%% that only includes the coverage achieved by the s1 test itself.
%%
%% The Tag in the 'cross' statement in the cover file has no other
%% purpose than mapping the list of modules ([m1] in the example
%% above) to the correct log directory where it should be included in
%% the cross_cover.html file (S1LogDir in the example above).
%% I.e. the value of the Tag has no meaning, it could be foo as well
%% as s1 above, as long as the same Tag is used in the cover file and
%% in the call to cross_cover_analyse/2.


%% Cover compilation
%% The compilation is executed on the target node
start_cover(#cover{}=CoverInfo) ->
    cover_compile(CoverInfo);
start_cover({log,CoverLogDir}=CoverInfo) ->
    %% Cover is controlled by the framework - here's the log
    put(test_server_cover_log_dir,CoverLogDir),
    {ok,CoverInfo}.

cover_compile(CoverInfo) ->
    test_server:cover_compile(CoverInfo).

%% Read the coverfile for an application and return a list of modules
%% that are members of the application but shall not be compiled
%% (Exclude), and a list of modules that are not members of the
%% application but shall be compiled (Include).
read_cover_file(none) ->
    {[],[],[]};
read_cover_file(CoverFile) ->
    case file:consult(CoverFile) of
	{ok,List} ->
	    case check_cover_file(List, [], [], []) of
		{ok,Exclude,Include,Cross} -> {Exclude,Include,Cross};
		error ->
		    io:fwrite("Faulty format of CoverFile ~p\n", [CoverFile]),
		    {[],[],[]}
	    end;
	{error,Reason} ->
	    io:fwrite("Can't read CoverFile ~ts\nReason: ~p\n",
		      [CoverFile,Reason]),
	    {[],[],[]}
    end.

check_cover_file([{exclude,all}|Rest], _, Include, Cross) ->
    check_cover_file(Rest, all, Include, Cross);
check_cover_file([{exclude,Exclude}|Rest], _, Include, Cross) ->
    case lists:all(fun(M) -> is_atom(M) end, Exclude) of
	true ->
	    check_cover_file(Rest, Exclude, Include, Cross);
	false ->
	    error
    end;
check_cover_file([{include,Include}|Rest], Exclude, _, Cross) ->
    case lists:all(fun(M) -> is_atom(M) end, Include) of
	true ->
	    check_cover_file(Rest, Exclude, Include, Cross);
	false ->
	    error
    end;
check_cover_file([{cross,Cross}|Rest], Exclude, Include, _) ->
    case check_cross(Cross) of
	true ->
	    check_cover_file(Rest, Exclude, Include, Cross);
	false ->
	    error
    end;
check_cover_file([], Exclude, Include, Cross) ->
    {ok,Exclude,Include,Cross}.

check_cross([{Tag,Modules}|Rest]) ->
    case lists:all(fun(M) -> is_atom(M) end, [Tag|Modules]) of
	true ->
	    check_cross(Rest);
	false ->
	    false
    end;
check_cross([]) ->
    true.


%% Cover analysis, per application
%% This analysis is executed on the target node once the test is
%% completed for an application. This is not the same as the cross
%% cover analysis, which can be executed on any node after the tests
%% are finshed.
%%
%% This per application analysis writes the file cover.html in the
%% application's run.<timestamp> directory.
stop_cover(#cover{}=CoverInfo, TestDir) ->
    cover_analyse(CoverInfo, TestDir);
stop_cover(_CoverInfo, _TestDir) ->
    %% Cover is probably controlled by the framework
    ok.

make_relative(AbsDir, VsDir) ->
    DirTokens = filename:split(AbsDir),
    VsTokens = filename:split(VsDir),
    filename:join(make_relative1(DirTokens, VsTokens)).

make_relative1([T | DirTs], [T | VsTs]) ->
    make_relative1(DirTs, VsTs);
make_relative1(Last = [_File], []) ->
    Last;
make_relative1(Last = [_File], VsTs) ->
    Ups = ["../" || _ <- VsTs],
    Ups ++ Last;
make_relative1(DirTs, []) ->
    DirTs;
make_relative1(DirTs, VsTs) ->
    Ups = ["../" || _ <- VsTs],
    Ups ++ DirTs.


cover_analyse(CoverInfo, TestDir) ->
    write_default_cross_coverlog(TestDir),

    {ok,CoverLog} = open_html_file(filename:join(TestDir, ?coverlog_name)),
    write_coverlog_header(CoverLog),
    #cover{app=App,
	   file=CoverFile,
	   excl=Excluded,
	   cross=Cross} = CoverInfo,
    io:fwrite(CoverLog, "<h1>Coverage for application '~w'</h1>\n", [App]),
    io:fwrite(CoverLog,
	      "<p><a href=\"~ts\">Coverdata collected over all tests</a></p>",
	      [?cross_coverlog_name]),

    io:fwrite(CoverLog, "<p>CoverFile: <code>~tp</code>\n", [CoverFile]),
    write_cross_cover_info(TestDir,Cross),

    case length(cover:imported_modules()) of
	Imps when Imps > 0 ->
	    io:fwrite(CoverLog,
		      "<p>Analysis includes data from ~w imported module(s).\n",
		      [Imps]);
	_ ->
	    ok
    end,

    io:fwrite(CoverLog, "<p>Excluded module(s): <code>~tp</code>\n", [Excluded]),

    Coverage = test_server:cover_analyse(TestDir, CoverInfo),
    write_binary_file(filename:join(TestDir,?raw_coverlog_name),
		      term_to_binary(Coverage)),

    case lists:filter(fun({_M,{_,_,_}}) -> false;
			 (_) -> true
		      end, Coverage) of
	[] ->
	    ok;
	Bad ->
	    io:fwrite(CoverLog, "<p>Analysis failed for ~w module(s): "
		      "<code>~w</code>\n",
		      [length(Bad),[BadM || {BadM,{_,_Why}} <- Bad]])
    end,

    TotPercent = write_cover_result_table(CoverLog, Coverage),
    write_binary_file(filename:join(TestDir, ?cover_total),
		      term_to_binary(TotPercent)).

%% Cover analysis - accumulated over multiple tests
%% This can be executed on any node after all tests are finished.
%% Analyse = overview | details
%% TagDirs = [{Tag,Dir}]
%%   Tag = atom(), identifier
%%   Dir = string(), the log directory for Tag, it can be a
%%         run.<timestamp> directory or the parent directory of
%%         such (in which case the latest run.<timestamp> directory
%%         is used)
cross_cover_analyse(Analyse, TagDirs0) ->
    TagDirs = get_latest_run_dirs(TagDirs0),
    TagMods = get_all_cross_info(TagDirs,[]),
    TagDirMods = add_cross_modules(TagMods,TagDirs),
    CoverdataFiles = get_coverdata_files(TagDirMods),
    lists:foreach(fun(CDF) -> cover:import(CDF) end, CoverdataFiles),
    io:fwrite("Cover analysing...\n", []),
    DetailsFun =
	case Analyse of
	    details ->
		fun(Dir,M) ->
			OutFile = filename:join(Dir,
						atom_to_list(M) ++
						".CROSS_COVER.html"),
			case cover:analyse_to_file(M, OutFile, [html]) of
			    {ok,_} ->
				{file,OutFile};
			    Error ->
				Error
			end
		end;
	    _ ->
		fun(_,_) -> undefined end
	end,
    Coverage = analyse_tests(TagDirMods, DetailsFun, []),
    cover:stop(),
    write_cross_cover_logs(Coverage,TagDirMods).

write_cross_cover_info(_Dir,[]) ->
    ok;
write_cross_cover_info(Dir,Cross) ->
    write_binary_file(filename:join(Dir,?cross_cover_info),
		      term_to_binary(Cross)).

%% For each test from which there are cross cover analysed
%% modules, write a cross cover log (cross_cover.html).
write_cross_cover_logs([{Tag,Coverage}|T],TagDirMods) ->
    case lists:keyfind(Tag,1,TagDirMods) of
	{_,Dir,Mods} when Mods=/=[] ->
	    write_binary_file(filename:join(Dir,?raw_cross_coverlog_name),
			      term_to_binary(Coverage)),
	    CoverLogName = filename:join(Dir,?cross_coverlog_name),
	    {ok,CoverLog} = open_html_file(CoverLogName),
	    write_coverlog_header(CoverLog),
	    io:fwrite(CoverLog,
		      "<h1>Coverage results for \'~w\' from all tests</h1>\n",
		      [Tag]),
	    write_cover_result_table(CoverLog, Coverage),
	    io:fwrite("Written file ~tp\n", [CoverLogName]);
	_ ->
	    ok
    end,
    write_cross_cover_logs(T,TagDirMods);
write_cross_cover_logs([],_) ->
    io:fwrite("done\n", []).

%% Get the latest run.<timestamp> directories
get_latest_run_dirs([{Tag,Dir}|Rest]) ->
    [{Tag,get_latest_run_dir(Dir)} | get_latest_run_dirs(Rest)];
get_latest_run_dirs([]) ->
    [].

get_latest_run_dir(Dir) ->
    case filelib:wildcard(filename:join(Dir,"run.[1-2]*")) of
	[] ->
	    Dir;
	[H|T] ->
	    get_latest_dir(T,H)
    end.

get_latest_dir([H|T],Latest) when H>Latest ->
    get_latest_dir(T,H);
get_latest_dir([_|T],Latest) ->
    get_latest_dir(T,Latest);
get_latest_dir([],Latest) ->
    Latest.

get_all_cross_info([{_Tag,Dir}|Rest],Acc) ->
    case file:read_file(filename:join(Dir,?cross_cover_info)) of
	{ok,Bin} ->
	    TagMods = binary_to_term(Bin),
	    get_all_cross_info(Rest,TagMods++Acc);
	_ ->
	    get_all_cross_info(Rest,Acc)
    end;
get_all_cross_info([],Acc) ->
    Acc.

%% Associate the cross cover modules with their log directories
add_cross_modules(TagMods,TagDirs)->
    do_add_cross_modules(TagMods,[{Tag,Dir,[]} || {Tag,Dir} <- TagDirs]).
do_add_cross_modules([{Tag,Mods1}|TagMods],TagDirMods)->
    NewTagDirMods =
	case lists:keytake(Tag,1,TagDirMods) of
	    {value,{Tag,Dir,Mods},Rest} ->
		[{Tag,Dir,lists:umerge(lists:sort(Mods1),Mods)}|Rest];
	    false ->
		TagDirMods
	end,
    do_add_cross_modules(TagMods,NewTagDirMods);
do_add_cross_modules([],TagDirMods) ->
    %% Just to get the modules in the same order as in the normal cover log
    [{Tag,Dir,lists:reverse(Mods)} || {Tag,Dir,Mods} <- TagDirMods].

%% Find all exported coverdata files.
get_coverdata_files(TagDirMods) ->
    lists:flatmap(
      fun({_,LatestDir,_}) ->
	      filelib:wildcard(filename:join(LatestDir,"all.coverdata"))
      end,
      TagDirMods).


%% For each test, analyse all modules
%% Used for cross cover analysis.
analyse_tests([{Tag,LastTest,Modules}|T], DetailsFun, Acc) ->
    Cov = analyse_modules(LastTest, Modules, DetailsFun, []),
    analyse_tests(T, DetailsFun, [{Tag,Cov}|Acc]);
analyse_tests([], _DetailsFun, Acc) ->
    Acc.

%% Analyse each module
%% Used for cross cover analysis.
analyse_modules(Dir, [M|Modules], DetailsFun, Acc) ->
    {ok,{M,{Cov,NotCov}}} = cover:analyse(M, module),
    Acc1 = [{M,{Cov,NotCov,DetailsFun(Dir,M)}}|Acc],
    analyse_modules(Dir, Modules, DetailsFun, Acc1);
analyse_modules(_Dir, [], _DetailsFun, Acc) ->
    Acc.


%% Support functions for writing the cover logs (both cross and normal)
write_coverlog_header(CoverLog) ->
    case catch io:put_chars(CoverLog,html_header("Coverage results")) of
	{'EXIT',Reason} ->
	    io:format("\n\nERROR: Could not write normal heading in coverlog.\n"
		      "CoverLog: ~w\n"
		      "Reason: ~p\n",
		      [CoverLog,Reason]),
	    io:format(CoverLog,"<html><body>\n", []);
	_ ->
	    ok
    end.


format_analyse(M,Cov,NotCov,undefined) ->
    io_lib:fwrite("<tr><td>~w</td>"
		  "<td align=right>~w %</td>"
		  "<td align=right>~w</td>"
		  "<td align=right>~w</td></tr>\n",
		  [M,pc(Cov,NotCov),Cov,NotCov]);
format_analyse(M,Cov,NotCov,{file,File}) ->
    io_lib:fwrite("<tr><td><a href=\"~ts\">~w</a></td>"
		  "<td align=right>~w %</td>"
		  "<td align=right>~w</td>"
		  "<td align=right>~w</td></tr>\n",
		  [uri_encode(filename:basename(File)),
		   M,pc(Cov,NotCov),Cov,NotCov]);
format_analyse(M,Cov,NotCov,{lines,Lines}) ->
    CoverOutName = atom_to_list(M)++".COVER.html",
    {ok,CoverOut} = open_html_file(CoverOutName),
    write_not_covered(CoverOut,M,Lines),
    ok = file:close(CoverOut),
    io_lib:fwrite("<tr><td><a href=\"~ts\">~w</a></td>"
		  "<td align=right>~w %</td>"
		  "<td align=right>~w</td>"
		  "<td align=right>~w</td></tr>\n",
		  [uri_encode(CoverOutName),M,pc(Cov,NotCov),Cov,NotCov]);
format_analyse(M,Cov,NotCov,{error,_}) ->
    io_lib:fwrite("<tr><td>~w</td>"
		  "<td align=right>~w %</td>"
		  "<td align=right>~w</td>"
		  "<td align=right>~w</td></tr>\n",
		  [M,pc(Cov,NotCov),Cov,NotCov]).


pc(0,0) ->
    0;
pc(Cov,NotCov) ->
    round(Cov/(Cov+NotCov)*100).


write_not_covered(CoverOut,M,Lines) ->
    io:put_chars(CoverOut,html_header("Coverage results for "++atom_to_list(M))),
    io:fwrite(CoverOut,
	      "The following lines in module ~w are not covered:\n"
	      "<table border=3 cellpadding=5>\n"
	      "<th>Line Number</th>\n",
	      [M]),
    lists:foreach(fun({{_M,Line},{0,1}}) ->
			  io:fwrite(CoverOut,"<tr><td>~w</td></tr>\n", [Line]);
		     (_) ->
			  ok
		  end,
		  Lines),
    io:put_chars(CoverOut,"</table>\n</body>\n</html>\n").


write_default_coverlog(TestDir) ->
    {ok,CoverLog} = open_html_file(filename:join(TestDir,?coverlog_name)),
    write_coverlog_header(CoverLog),
    io:put_chars(CoverLog,"Cover tool is not used\n</body></html>\n"),
    ok = file:close(CoverLog).

write_default_cross_coverlog(TestDir) ->
    {ok,CrossCoverLog} =
	open_html_file(filename:join(TestDir,?cross_coverlog_name)),
    write_coverlog_header(CrossCoverLog),
    io:put_chars(CrossCoverLog,
		 ["No cross cover modules exist for this application,",
		  xhtml("<br>","<br />"),
		  "or cross cover analysis is not completed.\n"
		  "</body></html>\n"]),
    ok = file:close(CrossCoverLog).

write_cover_result_table(CoverLog,Coverage) ->
    io:fwrite(CoverLog,
	      "<p><table border=3 cellpadding=5>\n"
	      "<tr><th>Module</th><th>Covered (%)</th><th>Covered (Lines)</th>"
	      "<th>Not covered (Lines)</th>\n",
	      []),
    {TotCov,TotNotCov} =
	lists:foldl(fun({M,{Cov,NotCov,Details}},{AccCov,AccNotCov}) ->
			    Str = format_analyse(M,Cov,NotCov,Details),
			    io:fwrite(CoverLog,"~ts", [Str]),
			    {AccCov+Cov,AccNotCov+NotCov};
		       ({_M,{error,_Reason}},{AccCov,AccNotCov}) ->
			    {AccCov,AccNotCov}
		    end,
		    {0,0},
		    Coverage),
    TotPercent = pc(TotCov,TotNotCov),
    io:fwrite(CoverLog,
	      "<tr><th align=left>Total</th><th align=right>~w %</th>"
	      "<th align=right>~w</th><th align=right>~w</th></tr>\n"
	      "</table>\n"
	      "</body>\n"
	      "</html>\n",
	      [TotPercent,TotCov,TotNotCov]),
    ok = file:close(CoverLog),
    TotPercent.


%%%-----------------------------------------------------------------
%%% Support functions for writing files

%% HTML files are always written with utf8 encoding
html_header(Title) ->
    ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n"
     "<!-- autogenerated by '", atom_to_list(?MODULE), "'. -->\n"
     "<html>\n"
     "<head>\n"
     "<title>", Title, "</title>\n"
     "<meta http-equiv=\"cache-control\" content=\"no-cache\"></meta>\n"
     "<meta http-equiv=\"content-type\" content=\"text/html; "
            "charset=utf-8\"></meta>\n"
     "</head>\n"
     "<body bgcolor=\"white\" text=\"black\" "
     "link=\"blue\" vlink=\"purple\" alink=\"red\">\n"].

open_html_file(File) ->
    open_utf8_file(File).

open_html_file(File,Opts) ->
    open_utf8_file(File,Opts).

write_html_file(File,Content) ->
    write_file(File,Content,utf8).

%% The 'major' log file, which is a pure text file is also written
%% with utf8 encoding
open_utf8_file(File) ->
    case file:open(File,AllOpts=[write,{encoding,utf8}]) of
	{error,Reason} -> {error,{Reason,{File,AllOpts}}};
	Result         -> Result
    end.

open_utf8_file(File,Opts) ->
    case file:open(File,AllOpts=[{encoding,utf8}|Opts]) of
	{error,Reason} -> {error,{Reason,{File,AllOpts}}};
	Result         -> Result
    end.

%% Write a file with specified encoding
write_file(File,Content,latin1) ->
    file:write_file(File,Content);
write_file(File,Content,utf8) ->
    write_binary_file(File,unicode:characters_to_binary(Content)).

%% Write a file with only binary data
write_binary_file(File,Content) ->
    file:write_file(File,Content).

%% Encoding of hyperlinks in HTML files
uri_encode(File) ->
    Encoding = file:native_name_encoding(),
    uri_encode(File,Encoding).

uri_encode(File,Encoding) ->
    Components = filename:split(File),
    filename:join([uri_encode_comp(C,Encoding) || C <- Components]).

%% Encode the reference to a "filename of the given encoding" so it
%% can be inserted in a utf8 encoded HTML file.
%% This does almost the same as http_uri:encode/1, except
%% 1. it does not convert @, : and / (in order to preserve nodename and c:/)
%% 2. if the file name is in latin1, it also encodes all
%%    characters >127 - i.e. latin1 but not ASCII.
uri_encode_comp([Char|Chars],Encoding) ->
    Reserved = sets:is_element(Char, reserved()),
    case (Char>127 andalso Encoding==latin1) orelse Reserved of
	true ->
	    [ $% | http_util:integer_to_hexlist(Char)] ++
		uri_encode_comp(Chars,Encoding);
	false ->
	    [Char | uri_encode_comp(Chars,Encoding)]
    end;
uri_encode_comp([],_) ->
    [].

%% Copied from http_uri.erl, but slightly modified
%% (not converting @, : and /)
reserved() ->
    sets:from_list([$;, $&, $=, $+, $,, $?,
		    $#, $[, $], $<, $>, $\", ${, $}, $|,
                    $\\, $', $^, $%, $ ]).

encoding(File) ->
    case epp:read_encoding(File) of
	none ->
	    epp:default_encoding();
	E ->
	    E
    end.