diff options
Diffstat (limited to 'lib/test_server/src/test_server_ctrl.erl')
| -rw-r--r-- | lib/test_server/src/test_server_ctrl.erl | 5253 |
1 files changed, 5253 insertions, 0 deletions
diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl new file mode 100644 index 0000000000..667d0cc051 --- /dev/null +++ b/lib/test_server/src/test_server_ctrl.erl @@ -0,0 +1,5253 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(test_server_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 +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% ARCHITECTURE +%% +%% The Erlang Test Server can be run on the target machine (local target) +%% or towards a remote target. The execution flow is mainly the same in +%% both cases, but with a remote target the test cases are (obviously) +%% executed on the target machine. Host and target communicates over +%% socket connections because the host should not be introduced as an +%% additional node in the distributed erlang system in which the test +%% cases are run. +%% +%% +%% Local Target: +%% ============= +%% +%% ----- +%% | | test_server_ctrl ({global,test_server}) +%% ----- (test_server_ctrl.erl) +%% | +%% | +%% ----- +%% | | JobProc +%% ----- (test_server_ctrl.erl and test_server.erl) +%% | +%% | +%% ----- +%% | | CaseProc +%% ----- (test_server.erl) +%% +%% +%% +%% test_server_ctrl is the main process in the system. It is a registered +%% process, and it will always be alive when testing is ongoing. +%% test_server_ctrl initiates testing and monitors JobProc(s). +%% +%% When target is local, and Test Server is *not* being used by a framework +%% application (where it might cause duplicate name problems in a distributed +%% test environment), the process is globally registered as 'test_server' +%% to be able to simulate the {global,test_server} process on a remote target. +%% +%% JobProc is spawned for each 'job' added to the test_server_ctrl. +%% A job can mean one test case, one test suite or one spec. +%% JobProc creates and writes logs and presents results from testing. +%% JobProc is the group leader for CaseProc. +%% +%% CaseProc is spawned for each test case. It runs the test case and +%% sends results and any other information to its group leader - JobProc. +%% +%% +%% +%% Remote Target: +%% ============== +%% +%% HOST TARGET +%% +%% ----- MainSock ----- +%% test_server_ctrl | |- - - - - - -| | {global,test_server} +%% (test_server_ctrl.erl) ----- ----- (test_server.erl) +%% | | +%% | | +%% ----- JobSock ----- +%% JobProcH | |- - - - - - -| | JobProcT +%% (test_server_ctrl.erl) ----- ----- (test_server.erl) +%% | +%% | +%% ----- +%% | | CaseProc +%% ----- (test_server.erl) +%% +%% +%% +%% +%% A separate test_server process only exists when target is remote. It +%% is then the main process on target. It is started when test_server_ctrl +%% is started, and a socket connection is established between +%% test_server_ctrl and test_server. The following information can be sent +%% over MainSock: +%% +%% HOST TARGET +%% -> {target_info, TargetInfo} (during initiation) +%% <- {job_proc_killed,Name,Reason} (if a JobProcT dies unexpectedly) +%% -> {job,Port,Name} (to start a new JobProcT) +%% +%% +%% When target is remote, JobProc is split into to processes: JobProcH +%% executing on Host and JobProcT executing on Target. (The two processes +%% execute the same code as JobProc does when target is local.) JobProcH +%% and JobProcT communicates over a socket connection. The following +%% information can be sent over JobSock: +%% +%% HOST TARGET +%% -> {test_case, Case} To start a new test case +%% -> {beam,Mod} .beam file as binary to be loaded +%% on target, e.g. a test suite +%% -> {datadir,Tarfile} Content of the datadir for a test suite +%% <- {apply,MFA} MFA to be applied on host, ignore return; +%% (apply is used for printing information in +%% log or console) +%% <- {sync_apply,MFA} MFA to be applied on host, wait for return +%% (used for starting and stopping slave nodes) +%% -> {sync_apply,MFA} MFA to be applied on target, wait for return +%% (used for cover compiling and analysing) +%% <-> {sync_result,Result} Return value from sync_apply +%% <- {test_case_result,Result} When a test case is finished +%% <- {crash_dumps,Tarfile} When a test case is finished +%% -> job_done When a job is finished +%% <- {privdir,Privdir} When a job is finished +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%% 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_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_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([get_levels/0, set_levels/3]). +-export([multiply_timetraps/1]). +-export([cover/2, cover/3, cover/7, + cross_cover_analyse/1, cross_cover_analyse/2, trc/1, stop_trace/0]). +-export([testcase_callback/1]). +-export([set_random_seed/1]). + +%%% TEST_SERVER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-export([output/2, print/2, print/3, 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]). +-export([get_target_info/0]). +-export([get_hosts/0]). +-export([get_target_os_type/0]). +-export([node_started/1]). + +%%% 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]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-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(cross_coverlog_name, "cross_cover.html"). +-define(cover_total, "total_cover.log"). +-define(last_file, "last_name"). +-define(last_link, "last_link"). +-define(last_test, "last_test"). +-define(html_ext, ".html"). +-define(cross_cover_file, "cross.cover"). +-define(now, erlang:now()). + +-define(pl2a(M), test_server_sup:package_atom(M)). +-define(void_fun, fun() -> ok end). +-define(mod_result(X), if X == skip -> skipped; + X == auto_skip -> skipped; + true -> X end). + +-record(state,{jobs=[],levels={1,19,10},multiply_timetraps=1,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_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_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 ~s: ~p\n", + [cast_to_list(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,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 = cast_to_list(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], [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], [Mod|Names], + Param, Trc, Cov, TCCB); +parse_cmd_line(['PARAMETERS',Param|Cmds], SpecList, Names, _Param, Trc, Cov, TCCB) -> + parse_cmd_line(Cmds, SpecList, 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("~p: Bad argument: ~p\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), cast_to_list(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 + +start() -> + start(local). + +start(Param) -> + case gen_server:start({local,?MODULE}, ?MODULE, [Param], []) of + {ok, Pid} -> + {ok, Pid}; + Other -> + Other + end. + +start_link(Param) -> + case gen_server:start_link({local,?MODULE}, ?MODULE, [Param], []) 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}), + + %% adding of jobs involves file i/o which may take long time + %% when running a nfs mounted file system (VxWorks). + case controller_call(get_target_info) of + #target_info{os_family=vxworks} -> + receive after 30000 -> ready_to_wait end; + _ -> + wait_now + end, + 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}), + ok. + +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}). + +multiply_timetraps(N) -> + controller_call({multiply_timetraps,N}). + +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}). +cover(App, CoverFile, Exclude, Include, Cross, Export, Analyse) -> + controller_call({cover,{App,{CoverFile,Exclude,Include,Cross,Export}},Analyse}). + +testcase_callback(ModFunc) -> + controller_call({testcase_callback,ModFunc}). + +set_random_seed(Seed) -> + controller_call({set_random_seed,Seed}). + +get_hosts() -> + get(test_server_hosts). + +get_target_os_type() -> + case whereis(?MODULE) of + undefined -> + %% This is probably called on the target node + os:type(); + _pid -> + %% This is called on the controller, e.g. from a + %% specification clause of a test case + #target_info{os_type=OsType} = controller_call(get_target_info), + OsType + end. + +%%-------------------------------------------------------------------- + +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([Mode]) +%% Mode = lazy | error_logger +%% StateFile = string() +%% ReadMode = ignore_errors | halt_on_errors +%% +%% init() is the init function of the test_server's gen_server. +%% When Mode=error_logger: The init function of the test_server's gen_event +%% event handler used as a replacement error_logger when running test_suites. +%% +%% The init function reads the test server state file, to see what test +%% suites were running when the test server was last running, and which +%% flags that were in effect. If no state file is found, or there are +%% errors in it, defaults are used. +%% +%% Mode 'lazy' ignores (and resets to []) any jobs in the state file +%% + +init([Param]) -> + case os:getenv("TEST_SERVER_CALL_TRACE") of + false -> + ok; + "" -> + ok; + TraceSpec -> + test_server_sup:call_trace(TraceSpec) + end, + process_flag(trap_exit, true), + case lists:keysearch(sasl, 1, application:which_applications()) of + {value,_} -> + test_server_h:install(); + false -> + ok + end, + %% 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(), + State = #state{jobs=[],finish=false}, + put(test_server_free_targets,[]), + case contact_main_target(Param) of + {ok,TI} -> + ets:new(slave_tab, [named_table,set,public,{keypos,2}]), + set_hosts([TI#target_info.host]), + {ok,State#state{target_info=TI}}; + {error,Reason} -> + {stop,Reason} + end. + + +%% If the test is to be run at a remote target, this function sets up +%% a socket communication with the target. +contact_main_target(local) -> + %% When used by a general framework, global registration of + %% test_server should not be required. + case os:getenv("TEST_SERVER_FRAMEWORK") of + false -> + %% Local target! The global test_server process implemented by + %% test_server.erl will not be started, so we simulate it by + %% globally registering this process instead. + global:sync(), + case global:whereis_name(test_server) of + undefined -> + global:register_name(test_server, self()); + Pid -> + case node() of + N when N == node(Pid) -> + io:format(user, "Warning: test_server already running!\n", []), + global:re_register_name(test_server,self()); + _ -> + ok + end + end; + _ -> + ok + end, + TI = test_server:init_target_info(), + TargetHost = test_server_sup:hoststr(), + {ok,TI#target_info{where=local, + host=TargetHost, + naming=naming(), + master=TargetHost}}; + +contact_main_target(ParameterFile) -> + case read_parameters(ParameterFile) of + {ok,Par} -> + case test_server_node:start_remote_main_target(Par) of + {ok,TI} -> + {ok,TI}; + {error,Error} -> + {error,{could_not_start_main_target,Error}} + end; + {error,Error} -> + {error,{could_not_read_parameterfile,Error}} + end. + +read_parameters(File) -> + case file:consult(File) of + {ok,Data} -> + read_parameters(lists:flatten(Data), #par{naming=naming()}); + Error -> + Error + end. +read_parameters([{type,Type}|Data], Par) -> % mandatory + read_parameters(Data, Par#par{type=Type}); +read_parameters([{target,Target}|Data], Par) -> % mandatory + read_parameters(Data, Par#par{target=cast_to_list(Target)}); +read_parameters([{slavetargets,SlaveTargets}|Data], Par) -> + read_parameters(Data, Par#par{slave_targets=SlaveTargets}); +read_parameters([{longnames,Bool}|Data], Par) -> + Naming = if Bool->"-name"; true->"-sname" end, + read_parameters(Data, Par#par{naming=Naming}); +read_parameters([{master,{Node,Cookie}}|Data], Par) -> + read_parameters(Data, Par#par{master=cast_to_list(Node), + cookie=cast_to_list(Cookie)}); +read_parameters([Other|_Data], _Par) -> + {error,{illegal_parameter,Other}}; +read_parameters([], Par) when Par#par.type==undefined -> + {error, {missing_mandatory_parameter,type}}; +read_parameters([], Par) when Par#par.target==undefined -> + {error, {missing_mandatory_parameter,target}}; +read_parameters([], Par0) -> + Par = + case {Par0#par.type, Par0#par.master} of + {ose, undefined} -> + %% Use this node as master and bootserver for target + %% and slave nodes + Par0#par{master = atom_to_list(node()), + cookie = atom_to_list(erlang:get_cookie())}; + {ose, _Master} -> + %% Master for target and slave nodes was defined in parameterfile + Par0; + _ -> + %% Use target as master for slave nodes, + %% (No master is used for target) + Par0#par{master="test_server@" ++ Par0#par.target} + end, + {ok,Par}. + +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(State#state.target_info), + {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} -> [{cover,App,Analyse}] + 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], + LogDir, Name, State#state.levels, + 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], + LogDir, Name, State#state.levels, + 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], + LogDir, Name, State#state.levels, + 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) 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 + [] -> + Fun(Cli), + {reply, {ok,self()}, State}; + _ -> + Subscribed = State#state.idle_notify, + {reply, {ok,self()}, + State#state{idle_notify=[{Cli,Fun}|Subscribed]}} + end; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 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({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({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}, _, 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}, _From, State) -> + {reply,ok,State#state{cover={App,Analyse}}}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 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, State#state.target_info), + {reply, R, State}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({stop_node,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 and +%% possibly a target client are expected to be linked. +%% When a test suite terminates, it is removed from the job queue. +%% If a target client terminates it means that we lost contact with +%% target. The test_server_ctrl process is terminated, and teminate/2 +%% will do the cleanup + +handle_info({'EXIT',Pid,Reason}, State) -> + case lists:keysearch(Pid,2,State#state.jobs) of + false -> + TI = State#state.target_info, + case TI#target_info.target_client of + Pid -> + %% The target client died - lost contact with target + {stop,{lost_contact_with_target,Reason},State}; + _other -> + %% not our problem + {noreply,State} + end; + {value,{Name,_}} -> + NewJobs = lists:keydelete(Pid, 2, State#state.jobs), + case Reason of + normal -> + fine; + killed -> + io:format("Suite ~s was killed\n", [Name]); + _Other -> + io:format("Suite ~s was killed with reason ~p\n", + [Name,Reason]) + end, + State2 = State#state{jobs=NewJobs}, + case NewJobs of + [] -> + lists:foreach(fun({Cli,Fun}) -> Fun(Cli) end, + State2#state.idle_notify), + case State2#state.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 State2#state.finish of + abort -> % abort test now! + lists:foreach(fun({Cli,Fun}) -> Fun(Cli) end, + State2#state.idle_notify), + {stop,shutdown,State2#state{finish=false}}; + _ -> % true | false + {noreply, State2} + end + end + end; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_info({tcp,Sock,Bin}, State) +%% +%% Message from remote main target process +%% Only valid message is 'job_proc_killed', which indicates +%% that a process running a test suite was killed + +handle_info({tcp,_MainSock,<<1,Request/binary>>}, State) -> + case binary_to_term(Request) of + {job_proc_killed,Name,Reason} -> + %% The only purpose of this is to inform the user about what + %% happened on target. + %% The local job proc will soon be killed by the closed socket or + %% because the job is finished. Then the above clause ('EXIT') will + %% handle the problem. + io:format("Suite ~s was killed on remote target with reason" + " ~p\n", [Name,Reason]); + _ -> + ignore + end, + {noreply,State}; + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_info({tcp_closed,Sock}, State) +%% +%% A Socket was closed. This indicates that a node died. +%% This can be +%% *Target node (if remote) +%% *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) -> + case test_server_node:nodedown(Sock,State#state.target_info) of + target_died -> + %% terminate/2 will do the cleanup + {stop,target_died,State}; + _ -> + {noreply,State} + end; + +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 terminates the remote target (if is exists) + +terminate(_Reason, State) -> + 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:stop(State#state.target_info), + 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, +%% TestCaseCallback, ExtraTools) -> Pid +%% Mod = atom() +%% Func = atom() +%% Args = [term(),...] +%% Dir = string() +%% Name = string() +%% Levels = {integer(),integer(),integer()} +%% 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, TCCallback, ExtraTools) -> + spawn_link( + fun() -> init_tester(Mod, Func, Args, Dir, Name, Levels, + TCCallback, ExtraTools) + end). + +init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, + TCCallback, ExtraTools) -> + process_flag(trap_exit, true), + 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_summary_level, SumLev), + put(test_server_major_level, MajLev), + put(test_server_minor_level, MinLev), + put(test_server_random_seed, proplists:get_value(random_seed, ExtraTools)), + put(test_server_testcase_callback, TCCallback), + StartedExtraTools = start_extra_tools(ExtraTools), + {TimeMy,Result} = ts_tc(Mod, Func, Args), + put(test_server_common_io_handler, undefined), + stop_extra_tools(StartedExtraTools), + case Result of + {'EXIT',test_suites_done} -> + print(25, "DONE, normal exit", []); + {'EXIT',_Pid,Reason} -> + print(1, "EXIT, reason ~p", [Reason]); + {'EXIT',Reason} -> + print(1, "EXIT, reason ~p", [Reason]); + _Other -> + print(25, "DONE", []) + 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,""}; + {Skipped,_} -> {Skipped,io_lib:format(", ~p Skipped", [Skipped])} + end, + OkN = get(test_server_ok), + FailedN = get(test_server_failed), + print(html,"<tr><td></td><td><b>TOTAL</b></td><td></td><td></td>" + "<td>~.3fs</td><td><b>~s</b></td><td>~p Ok, ~p Failed~s of ~p</td></tr>\n", + [Time,SuccessStr,OkN,FailedN,SkipStr,OkN+FailedN+SkippedN]). + +%% 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} | ExtraTools], Started) -> + case cover_compile(App) of + {ok,AnalyseMods} -> + start_extra_tools(ExtraTools, + [{cover,App,Analyse,AnalyseMods}|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}|ExtraTools], TestDir) -> + cover_analyse(App, Analyse, AnalyseMods, TestDir), + stop_extra_tools(ExtraTools, TestDir); +%%stop_extra_tools([_ | ExtraTools], TestDir) -> +%% stop_extra_tools(ExtraTools, TestDir); +stop_extra_tools([], _) -> + ok. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% do_spec(SpecName, MultiplyTimetrap) -> {error,Reason} | exit(Result) +%% SpecName = string() +%% MultiplyTimetrap = integer() | infinity +%% +%% Reads the named test suite specification file, and executes it. +%% +%% This function is meant to be called by a process created by +%% spawn_tester/7, which sets up some necessary dictionary values. + +do_spec(SpecName, MultiplyTimetrap) when is_list(SpecName) -> + case file:consult(SpecName) of + {ok,TermList} -> + do_spec_list(TermList,MultiplyTimetrap); + {error,Reason} -> + io:format("Can't open ~s: ~p\n", [SpecName,Reason]), + {error,{cant_open_spec,Reason}} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% do_spec_list(TermList) -> exit(Result) +%% TermList = [term()|...] +%% MultiplyTimetrap = integer() | infinity +%% +%% 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/7, which sets up some necessary dictionary values. + +do_spec_list(TermList0, MultiplyTimetrap) -> + 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, MultiplyTimetrap). + +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=cast_to_list(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,_} -> + 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); + _ -> + remove_conf(Cases, NoConf, true) + end; +remove_conf([{make,_Ref,_MF}|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([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([{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, MultiplyTimetrap) -> +%% exit(Result) +%% +%% TopCases = term() (See collect_cases/3) +%% SkipCases = term() (See collect_cases/3) +%% Config = term() (See collect_cases/3) +%% MultiplyTimetrap = integer() | infinity +%% +%% 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/7, which sets up some necessary dictionary values. + +do_test_cases(TopCases, SkipCases, Config, MultiplyTimetrap) when is_list(TopCases) -> + start_log_file(), + 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), + TI = get_target_info(), + print(1, "Starting test~s", [print_if_known(N, {", ~w test cases",[N]}, + {" (with repeated test cases)",[]})]), + test_server_sup:framework_call(report, [tests_start, + {get(test_server_name),N}]), + print(html, + "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" + "<!-- autogenerated by '"++atom_to_list(?MODULE)++"'. -->\n" + "<html>\n" + "<head><title>Test ~p results</title>\n" + "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n" + "</head>\n" + "<body bgcolor=\"white\" text=\"black\" " + "link=\"blue\" vlink=\"purple\" alink=\"red\">" + "<h2>Results from test ~p</h2>\n", + [get(test_server_name),get(test_server_name)]), + print_timestamp(html, "Test started at "), + + print(html, "<p>Host:<br>\n"), + print_who(test_server_sup:hoststr(), test_server_sup:get_username()), + print(html, "<br>Used Erlang ~s in <tt>~s</tt>.\n", + [erlang:system_info(version), code:root_dir()]), + + case os:getenv("TEST_SERVER_FRAMEWORK") of + false -> + print(html, "<p>Target:<br>\n"), + print_who(TI#target_info.host, TI#target_info.username), + print(html, "<br>Used Erlang ~s in <tt>~s</tt>.\n", + [TI#target_info.version, TI#target_info.root_dir]); + _ -> + case test_server_sup:framework_call(target_info, []) of + TargetInfo when is_list(TargetInfo), + length(TargetInfo) > 0 -> + print(html, "<p>Target:<br>\n"), + print(html, "~s\n", [TargetInfo]); + _ -> + ok + end + end, + + print(html, + "<p><a href=\"~s\">Full textual log</a>\n" + "<br><a href=\"~s\">Coverage log</a>\n", + [?suitelog_name,?coverlog_name]), + print(html,"<p>~s" + "<p>\n" + "<table border=3 cellpadding=5>" + "<tr><th>Num</th><th>Module</th><th>Case</th><th>Log</th>" + "<th>Time</th><th>Result</th><th>Comment</th></tr>\n", + [print_if_known(N, {"Suite contains ~p test cases.\n",[N]}, + {"",[]})]), + print(major, "=cases ~p", [get(test_server_cases)]), + print(major, "=user ~s", [TI#target_info.username]), + print(major, "=host ~s", [TI#target_info.host]), + + %% If there are no hosts specified,use only the local host + case controller_call(get_hosts) of + [] -> + print(major, "=hosts ~s", [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 ~s", [Str]) + end, + print(major, "=emulator_vsn ~s", [TI#target_info.version]), + print(major, "=emulator ~s", [TI#target_info.emulator]), + print(major, "=otp_release ~s", [TI#target_info.otp_release]), + print(major, "=started ~s", + [lists:flatten(timestamp_get(""))]), + run_test_cases(TestSpec, Config, MultiplyTimetrap) + end; + +do_test_cases(TopCase, SkipCases, Config, MultiplyTimetrap) -> + %% when not list(TopCase) + do_test_cases([TopCase], SkipCases, Config, MultiplyTimetrap). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% start_log_file() -> ok | 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 -> + exit({cant_create_log_dir,{MkDirError,Dir}}) + end, + TestDir = timestamp_filename_get(filename:join(Dir, "run.")), + case file:make_dir(TestDir) of + ok -> + ok; + MkDirError2 -> + exit({cant_create_log_dir,{MkDirError2,TestDir}}) + end, + + ok = file:write_file(filename:join(Dir, ?last_file), TestDir ++ "\n"), + ok = file:write_file(?last_file, TestDir ++ "\n"), + + put(test_server_log_dir_base,TestDir), + MajorName = filename:join(TestDir, ?suitelog_name), + HtmlName = MajorName ++ ?html_ext, + {ok,Major} = file:open(MajorName, [write]), + {ok,Html} = file:open(HtmlName, [write]), + put(test_server_major_fd,Major), + put(test_server_html_fd,Html), + + 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(TestDir, ?priv_dir), + ok = file:make_dir(PrivDir), + put(test_server_priv_dir,PrivDir++"/"), + print_timestamp(13,"Suite started at "), + ok. + +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 -> + filename:join(lists:nthtail(length(PwdL), TargetL)); + false -> + "file:" ++ Target + end, + H = io_lib:format("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" + "<!-- autogenerated by '"++atom_to_list(?MODULE)++"'. -->\n" + "<html>\n" + "<head><title>~s</title></head>\n" + "<body bgcolor=\"white\" text=\"black\"" + " link=\"blue\" vlink=\"purple\" alink=\"red\">\n" + "<h1>Last test</h1>\n" + "<a href=\"~s\">~s</a>~n" + "</body>\n</html>\n", + [Explanation,Href,Explanation]), + ok = file:write_file(LinkName, H). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% start_minor_log_file(Mod, Func) -> AbsName +%% Mod = atom() +%% Func = atom() +%% 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>.log. +%% Some header info will also be inserted into the log file. + +start_minor_log_file(Mod, Func) -> + LogDir = get(test_server_log_dir_base), + Name0 = lists:flatten(io_lib:format("~s.~s~s", [Mod,Func,?html_ext])), + Name = downcase(Name0), + AbsName = filename:join(LogDir, Name), + case file:read_file_info(AbsName) of + {error,_} -> %% normal case, unique name + start_minor_log_file1(Mod, Func, LogDir, AbsName); + {ok,_} -> %% special case, duplicate names + {_,S,Us} = now(), + Name1_0 = + lists:flatten(io_lib:format("~s.~s.~w.~w~s", [Mod,Func,S, + trunc(Us/1000), + ?html_ext])), + Name1 = downcase(Name1_0), + AbsName1 = filename:join(LogDir, Name1), + start_minor_log_file1(Mod, Func, LogDir, AbsName1) + end. + +start_minor_log_file1(Mod, Func, LogDir, AbsName) -> + {ok,Fd} = file:open(AbsName, [write]), + Lev = get(test_server_minor_level)+1000, %% far down in the minor levels + put(test_server_minor_fd, Fd), + io:fwrite(Fd, + "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" + "<!-- autogenerated by '"++atom_to_list(?MODULE)++"'. -->\n" + "<html>\n" + "<head><title>"++cast_to_list(Mod)++"</title>\n" + "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n" + "</head>\n" + "<body bgcolor=\"white\" text=\"black\"" + " link=\"blue\" vlink=\"purple\" alink=\"red\">\n", + []), + + SrcListing = downcase(cast_to_list(Mod)) ++ ?src_listing_ext, + case filelib:is_file(filename:join(LogDir, SrcListing)) of + true -> + print(Lev, "<a href=\"~s#~s\">source code for ~p:~p/1</a>\n", + [SrcListing,Func,Mod,Func]); + false -> ok + end, + + io:fwrite(Fd, "<pre>\n", []), + +% Stupid BUG! +% case catch apply(Mod, Func, [doc]) of +% {'EXIT', _Why} -> ok; +% Comment -> print(Lev, "Comment: ~s~n<br>", [Comment]) +% end, + + AbsName. + +stop_minor_log_file() -> + Fd = get(test_server_minor_fd), + io:fwrite(Fd, "</pre>\n</body>\n</html>\n", []), + 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) -> + Mods = html_isolate_modules(TestSpec), + 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) -> html_isolate_modules(List, sets:new()). + +html_isolate_modules([], Set) -> sets:to_list(Set); +html_isolate_modules([{skip_case,_}|Cases], Set) -> + html_isolate_modules(Cases, Set); +html_isolate_modules([{conf,_Ref,_Props,{Mod,_Func}}|Cases], Set) -> + html_isolate_modules(Cases, sets:add_element(Mod, Set)); +html_isolate_modules([{Mod,_Case}|Cases], Set) -> + html_isolate_modules(Cases, sets:add_element(Mod, Set)); +html_isolate_modules([{Mod,_Case,_Args}|Cases], Set) -> + html_isolate_modules(Cases, sets:add_element(Mod, Set)). + +%% 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", + DestDir = get(test_server_dir), + Name = atom_to_list(Mod), + DestFile = filename:join(DestDir, downcase(Name) ++ ?src_listing_ext), + html_possibly_convert(SrcFile, DestFile), + html_convert_modules(Mods); + _Other -> ok + end; +html_convert_modules([]) -> ok. + +%% Convert source code to HTML if possible and needed. + +html_possibly_convert(Src, Dest) -> + case file:read_file_info(Src) of + {ok,SInfo} -> + case file:read_file_info(Dest) of + {error,_Reason} -> % no dest file + erl2html2:convert(Src, Dest); + {ok,DInfo} when DInfo#file_info.mtime < SInfo#file_info.mtime -> + erl2html2:convert(Src, Dest); + {ok,_DInfo} -> ok % dest file up to date + end; + {error,_Reason} -> ok % no source code found + 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 = file:write_file(Dest, Bin); + {error,_Reason} -> + io:format("File ~p: read failed\n", [Src]) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% add_init_and_end_per_suite(TestSpec, Mod, Ref) -> 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) -> + [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef)]; +add_init_and_end_per_suite([{skip_case,{{Mod,all},_}}=Case|Cases], LastMod, LastRef) + when Mod =/= LastMod -> + {PreCases, NextMod, NextRef} = + do_add_end_per_suite_and_skip(LastMod, LastRef, Mod), + PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)]; +add_init_and_end_per_suite([{skip_case,{{Mod,_},_}}=Case|Cases], LastMod, LastRef) + when Mod =/= LastMod -> + {PreCases, NextMod, NextRef} = + do_add_init_and_end_per_suite(LastMod, LastRef, Mod), + PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)]; +add_init_and_end_per_suite([{skip_case,{conf,_,{Mod,_},_}}=Case|Cases], LastMod, LastRef) + when Mod =/= LastMod -> + {PreCases, NextMod, NextRef} = + do_add_init_and_end_per_suite(LastMod, LastRef, Mod), + PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)]; +add_init_and_end_per_suite([{skip_case,_}=Case|Cases], LastMod, LastRef) -> + [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef)]; +add_init_and_end_per_suite([{conf,_,_,{Mod,_}}=Case|Cases], LastMod, LastRef) + when Mod =/= LastMod -> + {PreCases, NextMod, NextRef} = + do_add_init_and_end_per_suite(LastMod, LastRef, Mod), + PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)]; +add_init_and_end_per_suite([{conf,_,_,_}=Case|Cases], LastMod, LastRef) -> + [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef)]; +add_init_and_end_per_suite([{Mod,_}=Case|Cases], LastMod, LastRef) + when Mod =/= LastMod -> + {PreCases, NextMod, NextRef} = + do_add_init_and_end_per_suite(LastMod, LastRef, Mod), + PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)]; +add_init_and_end_per_suite([{Mod,_,_}=Case|Cases], LastMod, LastRef) + when Mod =/= LastMod -> + {PreCases, NextMod, NextRef} = + do_add_init_and_end_per_suite(LastMod, LastRef, Mod), + PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)]; +add_init_and_end_per_suite([Case|Cases], LastMod, LastRef)-> + [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef)]; +add_init_and_end_per_suite([], _LastMod, undefined) -> + []; +add_init_and_end_per_suite([], _LastMod, skipped_suite) -> + []; +add_init_and_end_per_suite([], LastMod, LastRef) -> + [{conf,LastRef,[],{LastMod,end_per_suite}}]. + +do_add_init_and_end_per_suite(LastMod, LastRef, Mod) -> + 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 -> + {[],Mod,undefined} + end, + Cases = + if LastRef==undefined -> + Init; + LastRef==skipped_suite -> + Init; + true -> + %% Adding end_per_suite here without checking if the + %% function is actually exported. This is because a + %% conf case must have an end case - so if it doesn't + %% exist, it will only fail... + [{conf,LastRef,[],{LastMod,end_per_suite}}|Init] + end, + {Cases,NextMod,NextRef}. + +do_add_end_per_suite_and_skip(LastMod, LastRef, Mod) -> + case LastRef of + No when No==undefined ; No==skipped_suite -> + {[],Mod,skipped_suite}; + _Ref -> + {[{conf,LastRef,[],{LastMod,end_per_suite}}],Mod,skipped_suite} + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% run_test_cases(TestSpec, Config, MultiplyTimetrap) -> exit(Result) +%% +%% If remote target, a socket connection is established. +%% Runs the specified tests, then displays/logs the summary. + +run_test_cases(TestSpec, Config, MultiplyTimetrap) -> + + maybe_open_job_sock(), + + html_convert_modules(TestSpec, Config), + + %%! For readable tracing... + %%! Config1 = [{data_dir,""},{priv_dir,""},{nodes,[]}], + %%! run_test_cases_loop(TestSpec, [[]], MultiplyTimetrap, [], []), + + run_test_cases_loop(TestSpec, [Config], MultiplyTimetrap, [], []), + + maybe_get_privdir(), + + {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~s 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 ~p", [FailedN]), + print(major, "=successful ~p", [OkN]), + print(major, "=user_skipped ~p", [UserSkipN]), + print(major, "=auto_skipped ~p", [AutoSkipN]), + exit(test_suites_done). + +%% If the test is run at a remote target, this function sets up a socket +%% communication with the target for handling this particular job. +maybe_open_job_sock() -> + TI = get_target_info(), + case TI#target_info.where of + local -> + %% local target + test_server:init_purify(); + MainSock -> + %% remote target + {ok,LSock} = gen_tcp:listen(0, [binary, + {reuseaddr,true}, + {packet,4}, + {active,false}]), + {ok,Port} = inet:port(LSock), + request(MainSock, {job,Port,get(test_server_name)}), + case gen_tcp:accept(LSock, ?ACCEPT_TIMEOUT) of + {ok,Sock} -> put(test_server_ctrl_job_sock, Sock); + {error,Reason} -> exit({no_contact,Reason}) + end + end. + +%% If the test is run at a remote target, this function waits for a +%% tar packet containing the privdir created by the test case. +maybe_get_privdir() -> + case get(test_server_ctrl_job_sock) of + undefined -> + %% local target + ok; + Sock -> + %% remote target + request(Sock, job_done), + gen_tcp:close(Sock) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% run_test_cases_loop(TestCases, Config, MultiplyTimetrap, Mode, Status) -> ok +%% TestCases = [Test,...] +%% Config = [[{Key,Val},...],...] +%% MultiplyTimetrap = integer() | infinity +%% 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. This function will *always* be called on the host +%% - not on target. +%% +%% {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. +%% +%% A parallel test case process will always set the dictionary value +%% 'test_server_common_io_handler' to the pid of the main (starting) +%% process. With this value set, the print/3 function will send print +%% messages to the main process instead of writing the data to file +%% (only true for printouts to common log files). +%% +%% 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. This causes all printouts +%% to common files - both from parallel test cases and from cases +%% executed by the main process - to all end up as messages in the +%% inbox of 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 printout messages from +%% each process - including the main process - are handled in turn. 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([{auto_skip_case,{Type,Ref,Case,Comment},SkipMode}|Cases], + Config, MultiplyTimetrap, Mode, Status) when Type==conf; + Type==make -> + + file:set_cwd(filename:dirname(get(test_server_dir))), + CurrIOHandler = get(test_server_common_io_handler), + %% 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, tl(Mode)) 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(auto, Ref, 0, Case, Comment, false, SkipMode), + test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]), + run_test_cases_loop(Cases, Config, MultiplyTimetrap, tl(Mode), + 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(auto, Ref, 0, Case, Comment, true, SkipMode), + test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]), + 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, MultiplyTimetrap, tl(Mode), + 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(auto, Ref, 0, Case, Comment, false, SkipMode), + test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]), + run_test_cases_loop(Cases, Config, MultiplyTimetrap, tl(Mode), + 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(auto, Ref, 0, Case, Comment, true, SkipMode), + test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]), + 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, MultiplyTimetrap, 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(auto, Ref, 0, Case, Comment, false, SkipMode), + test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]), + run_test_cases_loop(Cases, Config, MultiplyTimetrap, [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(auto, Ref, 0, Case, Comment, true, SkipMode), + test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]), + run_test_cases_loop(Cases, Config, MultiplyTimetrap, [conf(Ref,[])|Mode], Status) + end; + +run_test_cases_loop([{auto_skip_case,{Case,Comment},SkipMode}|Cases], + Config, MultiplyTimetrap, Mode, Status) -> + {Mod,Func} = skip_case(auto, undefined, get(test_server_case_num)+1, Case, Comment, + (undefined /= get(test_server_common_io_handler)), SkipMode), + test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]), + run_test_cases_loop(Cases, Config, MultiplyTimetrap, Mode, + update_status(skipped, Mod, Func, Status)); + +run_test_cases_loop([{skip_case,{conf,Ref,Case,Comment}}|Cases0], + Config, MultiplyTimetrap, Mode, Status) -> + {Mod,Func} = skip_case(user, Ref, 0, Case, Comment, + (undefined /= get(test_server_common_io_handler))), + {Cases,Config1} = + case curr_ref(Mode) of + Ref -> + %% skipped end conf + {Cases0,tl(Config)}; + _ -> + %% skipped start conf + {skip_cases_upto(Ref, Cases0, Comment, conf, Mode),Config} + end, + test_server_sup:framework_call(report, [tc_user_skip,{?pl2a(Mod),Func,Comment}]), + run_test_cases_loop(Cases, Config1, MultiplyTimetrap, Mode, + update_status(skipped, Mod, Func, Status)); + +run_test_cases_loop([{skip_case,{Case,Comment}}|Cases], + Config, MultiplyTimetrap, Mode, Status) -> + {Mod,Func} = skip_case(user, undefined, get(test_server_case_num)+1, Case, Comment, + (undefined /= get(test_server_common_io_handler))), + test_server_sup:framework_call(report, [tc_user_skip,{?pl2a(Mod),Func,Comment}]), + run_test_cases_loop(Cases, Config, MultiplyTimetrap, 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, MultiplyTimetrap, 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}; + _ -> + {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}; + {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,_,_} 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, + ActualCfg = + update_config(hd(Config), [{priv_dir,get(test_server_priv_dir)}, + {data_dir,get_data_dir(Mod)}] ++ CfgProps), + CurrMode = curr_mode(Ref, Mode0, Mode), + + ConfCaseResult = run_test_case(Ref, 0, Mod, Func, [ActualCfg], skip_init, target, + MultiplyTimetrap, 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], + MultiplyTimetrap, Mode, Status2); + Bad -> + print(minor, "~n*** ~p 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), + set_io_buffering(IOHandler), + stop_minor_log_file(), + run_test_cases_loop(Cases2, Config, MultiplyTimetrap, 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], MultiplyTimetrap, Mode, Status2); + {_,{framework_error,{FwMod,FwFunc},Reason},_} -> + print(minor, "~n*** ~p failed in ~p. Reason: ~p~n", [FwMod,FwFunc,Reason]), + print(1, "~p failed in ~p. Reason: ~p~n", [FwMod,FwFunc,Reason]), + exit(framework_error); + {_,Fail,_} when element(1,Fail) == 'EXIT'; + element(1,Fail) == timetrap_timeout; + element(1,Fail) == failed -> + {Cases2,Config1} = + if StartConf -> + ReportAbortRepeat(failed), + print(minor, "~n*** ~p failed.~n" + " Skipping all cases.", [Func]), + Reason = {failed,{Mod,Func,Fail}}, + {skip_cases_upto(Ref, Cases, Reason, conf, CurrMode),Config}; + not StartConf -> + ReportRepeatStop(), + print_conf_time(ConfTime), + {Cases,tl(Config)} + end, + set_io_buffering(IOHandler), + stop_minor_log_file(), + run_test_cases_loop(Cases2, Config1, MultiplyTimetrap, Mode, + delete_status(Ref, Status2)); + {died,Why,_} when Func == init_per_suite -> + print(minor, "~n*** Unexpected exit during init_per_suite.~n", []), + Reason = {failed,{Mod,init_per_suite,Why}}, + Cases2 = skip_cases_upto(Ref, Cases, Reason, conf, CurrMode), + set_io_buffering(IOHandler), + stop_minor_log_file(), + run_test_cases_loop(Cases2, Config, MultiplyTimetrap, Mode, + delete_status(Ref, Status2)); + {_,{Skip,Reason},_} when StartConf and ((Skip==skip) or (Skip==skipped)) -> + ReportAbortRepeat(skipped), + print(minor, "~n*** ~p 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), + Config, MultiplyTimetrap, Mode, + delete_status(Ref, Status2)); + {_,{skip_and_save,Reason,_SavedConfig},_} when StartConf -> + ReportAbortRepeat(skipped), + print(minor, "~n*** ~p 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), + Config, MultiplyTimetrap, 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), + set_io_buffering(IOHandler), + stop_minor_log_file(), + run_test_cases_loop(Cases2, Config, MultiplyTimetrap, 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], MultiplyTimetrap, + Mode, Status2); + + {_,_EndConfRetVal,Opts} -> + %% check if return_group_result is set (ok, skipped or failed) and + %% if so return the value to the group "above" so that result may be + %% used for evaluating repeat_until_* + Status3 = + case lists:keysearch(return_group_result, 1, Opts) of + {value,{_,GroupResult}} -> + update_status(GroupResult, group_result, Func, + delete_status(Ref, Status2)); + false -> + delete_status(Ref, Status2) + end, + print_conf_time(ConfTime), + ReportRepeatStop(), + set_io_buffering(IOHandler), + stop_minor_log_file(), + run_test_cases_loop(Cases, tl(Config), MultiplyTimetrap, Mode, Status3) + end; + +run_test_cases_loop([{make,Ref,{Mod,Func,Args}}|Cases0], Config, MultiplyTimetrap, Mode, Status) -> + case run_test_case(Ref, 0, Mod, Func, Args, skip_init, host, MultiplyTimetrap) of + {_,Why={'EXIT',_},_} -> + print(minor, "~n*** ~p failed.~n" + " Skipping all cases.", [Func]), + Reason = {failed,{Mod,Func,Why}}, + Cases = skip_cases_upto(Ref, Cases0, Reason, conf, Mode), + stop_minor_log_file(), + run_test_cases_loop(Cases, Config, MultiplyTimetrap, Mode, Status); + {_,_Whatever,_} -> + stop_minor_log_file(), + run_test_cases_loop(Cases0, Config, MultiplyTimetrap, Mode, Status) + end; + +run_test_cases_loop([{conf,_Ref,_Props,_X}=Conf|_Cases0], + Config, _MultiplyTimetrap, _Mode, _Status) -> + erlang:error(badarg, [Conf,Config]); + +run_test_cases_loop([{Mod,Case}|Cases], Config, MultiplyTimetrap, Mode, Status) -> + ActualCfg = + update_config(hd(Config), [{priv_dir,get(test_server_priv_dir)}, + {data_dir,get_data_dir(Mod)}]), + run_test_cases_loop([{Mod,Case,[ActualCfg]}|Cases], Config, + MultiplyTimetrap, Mode, Status); + +run_test_cases_loop([{Mod,Func,Args}|Cases], Config, MultiplyTimetrap, Mode, Status) -> + Num = put(test_server_case_num, get(test_server_case_num)+1), + %% 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) of + false -> + case get(test_server_common_io_handler) of + undefined -> + %% io printouts are written to straight to file + ok; + _ -> + %% io messages are buffered, put test case in queue + queue_test_case_io(undefined, self(), Num+1, Mod, Func) + end; + _ -> + ok + end, + case run_test_case(undefined, Num+1, Mod, Func, Args, + run_init, target, MultiplyTimetrap, Mode) of + %% callback to framework module failed, exit immediately + {_,{framework_error,{FwMod,FwFunc},Reason},_} -> + print(minor, "~n*** ~p failed in ~p. Reason: ~p~n", [FwMod,FwFunc,Reason]), + print(1, "~p failed in ~p. 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, MultiplyTimetrap, 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, MultiplyTimetrap, Mode, Status1); + true -> % skip rest of cases in sequence + print(minor, "~n*** ~p failed.~n" + " Skipping all other cases in sequence.", [Func]), + Reason = {failed,{Mod,Func}}, + Cases2 = skip_cases_upto(Ref, Cases, Reason, tc, Mode), + stop_minor_log_file(), + run_test_cases_loop(Cases2, Config, MultiplyTimetrap, 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 in the main process inbox 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, MultiplyTimetrap, Mode, Status) + end; + +%% TestSpec processing finished +run_test_cases_loop([], _Config, _MultiplyTimetrap, _, _) -> + 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. + +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([{_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) -> + case code:which(Mod) of + non_existing -> + print(12, "The module ~p is not loaded", [Mod]), + []; + FullPath -> + filename:dirname(FullPath) ++ "/" ++ cast_to_list(Mod) ++ + ?data_dir_suffix + end. + +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 < 2 -> + lists:keydelete(RepType, 1, Props); + N >= 2 -> + [{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}, + skip_case1(Type, CaseNum, Mod, Func, Comment, Mode), + 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 -> "#ffcc99"; + Type == user -> "#ff9933" + end, + + Comment1 = reason_to_string(Comment), + + print(major, "~n=case ~p:~p", [Mod,Func]), + print(major, "=started ~s", [lists:flatten(timestamp_get(""))]), + print(major, "=result skipped: ~s", [Comment1]), + print(2,"*** Skipping test case #~w ~p ***", [CaseNum,{Mod,Func}]), + print(html, + "<tr valign=top>" + "<td>" ++ Col0 ++ "~s" ++ Col1 ++ "</td>" + "<td>" ++ Col0 ++ "~p" ++ Col1 ++ "</td>" + "<td>" ++ Col0 ++ "~p" ++ Col1 ++ "</td>" + "<td>" ++ Col0 ++ "< >" ++ Col1 ++ "</td>" + "<td>" ++ Col0 ++ "0.000s" ++ Col1 ++ "</td>" + "<td><font color=\"~s\">SKIPPED</font></td>" + "<td>~s</td></tr>\n", + [num2str(CaseNum),Mod,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) -> Cases1 +%% +%% Mark all cases tagged with Ref as skipped. + +skip_cases_upto(Ref, Cases, Reason, Origin, Mode) -> + {_,Modified,Rest} = modify_cases_upto(Ref, {skip,Reason,Origin,Mode}, 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; + (_) -> 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}, [{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}, [{make,Ref,MF}|T], Orig, Alt) -> + {Orig,[{auto_skip_case,{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}, [{skip_case,{Type,Ref,MF,_Cmt}}|T], Orig, Alt) -> + {Orig,[{auto_skip_case,{Type,Ref,MF,Reason},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,_,Mode}=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). If the value is the default 'undefined', +%% io is not buffered but printed directly to file (see print/3). + +set_io_buffering(IOHandler) -> + put(test_server_common_io_handler, IOHandler). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 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 handle buffered io messages 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 #~p (~p:~p) 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. The test case processes send print requests +%% to the main (starting) process (the same process executing +%% run_test_cases_loop/4), which handles these requests in the same +%% order that the test case processes were started. +%% +%% An io session is always started with a {started,Ref,Pid,Num,Mod,Func} +%% message and terminated with {finished,Ref,Pid,Num,Mod,Func,Result,RetVal}. +%% 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', 'print' 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 consumated 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) -> + %% retreive 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 + %% end of io session from test case executed by main process + {finished,_,Main,CaseNum,Mod,Func,Result,_RetVal} -> + {Result,{Mod,Func}}; + %% end of io session from test case executed by parallel process + {finished,_,CurrPid,CaseNum,Mod,Func,Result,RetVal} -> + 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}}; + + %% print to common log file + {print,CurrPid,Detail,Msg} -> + output({Detail,Msg}, internal), + handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases); + + %% unexpected termination of test case process + {'EXIT',TCPid,Reason} when Reason /= normal -> + {value,{_,_,Num,M,F}} = lists:keysearch(TCPid, 2, Cases), + print(1, "Error! Process for test case #~p (~p:~p) 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, +%% Where, MultiplyTimetrap, Mode) -> RetVal +%% +%% Creates the minor log file and inserts some test case specific headers +%% and footers into the log files. If a remote target is used, the test +%% suite (binary) and the content of data_dir is sent. 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). +%% +%% Where specifies if the test case should run on target or on the host. +%% (Note that 'make' test cases always run on host). +%% +%% 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, Where, MultiplyTimetrap) -> + file:set_cwd(filename:dirname(get(test_server_dir))), + run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, + MultiplyTimetrap, [], [], self()). + +run_test_case(Ref, Num, Mod, Func, Args, skip_init, Where, MultiplyTimetrap, Mode) -> + %% a conf case is always executed by the main process + run_test_case1(Ref, Num, Mod, Func, Args, skip_init, Where, + MultiplyTimetrap, [], Mode, self()); + +run_test_case(Ref, Num, Mod, Func, Args, RunInit, Where, MultiplyTimetrap, Mode) -> + file:set_cwd(filename:dirname(get(test_server_dir))), + case check_prop(parallel, Mode) of + false -> + %% this is a sequential test case + run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, + MultiplyTimetrap, [], Mode, self()); + _Ref -> + %% this a parallel test case, spawn the new process + Main = self(), + {dictionary,State} = process_info(self(), dictionary), + spawn_link(fun() -> + run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, + MultiplyTimetrap, State, Mode, Main) + end) + end. + +run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, + MultiplyTimetrap, State, Mode, Main) -> + %% if this runs on a parallel test case process, + %% copy the dictionary from the main process + do_if_parallel(Main, fun() -> process_flag(trap_exit, true) end, ok), + CopyDict = fun() -> lists:foreach(fun({Key,Val}) -> put(Key, Val) end, State) end, + do_if_parallel(Main, CopyDict, ok), + do_if_parallel(Main, fun() -> put(test_server_common_io_handler, {tc,Main}) end, ok), + %% if io is being buffered, send start io session message + %% (no matter if case runs on parallel or main process) + case get(test_server_common_io_handler) of + undefined -> ok; + _ -> Main ! {started,Ref,self(),Num,Mod,Func} + end, + TSDir = get(test_server_dir), + case Where of + target -> + maybe_send_beam_and_datadir(Mod); + host -> + ok + end, + test_server_sup:framework_call(report, [tc_start,{?pl2a(Mod),Func}]), + print(major, "=case ~p:~p", [Mod, Func]), + MinorName = start_minor_log_file(Mod, Func), + print(minor, "<a name=top></a>", []), + MinorBase = filename:basename(MinorName), + print(major, "=logfile ~s", [filename:basename(MinorName)]), + print_props((RunInit==skip_init), get_props(Mode)), + print(major, "=started ~s", [lists:flatten(timestamp_get(""))]), + {{Col0,Col1},Style} = get_font_style((RunInit==run_init), Mode), + print(html, "<tr valign=top><td>" ++ Col0 ++ "~s" ++ Col1 ++ "</td>" + "<td>" ++ Col0 ++ "~p" ++ Col1 ++ "</td>" + "<td><a href=\"~s\">~p</a></td>" + "<td><a href=\"~s#top\"><</a> <a href=\"~s#end\">></a></td>", + [num2str(Num),Mod,MinorBase,Func,MinorBase,MinorBase]), + + do_if_parallel(Main, ok, fun erlang:yield/0), + %% run the test case + {Result,DetectedFail,ProcsBefore,ProcsAfter} = + run_test_case_apply(Num, Mod, Func, Args, get_name(Mode), + RunInit, Where, MultiplyTimetrap), + {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>", []), + print_timestamp(minor, "Ended at "), + print(major, "=ended ~s", [lists:flatten(timestamp_get(""))]), + + do_if_parallel(Main, ok, 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 -> + 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); + {_, {failed, Reason}} -> + progress(failed, 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, + check_new_crash_dumps(Where), + + %% if io is being buffered, send finished message + %% (no matter if case runs on parallel or main process) + case get(test_server_common_io_handler) of + undefined -> ok; + _ -> Main ! {finished,Ref,self(),Num,Mod,Func, + ?mod_result(Status),{Time,RetVal,Opts}} + end, + {Time,RetVal,Opts}. + + +%%-------------------------------------------------------------------- +%% various help functions + +%% Call If() if we're on parallel process, or +%% call Else() if we're on main process +do_if_parallel(Pid, If, Else) -> + case self() of + Pid -> + if is_function(Else) -> Else(); + true -> Else + end; + _ -> + if is_function(If) -> If(); + true -> If + end + end. + +num2str(0) -> ""; +num2str(N) -> integer_to_list(N). + +%% If remote target, this function sends the test suite (if not already sent) +%% and the content of datadir til target. +maybe_send_beam_and_datadir(Mod) -> + case get(test_server_ctrl_job_sock) of + undefined -> + %% local target + ok; + JobSock -> + %% remote target + case get(test_server_downloaded_suites) of + undefined -> + send_beam_and_datadir(Mod, JobSock), + put(test_server_downloaded_suites, [Mod]); + Suites -> + case lists:member(Mod, Suites) of + false -> + send_beam_and_datadir(Mod, JobSock), + put(test_server_downloaded_suites, [Mod|Suites]); + true -> + ok + end + end + end. + +send_beam_and_datadir(Mod, JobSock) -> + case code:which(Mod) of + non_existing -> + io:format("** WARNING: Suite ~w could not be found on host\n", + [Mod]); + BeamFile -> + send_beam(JobSock, Mod, BeamFile) + end, + DataDir = get_data_dir(Mod), + case file:read_file_info(DataDir) of + {ok,_I} -> + {ok,All} = file:list_dir(DataDir), + AddTarFiles = + case controller_call(get_target_info) of + #target_info{os_family=ose} -> + ObjExt = code:objfile_extension(), + Wc = filename:join(DataDir, "*" ++ ObjExt), + ModsInDatadir = filelib:wildcard(Wc), + SendBeamFun = fun(X) -> send_beam(JobSock, X) end, + lists:foreach(SendBeamFun, ModsInDatadir), + %% No need to send C code or makefiles since + %% no compilation can be done on target anyway. + %% Compiled C code must exist on target. + %% Beam files are already sent as binaries. + %% Erlang source are sent in case the test case + %% is to compile it. + Filter = fun("Makefile") -> false; + ("Makefile.src") -> false; + (Y) -> + case filename:extension(Y) of + ".c" -> false; + ObjExt -> false; + _ -> true + end + end, + lists:filter(Filter, All); + _ -> + All + end, + Tarfile = "data_dir.tar.gz", + {ok,Tar} = erl_tar:open(Tarfile, [write,compressed]), + ShortDataDir = filename:basename(DataDir), + AddTarFun = + fun(File) -> + Long = filename:join(DataDir, File), + Short = filename:join(ShortDataDir, File), + ok = erl_tar:add(Tar, Long, Short, []) + end, + lists:foreach(AddTarFun, AddTarFiles), + ok = erl_tar:close(Tar), + {ok,TarBin} = file:read_file(Tarfile), + file:delete(Tarfile), + request(JobSock, {{datadir,Tarfile}, TarBin}); + {error,_R} -> + ok + end. + +send_beam(JobSock, BeamFile) -> + Mod=filename:rootname(filename:basename(BeamFile), code:objfile_extension()), + send_beam(JobSock, list_to_atom(Mod), BeamFile). +send_beam(JobSock, Mod, BeamFile) -> + {ok,BeamBin} = file:read_file(BeamFile), + request(JobSock, {{beam,Mod,BeamFile}, BeamBin}). + +check_new_crash_dumps(Where) -> + case Where of + target -> + case get(test_server_ctrl_job_sock) of + undefined -> + ok; + Socket -> + read_job_sock_loop(Socket) + end; + _ -> + ok + end, + test_server_sup:check_new_crash_dumps(). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 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}} = if_auto_skip(Reason, + fun() -> {"#ffcc99",auto_skip} end, + fun() -> {"#ff9933",skip} end), + print(major, "=result skipped", []), + print(1, "*** SKIPPED *** ~s", + [get_info_str(Func, CaseNum, get(test_server_cases))]), + test_server_sup:framework_call(report, [tc_done,{?pl2a(Mod),Func, + {skipped,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 + "" -> ""; + _ -> "<br>(" ++ to_string(Comment) ++ ")" + end, + print(html, + "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>" + "<td><font color=\"~s\">SKIPPED</font></td>" + "<td>~s~s</td></tr>\n", + [Time,Color,ReasonStr2,Comment1]), + FormatLoc = test_server_sup:format_loc(Loc), + print(minor, "=== location ~s", [FormatLoc]), + print(minor, "=== reason = ~s", [ReasonStr1]), + Ret; + +progress(failed, CaseNum, Mod, Func, Loc, timetrap_timeout, T, + Comment0, {St0,St1}) -> + print(major, "=result failed: timeout, ~p", [Loc]), + print(1, "*** FAILED *** ~s", + [get_info_str(Func, CaseNum, get(test_server_cases))]), + test_server_sup:framework_call(report, + [tc_done,{?pl2a(Mod),Func, + {failed,timetrap_timeout}}]), + FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)), + ErrorReason = io_lib:format("{timetrap_timeout,~s}", [FormatLastLoc]), + Comment = + case Comment0 of + "" -> "<font color=\"red\">" ++ ErrorReason ++ "</font>"; + _ -> "<font color=\"red\">" ++ ErrorReason ++ "</font><br>" ++ + to_string(Comment0) + end, + print(html, + "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>" + "<td><font color=\"red\">FAILED</font></td>" + "<td>~s</td></tr>\n", + [T/1000,Comment]), + FormatLoc = test_server_sup:format_loc(Loc), + print(minor, "=== location ~s", [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 *** ~s", + [get_info_str(Func, CaseNum, get(test_server_cases))]), + test_server_sup:framework_call(report, + [tc_done,{?pl2a(Mod),Func, + {failed,testcase_aborted}}]), + FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)), + ErrorReason = io_lib:format("{testcase_aborted,~s}", [FormatLastLoc]), + Comment = + case Comment0 of + "" -> "<font color=\"red\">" ++ ErrorReason ++ "</font>"; + _ -> "<font color=\"red\">" ++ ErrorReason ++ "</font><br>" ++ + to_string(Comment0) + end, + print(html, + "<td>" ++ St0 ++ "died" ++ St1 ++ "</td>" + "<td><font color=\"red\">FAILED</font></td>" + "<td>~s</td></tr>\n", + [Comment]), + FormatLoc = test_server_sup:format_loc(Loc), + print(minor, "=== location ~s", [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, ~p", [Reason,unknown]), + print(1, "*** FAILED *** ~s", + [get_info_str(Func, CaseNum, get(test_server_cases))]), + test_server_sup:framework_call(report, [tc_done,{?pl2a(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 ++ "</font><br>" ++ + to_string(Comment0) + end, + print(html, + "<td>" ++ St0 ++ "~s" ++ St1 ++ "</td>" + "<td><font color=\"red\">FAILED</font></td>" + "<td>~s</td></tr>\n", + [TimeStr,Comment]), + print(minor, "=== location ~s", [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 *** ~s", + [get_info_str(Func, CaseNum, get(test_server_cases))]), + test_server_sup:framework_call(report, [tc_done,{?pl2a(Mod),Func, + {failed,Reason}}]), + TimeStr = io_lib:format(if is_float(Time) -> "~.3fs"; + true -> "~w" + end, [Time]), + Comment = + case Comment0 of + "" -> ""; + _ -> "<br>" ++ to_string(Comment0) + end, + FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)), + print(html, + "<td>" ++ St0 ++ "~s" ++ St1 ++ "</td>" + "<td><font color=\"red\">FAILED</font></td>" + "<td><font color=\"red\">~s</font>~s</td></tr>\n", + [TimeStr,FormatLastLoc,Comment]), + FormatLoc = test_server_sup:format_loc(Loc), + print(minor, "=== location ~s", [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,{?pl2a(Mod),Func,ok}]), + Comment = + case RetVal of + {comment,RetComment} -> + String = to_string(RetComment), + print(major, "=result ok: ~s", [String]), + "<td>" ++ String ++ "</td>"; + _ -> + print(major, "=result ok", []), + case Comment0 of + "" -> ""; + _ -> "<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>" + "~s</tr>\n", + [Time,Comment]), + print(minor, "=== returned value = ~p", [RetVal]), + ok. + +%%-------------------------------------------------------------------- +%% various help functions + +if_auto_skip(Reason={failed,{_,init_per_testcase,_}}, True, _False) -> + {Reason,True()}; +if_auto_skip({_T,{skip,Reason={failed,{_,init_per_testcase,_}}},_Opts}, True, _False) -> + {Reason,True()}; +if_auto_skip({fw_auto_skip,Reason}, True, _False) -> + {Reason,True()}; +if_auto_skip({_T,{skip,{fw_auto_skip,Reason}},_Opts}, True, _False) -> + {Reason,True()}; +if_auto_skip(Reason, _True, False) -> + {Reason,False()}. + +update_skip_counters(RetVal, {US,AS}) -> + {_,Result} = if_auto_skip(RetVal, fun() -> {US,AS+1} end, fun() -> {US+1,AS} end), + Result. + +get_info_str(Func, 0, _Cases) -> + atom_to_list(Func); +get_info_str(_Func, CaseNum, unknown) -> + "test case " ++ integer_to_list(CaseNum); +get_info_str(_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("~s", [Term])) of + {'EXIT',_} -> 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 os:getenv("TEST_SERVER_FRAMEWORK") of + false -> + case application:get_env(test_server, format_exception) of + {ok,false} -> + {"~p",Reason}; + _ -> + do_format_exception(Reason) + end; + FW -> + case application:get_env(list_to_atom(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}]), + {"~s",lists:flatten(Formatted1)} + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, +%% Where, MultiplyTimetrap) -> +%% {{Time,RetVal,Loc,Opts,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} | +%% {{died,Reason,unknown,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} +%% Name = atom() +%% Where = target | host +%% Time = float() (seconds) +%% RetVal = term() +%% Loc = term() +%% Comment = string() +%% Reason = term() +%% DetectedFail = [{File,Line}] +%% ProcessesBefore = ProcessesAfter = integer() +%% +%% Where indicates if the test should run on target or always on the host. +%% +%% If test is to be run on target, and target is remote the request is +%% sent over socket to target, and test_server runs the case and sends the +%% result back over the socket. Else test_server runs the case directly on host. + +run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, host, MultiplyTimetrap) -> + test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit, + MultiplyTimetrap}); +run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, target, MultiplyTimetrap) -> + case get(test_server_ctrl_job_sock) of + undefined -> + %% local target + test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit, + MultiplyTimetrap}); + JobSock -> + %% remote target + request(JobSock, {test_case,{CaseNum,Mod,Func,Args,Name,RunInit, + MultiplyTimetrap}}), + read_job_sock_loop(JobSock) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 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. +%% +%% To handle printouts to common (not minor) log files from parallel test +%% case processes, the test_server_common_io_handler value is checked. If +%% set, the data is sent to the main controlling process. Note that test +%% cases that belong to a conf group nested under a parallel group will also +%% get its io data sent to main rather than immediately printed out, even +%% if the test cases are executed by the same, main, process (ie the main +%% process sends messages to itself then). +%% +%% Buffered io is handled by the handle_test_case_io_and_status/0 function. + +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) -> + case get(test_server_minor_level) of + _ when Detail == minor -> + output({Detail,Msg}, Printer); + MinLevel when is_number(Detail), Detail >= MinLevel -> + output({Detail,Msg}, Printer); + _ -> % Detail < Minor | major | html + case get(test_server_common_io_handler) of + undefined -> + output({Detail,Msg}, Printer); + {_,MainPid} -> + MainPid ! {print,self(),Detail,Msg} + end + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 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~s on ~s", [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()). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% output({Level,Message}, Sender) -> ok +%% Level = integer() | minor | major | html +%% Message = string() | [integer()] +%% Sender = string() | internal +%% +%% Outputs the message on the channels indicated by Level. If Level is an +%% atom, only the corresponding channel receives the output. When Level is +%% an integer console, major and/or minor log file will receive output +%% depending on the user set thresholds (see get_levels/0, set_levels/3) +%% +%% When printing on the console, the message is prefixed with the test +%% suite's name. In case a name is not set (yet), Sender is used. +%% +%% When not outputting to the console, and the Sender is 'internal', +%% the message is prefixed with "=== ", so that it will be apparent that +%% the message comes from the test server and not the test suite itself. + +output({Level,Msg}, Sender) when is_integer(Level) -> + SumLev = get(test_server_summary_level), + if Level =< SumLev -> + output_to_fd(stdout, Msg, Sender); + true -> + ok + end, + MajLev = get(test_server_major_level), + if Level =< MajLev -> + output_to_fd(get(test_server_major_fd), Msg, Sender); + true -> + ok + end, + MinLev = get(test_server_minor_level), + if Level >= MinLev -> + output_to_fd(get(test_server_minor_fd), Msg, Sender); + true -> + ok + end; +output({minor,Bytes}, Sender) when is_list(Bytes) -> + output_to_fd(get(test_server_minor_fd), Bytes, Sender); +output({major,Bytes}, Sender) when is_list(Bytes) -> + output_to_fd(get(test_server_major_fd), Bytes, Sender); +output({minor,Bytes}, Sender) when is_binary(Bytes) -> + output_to_fd(get(test_server_minor_fd),binary_to_list(Bytes), Sender); +output({major,Bytes}, Sender) when is_binary(Bytes) -> + output_to_fd(get(test_server_major_fd),binary_to_list(Bytes), Sender); +output({html,Msg}, _Sender) -> + case get(test_server_html_fd) of + undefined -> + ok; + Fd -> + io:put_chars(Fd,Msg), + case file:position(Fd, {cur, 0}) of + {ok, Pos} -> + %% We are writing to a seekable file. Finalise so + %% we get complete valid (and viewable) HTML code. + %% Then rewind to overwrite the finalising code. + io:put_chars(Fd, "\n</table>\n</body>\n</html>\n"), + file:position(Fd, Pos); + {error, epipe} -> + %% The file is not seekable. We cannot erase what + %% we've already written --- so the reader will + %% have to wait until we're done. + ok + end + end; +output({minor,Data}, Sender) -> + output_to_fd(get(test_server_minor_fd), + lists:flatten(io_lib:format( + "Unexpected output: ~p~n", [Data])),Sender); +output({major,Data}, Sender) -> + output_to_fd(get(test_server_major_fd), + lists:flatten(io_lib:format( + "Unexpected output: ~p~n", [Data])),Sender). + +output_to_fd(stdout, Msg, Sender) -> + Name = + case get(test_server_name) of + undefined -> Sender; + Other -> Other + end, + io:format("Testing ~s: ~s\n", [Name, lists:flatten(Msg)]); +output_to_fd(undefined, _Msg, _Sender) -> + ok; +output_to_fd(Fd, [$=|Msg], internal) -> + io:put_chars(Fd, [$=]), + io:put_chars(Fd, Msg), + io:put_chars(Fd, "\n"); +output_to_fd(Fd, Msg, internal) -> + io:put_chars(Fd, [$=,$=,$=,$ ]), + io:put_chars(Fd, Msg), + io:put_chars(Fd, "\n"); +output_to_fd(Fd, Msg, _Sender) -> + io:put_chars(Fd, Msg), + io:put_chars(Fd, "\n"). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 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, + "~s~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, + "~s~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. InitMFA and FinMFA are +%% always run on the host - not on target. +%% +%% 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) -> + collect_cases({conf,Props,{St#cc.mod,InitF},CaseList,FinMF}, St); +collect_cases({conf,Props,InitMF,CaseList,FinF}, St) when is_atom(FinF) -> + collect_cases({conf,Props,InitMF,CaseList,{St#cc.mod,FinF}}, St); +collect_cases({conf,Props,InitMF,CaseList,FinMF}, St0) -> + case collect_cases(CaseList, St0) of + {ok,[],_St}=Empty -> + Empty; + {ok,FlatCases,St} -> + Ref = make_ref(), + case in_skip_list(InitMF, St#cc.skip) of + {true,Comment} -> + {ok,[{skip_case,{conf,Ref,InitMF,Comment}} | + FlatCases ++ [{conf,Ref,[],FinMF}]],St}; + false -> + {ok,[{conf,Ref,Props,InitMF} | + FlatCases ++ [{conf,Ref,keep_name(Props),FinMF}]],St} + end; + {error,_Reason}=Error -> + Error + 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,Other}}. + +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 os:getenv("TEST_SERVER_FRAMEWORK") of + false -> + 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, [?pl2a(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}; + [] -> {ok,[MFA],St}; +%%%! --- START Kept for backwards compatibilty --- +%%%! 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 compatibilty --- + {Skip,Reason} when Skip==skip; Skip==skipped -> + {ok,[{skip_case,{MFA,Reason}}],St}; + 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) -> + 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,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. + +keep_name(Props) -> + lists:filter(fun({name,_}) -> true; (_) -> false end, Props). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Target 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, % give some extra time + 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 ~p on ~p with command: ~p", + [Nodename, Host, Cmd]), + format(major, "=node_start ~p", [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 ~p on ~p with command: ~p~n" + "Reason: ~p", + [Name, Host, Cmd, Ret]), + {fail,Ret}; + {Ret, undefined, undefined} -> + format(minor, "Failed to start node ~p: ~p", [Name,Ret]), + Ret; + {Ret, Host, Cmd} -> + format(minor, + "Failed to start node ~p on ~p with command: ~p~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) -> + case catch controller_call({wait_for_node,Slave},10000) 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}). + + +%%-------------------------------------------------------------------- +%% Functions handling target communication over socket + +%% Generic send function for communication with target +request(Sock,Request) -> + gen_tcp:send(Sock,<<1,(term_to_binary(Request))/binary>>). + +%% Receive and decode request on job specific socket +%% Used when test is running on a remote target +read_job_sock_loop(Sock) -> + case gen_tcp:recv(Sock,0) of + {error,Reason} -> + gen_tcp:close(Sock), + exit({controller,connection_lost,Reason}); + {ok,<<1,Request/binary>>} -> + case decode(binary_to_term(Request)) of + ok -> + read_job_sock_loop(Sock); + {stop,Result} -> + Result + end + end. + +decode({apply,{M,F,A}}) -> + apply(M,F,A), + ok; +decode({sync_apply,{M,F,A}}) -> + R = apply(M,F,A), + request(get(test_server_ctrl_job_sock),{sync_result,R}), + ok; +decode({sync_result,Result}) -> + {stop,Result}; +decode({test_case_result,Result}) -> + {stop,Result}; +decode({privdir,empty_priv_dir}) -> + {stop,ok}; +decode({{privdir,PrivDirTar},TarBin}) -> + Root = get(test_server_log_dir_base), + unpack_tar(Root,PrivDirTar,TarBin), + {stop,ok}; +decode({crash_dumps,no_crash_dumps}) -> + {stop,ok}; +decode({{crash_dumps,CrashDumpTar},TarBin}) -> + Dir = test_server_sup:crash_dump_dir(), + unpack_tar(Dir,CrashDumpTar,TarBin), + {stop,ok}. + +unpack_tar(Dir,TarFileName0,TarBin) -> + TarFileName = filename:join(Dir,TarFileName0), + ok = file:write_file(TarFileName,TarBin), + ok = erl_tar:extract(TarFileName,[compressed,{cwd,Dir}]), + ok = file:delete(TarFileName). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 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.cover file (in the test_server application) under 'all' +%% or under the tested application. +%% +%% The modules listed in the cross.cover file are modules that are +%% hevily used by other applications than the one they belong +%% to. After all tests are completed, these modules can be analysed +%% with coverage data from all tests - see cross_cover_analyse/1. The +%% result is stored in a file called cross_cover.html in the +%% run.<timestamp> directory of the application the modules belong +%% to. +%% +%% For example, the lists module is listed in cross.cover to be +%% included in all tests. lists belongs to the stdlib +%% application. cross_cover_analyse/1 will create a file named +%% cross_cover.html under the newest stdlib.logs/run.xxx directory, +%% where the coverage result for the lists module from all tests is +%% presented. +%% +%% The lists module is also presented in the normal coverage log +%% for stdlib, but that only includes the coverage achieved by +%% the stdlib tests themselves. +%% +%% The Cross cover file cross.cover contains elements like this: +%% {App,Modules}. +%% where App can be an application name or the atom all. The +%% application (or all applications) shall cover compile the listed +%% Modules. + + +%% 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}) -> + Cross = get_cross_modules(App), + {Exclude,Include} = read_cover_file(CoverFile), + cover_compile1({App,Exclude,Include,Cross}). + +cover_compile1(What) -> + case get(test_server_ctrl_job_sock) of + undefined -> + %% local target + test_server:cover_compile(What); + JobSock -> + %% remote target + request(JobSock, {sync_apply,{test_server,cover_compile,[What]}}), + read_job_sock_loop(JobSock) + end. + + +%% 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} -> {Exclude,Include}; + error -> + io:fwrite("Faulty format of CoverFile ~p\n", [CoverFile]), + {[],[]} + end; + {error,Reason} -> + io:fwrite("Can't read CoverFile ~p\nReason: ~p\n", + [CoverFile,Reason]), + {[],[]} + end. + +check_cover_file([{exclude,all}|Rest], _, Include) -> + check_cover_file(Rest, all, Include); +check_cover_file([{exclude,Exclude}|Rest], _, Include) -> + case lists:all(fun(M) -> is_atom(M) end, Exclude) of + true -> + check_cover_file(Rest, Exclude, Include); + false -> + error + end; +check_cover_file([{include,Include}|Rest], Exclude, _) -> + case lists:all(fun(M) -> is_atom(M) end, Include) of + true -> + check_cover_file(Rest, Exclude, Include); + false -> + error + end; +check_cover_file([], Exclude, Include) -> + {ok,Exclude,Include}. + + + +%% 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, TestDir) -> + write_default_cross_coverlog(TestDir), + + {ok,CoverLog} = file:open(filename:join(TestDir, ?coverlog_name), [write]), + write_coverlog_header(CoverLog), + io:fwrite(CoverLog, "<h1>Coverage for application '~w'</h1>\n", [App]), + io:fwrite(CoverLog, + "<p><a href=\"~s\">Coverdata collected over all tests</a></p>", + [?cross_coverlog_name]), + + {CoverFile,_Included,Excluded} = + case CoverInfo of + {File,Excl,Incl,_Cross,Export} -> + cover:export(Export), + {File,Incl,Excl}; + File -> + {Excl,Incl} = read_cover_file(File), + {File,Incl,Excl} + end, + io:fwrite(CoverLog, "<p>CoverFile: <code>~p</code>\n", [CoverFile]), + + 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>~p</code>\n", [Excluded]), + + Coverage = cover_analyse(Analyse, AnalyseMods), + + 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), + file:write_file(filename:join(TestDir, ?cover_total), + term_to_binary(TotPercent)). + +cover_analyse(Analyse, AnalyseMods) -> + TestDir = get(test_server_log_dir_base), + case get(test_server_ctrl_job_sock) of + undefined -> + %% local target + test_server:cover_analyse({Analyse,TestDir}, AnalyseMods); + JobSock -> + %% remote target + request(JobSock, {sync_apply,{test_server, + cover_analyse, + [Analyse,AnalyseMods]}}), + read_job_sock_loop(JobSock) + end. + + +%% Cover analysis, cross application +%% This can be executed on any node after all tests are finished. +%% The node's current directory must be the same as when the tests +%% were run. +cross_cover_analyse(Analyse) -> + cross_cover_analyse(Analyse, undefined). + +cross_cover_analyse(Analyse, CrossModules) -> + CoverdataFiles = get_coverdata_files(), + lists:foreach(fun(CDF) -> cover:import(CDF) end, CoverdataFiles), + io:fwrite("Cover analysing... ", []), + DetailsFun = + case Analyse of + details -> + fun(Dir,M) -> + OutFile = filename:join(Dir, + atom_to_list(M) ++ + ".CROSS_COVER.html"), + cover:analyse_to_file(M, OutFile, [html]), + {file,OutFile} + end; + _ -> + fun(_,_) -> undefined end + end, + SortedModules = + case CrossModules of + undefined -> + sort_modules([Mod || Mod <- get_all_cross_modules(), + lists:member(Mod, cover:imported_modules())], []); + _ -> + sort_modules(CrossModules, []) + end, + Coverage = analyse_apps(SortedModules, DetailsFun, []), + cover:stop(), + write_cross_cover_logs(Coverage). + +%% For each application from which there are modules listed in the +%% cross.cover, write a cross cover log (cross_cover.html). +write_cross_cover_logs([{App,Coverage}|T]) -> + case last_test_for_app(App) of + false -> + ok; + Dir -> + CoverLogName = filename:join(Dir,?cross_coverlog_name), + {ok,CoverLog} = file:open(CoverLogName, [write]), + write_coverlog_header(CoverLog), + io:fwrite(CoverLog, + "<h1>Coverage results for \'~w\' from all tests</h1>\n", + [App]), + write_cover_result_table(CoverLog, Coverage), + io:fwrite("Written file ~p\n", [CoverLogName]) + end, + write_cross_cover_logs(T); +write_cross_cover_logs([]) -> + io:fwrite("done\n", []). + +%% Find all exported coverdata files. First find all the latest +%% run.<timestamp> directories, and the check if there is a file named +%% all.coverdata. +get_coverdata_files() -> + PossibleFiles = [last_coverdata_file(Dir) || + Dir <- filelib:wildcard([$*|?logdir_ext]), + filelib:is_dir(Dir)], + [File || File <- PossibleFiles, filelib:is_file(File)]. + +last_coverdata_file(Dir) -> + LastDir = last_test(filelib:wildcard(filename:join(Dir,"run.[1-2]*")),false), + filename:join(LastDir,"all.coverdata"). + + +%% Find the latest run.<timestamp> directory for the given application. +last_test_for_app(App) -> + AppLogDir = atom_to_list(App)++?logdir_ext, + last_test(filelib:wildcard(filename:join(AppLogDir,"run.[1-2]*")),false). + +last_test([Run|Rest], false) -> + last_test(Rest, Run); +last_test([Run|Rest], Latest) when Run > Latest -> + last_test(Rest, Run); +last_test([_|Rest], Latest) -> + last_test(Rest, Latest); +last_test([], Latest) -> + Latest. + +%% Sort modules according to the application they belong to. +%% Return [{App,LastTestDir,ModuleList}] +sort_modules([M|Modules], Acc) -> + App = get_app(M), + Acc1 = + case lists:keysearch(App, 1, Acc) of + {value,{App,LastTest,List}} -> + lists:keyreplace(App, 1, Acc, {App,LastTest,[M|List]}); + false -> + [{App,last_test_for_app(App),[M]}|Acc] + end, + sort_modules(Modules, Acc1); +sort_modules([], Acc) -> + Acc. + +get_app(Module) -> + Beam = code:which(Module), + AppDir = filename:basename(filename:dirname(filename:dirname(Beam))), + [AppStr|_] = string:tokens(AppDir,"-"), + list_to_atom(AppStr). + + +%% For each application, analyse all modules +%% Used for cross cover analysis. +analyse_apps([{App,LastTest,Modules}|T], DetailsFun, Acc) -> + Cov = analyse_modules(LastTest, Modules, DetailsFun, []), + analyse_apps(T, DetailsFun, [{App,Cov}|Acc]); +analyse_apps([], _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. + + +%% Read the cross cover file (cross.cover) +get_all_cross_modules() -> + get_cross_modules(all). +get_cross_modules(App) -> + case file:consult(?cross_cover_file) of + {ok,List} -> + get_cross_modules(App, List, []); + _X -> + [] + end. + +get_cross_modules(App, [{_To,Modules}|T], Acc) when App==all-> + get_cross_modules(App, T, Acc ++ Modules); +get_cross_modules(App, [{To,Modules}|T], Acc) when To==App; To==all-> + get_cross_modules(App, T, Acc ++ Modules); +get_cross_modules(App, [_H|T], Acc) -> + get_cross_modules(App, T, Acc); +get_cross_modules(_App, [], Acc) -> + Acc. + + +%% Support functions for writing the cover logs (both cross and normal) +write_coverlog_header(CoverLog) -> + case catch + io:fwrite(CoverLog, + "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" + "<!-- autogenerated by '~w'. -->\n" + "<html>\n" + "<head><title>Coverage results</title></head>\n" + "<body bgcolor=\"white\" text=\"black\" " + "link=\"blue\" vlink=\"purple\" alink=\"red\">", + [?MODULE]) 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=\"~s\">~w</a></td>" + "<td align=right>~w %</td>" + "<td align=right>~w</td>" + "<td align=right>~w</td></tr>\n", + [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} = file:open(CoverOutName, [write]), + write_not_covered(CoverOut,M,Lines), + io_lib:fwrite("<tr><td><a href=\"~s\">~w</a></td>" + "<td align=right>~w %</td>" + "<td align=right>~w</td>" + "<td align=right>~w</td></tr>\n", + [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:fwrite(CoverOut, + "<html>\n" + "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:fwrite(CoverOut,"</table>\n</html>\n", []). + + +write_default_coverlog(TestDir) -> + {ok,CoverLog} = file:open(filename:join(TestDir,?coverlog_name), [write]), + write_coverlog_header(CoverLog), + io:fwrite(CoverLog,"Cover tool is not used\n</body></html>\n", []), + file:close(CoverLog). + +write_default_cross_coverlog(TestDir) -> + {ok,CrossCoverLog} = + file:open(filename:join(TestDir,?cross_coverlog_name), [write]), + write_coverlog_header(CrossCoverLog), + io:fwrite(CrossCoverLog, + "No cross cover modules exist for this application,<br>" + "or cross cover analysis is not completed.\n" + "</body></html>\n", []), + 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,"~s", [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]), + file:close(CoverLog), + TotPercent. |