%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2002-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%%
%% %CopyrightEnd%
%%
-module(test_server_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/2, cover/3, cover/8, 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]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-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, erlang:now()).
-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) ->
controller_call({cover,{App,CoverFile},Analyse,true}).
cover(App, CoverFile, Exclude, Include, Cross, Export, Analyse, Stop) ->
controller_call({cover,
{App,{CoverFile,Exclude,Include,Cross,Export}},
Analyse,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 -> [];
{App,Analyse,Stop} -> [{cover,App,Analyse,Stop}]
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,App,Analyse,Stop}, _, State) -> ok | {error,Reason}
%%
%% All modules inn application App are cover compiled
%% Analyse indicates on which level the coverage should be analysed
handle_call({cover,App,Analyse,Stop}, _From, State) ->
{reply,ok,State#state{cover={App,Analyse,Stop}}};
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% 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]).
%% timer:tc/3
ts_tc(M, F, A) ->
Before = ?now,
Val = (catch apply(M, F, A)),
After = ?now,
Elapsed = elapsed_time(Before, After),
{Elapsed,Val}.
elapsed_time(Before, After) ->
(element(1,After)*1000000000000 +
element(2,After)*1000000 + element(3,After)) -
(element(1,Before)*1000000000000 +
element(2,Before)*1000000 + element(3,Before)).
start_extra_tools(ExtraTools) ->
start_extra_tools(ExtraTools, []).
start_extra_tools([{cover,App,Analyse,Stop} | ExtraTools], Started) ->
case cover_compile(App) of
{ok,AnalyseMods} ->
start_extra_tools(ExtraTools,
[{cover,App,Analyse,AnalyseMods,Stop}|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,App,Analyse,AnalyseMods,Stop}|ExtraTools], TestDir) ->
cover_analyse(App, Analyse, AnalyseMods, Stop, 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}}|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,_Func},_Cmt}}|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,
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_name,?unexpected_io_log]),
print(html,
"<p>~ts</p>\n" ++
xhtml("<table bgcolor=\"white\" border=\"3\" cellpadding=\"5\">",
["<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),
SrcListing = downcase(atom_to_list(Mod)) ++ ?src_listing_ext,
case {filelib:is_file(filename:join(LogDir, SrcListing)),
lists:member(no_src, get(test_server_logopts))} of
{true,false} ->
print(Lev, "<a href=\"~ts#~ts\">source code for ~w:~w/1</a>\n",
[uri_encode(SrcListing),
uri_encode(atom_to_list(Func)++"-1",utf8),
Mod,Func]);
_ ->
ok
end,
io:put_chars(Fd, "<pre>\n"),
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,_}|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
_ ->
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);
{_,Header,_} ->
erl2html2:convert(Src, Dest, 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,_},_}}=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 ->
[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}} 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, Mode,
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,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}}|Cases],
Config, TimetrapData, Mode, Status) ->
skip_case(user, undefined, 0, Case, Comment, false, Mode),
test_server_sup:framework_call(report, [tc_user_skip,
{Mod,all,Comment}]),
run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status);
run_test_cases_loop([{skip_case,{Case,Comment}}|Cases],
Config, TimetrapData, Mode, Status) ->
{Mod,Func} = skip_case(user, undefined, get(test_server_case_num)+1,
Case, Comment, is_io_buffered()),
test_server_sup:framework_call(report, [tc_user_skip,{Mod,Func,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 = elapsed_time(Before, After)/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 = elapsed_time(conf_start(Ref, Mode0),?now)/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,
elapsed_time(conf_start(Ref, Mode0),?now)/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 = elapsed_time(conf_start(Ref, Mode0),?now)/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 now() 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(true, Props) ->
print(major, "=group_props ~p", [Props]),
print(minor, "Group properties: ~p~n", [Props]);
print_props(_, _) ->
ok.
%% 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) ->
skip_case(Type, Ref, CaseNum, Case, Comment, SendSync, []).
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}}=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,_,_,skip_case}=Op,
[{_M,_F}=MF|T], Orig, Alt) ->
modify_cases_upto1(Ref, Op, T, Orig, [{skip_case,{MF,Reason}}|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 some other case, ignore or copy
modify_cases_upto1(Ref, {skip,_,_,_,_}=Op, [_|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),
print(minor, "<a name=\"top\"></a>", [], internal_raw),
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 ->
{_,S,Us} = now(),
lists:flatten(io_lib:format(".~w.~w", [S,Us]));
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,
test_server_sup:framework_call(report,
[tc_start,{{Mod,Func},MinorName}]),
print_props((RunInit==skip_init), get_props(Mode)),
GroupName = case get_name(Mode) 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\"><</a> <a href=\"~ts#end\">></a></td>",
[num2str(Num),fw_name(Mod),GroupName,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], get_name(Mode),
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, Loc,
timetrap_timeout, TimetrapTimeout, Comment, Style);
{died,Reason} ->
progress(failed, Num, Mod, Func, Loc, Reason,
Time, Comment, Style);
{_,{'EXIT',{Skip,Reason}}} when Skip==skip; Skip==skipped;
Skip==auto_skip ->
progress(skip, Num, Mod, Func, Loc, Reason,
Time, Comment, Style);
{_,{'EXIT',_Pid,{Skip,Reason}}} when Skip==skip; Skip==skipped ->
progress(skip, Num, Mod, Func, Loc, Reason,
Time, Comment, Style);
{_,{'EXIT',_Pid,Reason}} ->
progress(failed, Num, Mod, Func, Loc, Reason,
Time, Comment, Style);
{_,{'EXIT',Reason}} ->
progress(failed, Num, Mod, Func, Loc, Reason,
Time, Comment, Style);
{_,{Fail,Reason}} when Fail =:= fail; Fail =:= failed ->
progress(failed, Num, Mod, Func, Loc, Reason,
Time, Comment, Style);
{_,Reason={auto_skip,_Why}} ->
progress(skip, Num, Mod, Func, Loc, Reason,
Time, Comment, Style);
{_,{Skip,Reason}} when Skip==skip; Skip==skipped ->
progress(skip, Num, Mod, Func, Loc, Reason,
Time, Comment, Style);
{Time,RetVal} ->
case DetectedFail of
[] ->
progress(ok, Num, Mod, Func, Loc, RetVal,
Time, Comment, Style);
Reason ->
progress(failed, Num, Mod, Func, 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, 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,
{ReportTag,Reason1}}]),
ReasonStr = 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, 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,
{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, 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,
{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, "=== reason = {testcase_aborted,~p}", [Reason]),
failed;
progress(failed, CaseNum, Mod, Func, unknown, Reason, Time,
Comment0, {St0,St1}) ->
print(major, "=result failed: ~p, ~w", [Reason,unknown]),
print(1, "*** FAILED ~ts ***",
[get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
test_server_sup:framework_call(report, [tc_done,{Mod,Func,
{failed,Reason}}]),
TimeStr = io_lib:format(if is_float(Time) -> "~.3fs";
true -> "~w"
end, [Time]),
ErrorReason = 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, "=== reason = " ++ FStr, [FormattedReason]),
failed;
progress(failed, CaseNum, Mod, Func, Loc, Reason, Time,
Comment0, {St0,St1}) ->
print(major, "=result failed: ~p, ~p", [Reason,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,
{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(Loc)),
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(Loc),
print(minor, "=== location ~ts", [FormatLoc]),
{FStr,FormattedReason} = format_exception(Reason),
print(minor, "=== reason = " ++ FStr, [FormattedReason]),
failed;
progress(ok, _CaseNum, Mod, Func, _Loc, RetVal, Time,
Comment0, {St0,St1}) ->
print(minor, "successfully completed test case", []),
test_server_sup:framework_call(report, [tc_done,{Mod,Func,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, "=== returned value = ~p", [RetVal]),
ok.
%%--------------------------------------------------------------------
%% various help functions
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) ->
case collect_cases(Case, St0) of
{ok,FlatCases1,St1} ->
case collect_cases(Cs0, St1) of
{ok,FlatCases2,St} ->
{ok,FlatCases1 ++ FlatCases2,St};
{error,_Reason} = Error -> Error
end;
{error,_Reason} = Error -> Error
end;
collect_cases({module,Case}, St) when is_atom(Case), is_atom(St#cc.mod) ->
collect_case({St#cc.mod,Case}, St);
collect_cases({module,Mod,Case}, St) ->
collect_case({Mod,Case}, St);
collect_cases({module,Mod,Case,Args}, St) ->
collect_case({Mod,Case,Args}, St);
collect_cases({dir,SubDir}, St) ->
collect_files(SubDir, "*_SUITE", St);
collect_cases({dir,SubDir,Pattern}, St) ->
collect_files(SubDir, Pattern++"*", St);
collect_cases({conf,InitF,CaseList,FinMF}, St) when is_atom(InitF) ->
collect_cases({conf,[],{St#cc.mod,InitF},CaseList,FinMF}, St);
collect_cases({conf,InitMF,CaseList,FinF}, St) when is_atom(FinF) ->
collect_cases({conf,[],InitMF,CaseList,{St#cc.mod,FinF}}, St);
collect_cases({conf,InitMF,CaseList,FinMF}, St0) ->
collect_cases({conf,[],InitMF,CaseList,FinMF}, St0);
collect_cases({conf,Props,InitF,CaseList,FinMF}, St) when is_atom(InitF) ->
case init_props(Props) of
{error,_} ->
{ok,[],St};
Props1 ->
collect_cases({conf,Props1,{St#cc.mod,InitF},CaseList,FinMF}, St)
end;
collect_cases({conf,Props,InitMF,CaseList,FinF}, St) when is_atom(FinF) ->
case init_props(Props) of
{error,_} ->
{ok,[],St};
Props1 ->
collect_cases({conf,Props1,InitMF,CaseList,{St#cc.mod,FinF}}, St)
end;
collect_cases({conf,Props,InitMF,CaseList,FinMF} = Conf, St) ->
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)],
Mode = [{Ref,Props2,undefined}],
case in_skip_list({St#cc.mod,Conf}, Skips) of
{true,Comment} -> % conf init skipped
{ok,[{skip_case,{conf,Ref,InitMF,Comment},Mode} |
[] ++ [{conf,Ref,[],FinMF}]],St};
{true,Name,Comment} when is_atom(Name) -> % all cases skipped
case collect_cases(CaseList, St) of
{ok,[],_St} = Empty ->
Empty;
{ok,FlatCases,St1} ->
Cases2Skip = FlatCases ++ [{conf,Ref,
keep_name(Props1),
FinMF}],
Skipped = skip_cases_upto(Ref, Cases2Skip, Comment,
conf, Mode, skip_case),
{ok,[{skip_case,{conf,Ref,InitMF,Comment},Mode} |
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}) 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) 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) ->
case collect_cases(CaseList, St0) 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) when is_list(Cases) ->
case (catch collect_case(Cases, St#cc{mod=Module}, [])) of
{ok, NewCases, NewSt} ->
{ok, NewCases, NewSt};
Other ->
{error, Other}
end;
collect_cases({_Mod,_Case}=Spec, St) ->
collect_case(Spec, St);
collect_cases({_Mod,_Case,_Args}=Spec, St) ->
collect_case(Spec, St);
collect_cases(Case, St) when is_atom(Case), is_atom(St#cc.mod) ->
collect_case({St#cc.mod,Case}, St);
collect_cases(Other, St) ->
{error,{bad_subtest_spec,St#cc.mod,Other}}.
collect_case({Mod,{conf,_,_,_,_}=Conf}, St) ->
collect_case_invoke(Mod, Conf, [], St);
collect_case(MFA, St) ->
case in_skip_list(MFA, St#cc.skip) of
{true,Comment} ->
{ok,[{skip_case,{MFA,Comment}}],St};
false ->
case MFA of
{Mod,Case} -> collect_case_invoke(Mod, Case, MFA, St);
{_Mod,_Case,_Args} -> {ok,[MFA],St}
end
end.
collect_case([], St, Acc) ->
{ok, Acc, St};
collect_case([Case | Cases], St, Acc) ->
{ok, FlatCases, NewSt} = collect_case({St#cc.mod, Case}, St),
collect_case(Cases, NewSt, Acc ++ FlatCases).
collect_case_invoke(Mod, Case, MFA, St) ->
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)
end;
_ ->
Suite = test_server_sup:framework_call(get_suite,
[Mod,Case],
[]),
collect_subcases(Mod, Case, MFA, St, Suite)
end.
collect_subcases(Mod, Case, MFA, St, Suite) ->
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);
{req,ReqList,SubCases} ->
collect_case_deny(Mod, Case, MFA, ReqList, SubCases, St);
%%%! --- END Kept for backwards compatibility ---
{Skip,Reason} when Skip==skip; Skip==skipped ->
{ok,[{skip_case,{MFA,Reason}}],St};
{error,Reason} ->
throw(Reason);
SubCases ->
collect_case_subcases(Mod, Case, SubCases, St)
end.
collect_case_subcases(Mod, Case, SubCases, St0) ->
OldMod = St0#cc.mod,
case collect_cases(SubCases, St0#cc{mod=Mod}) of
{ok,FlatCases,St} ->
{ok,FlatCases,St#cc{mod=OldMod}};
{error,Reason} ->
{error,{{Mod,Case},Reason}}
end.
collect_files(Dir, Pattern, St) ->
{ok,Cwd} = file:get_cwd(),
Dir1 = filename:join(Cwd, Dir),
Wc = filename:join([Dir1,Pattern++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}};
Mods0 ->
Mods = [{path_to_module(Mod),all} || Mod <- lists:sort(Mods0)],
collect_cases(Mods, St)
end.
path_to_module(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) ->
case {check_deny(ReqList, St#cc.skip),SubCases} of
{{denied,Comment},_SubCases} ->
{ok,[{skip_case,{MFA,Comment}}],St};
{granted,[]} ->
{ok,[MFA],St};
{granted,SubCases} ->
collect_case_subcases(Mod, Case, SubCases, St)
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
cover_compile({App,{_File,Exclude,Include,Cross,_Export}}) ->
cover_compile1({App,Exclude,Include,Cross});
cover_compile({App,CoverFile}) ->
{Exclude,Include,Cross} = read_cover_file(CoverFile),
cover_compile1({App,Exclude,Include,Cross}).
cover_compile1(What) ->
test_server:cover_compile(What).
%% 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.
cover_analyse({App,CoverInfo}, Analyse, AnalyseMods, Stop, TestDir) ->
write_default_cross_coverlog(TestDir),
{ok,CoverLog} = open_html_file(filename:join(TestDir, ?coverlog_name)),
write_coverlog_header(CoverLog),
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]),
{CoverFile,_Included,Excluded,Cross} =
case CoverInfo of
{File,Excl,Incl,Cr,Export} ->
cover:export(Export),
{File,Incl,Excl,Cr};
File ->
{Excl,Incl,Cr} = read_cover_file(File),
{File,Incl,Excl,Cr}
end,
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 = cover_analyse(Analyse, AnalyseMods, Stop),
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_analyse(Analyse, AnalyseMods, Stop) ->
TestDir = get(test_server_log_dir_base),
test_server:cover_analyse({Analyse,TestDir}, AnalyseMods, Stop).
%% 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\">\n"
"<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\">\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.