%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%%
%% %CopyrightEnd%
%%
-module(test_server).
-define(DEFAULT_TIMETRAP_SECS, 60).
%%% TEST_SERVER_CTRL INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([run_test_case_apply/1,init_target_info/0,init_purify/0]).
-export([cover_compile/1,cover_analyse/2]).
%%% TEST_SERVER_SUP INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([get_loc/1,set_tc_state/1]).
%%% TEST SUITE INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([lookup_config/2]).
-export([fail/0,fail/1,format/1,format/2,format/3]).
-export([capture_start/0,capture_stop/0,capture_get/0]).
-export([messages_get/0]).
-export([permit_io/2]).
-export([hours/1,minutes/1,seconds/1,sleep/1,adjusted_sleep/1,timecall/3]).
-export([timetrap_scale_factor/0,timetrap/1,get_timetrap_info/0,
timetrap_cancel/1,timetrap_cancel/0]).
-export([m_out_of_n/3,do_times/4,do_times/2]).
-export([call_crash/3,call_crash/4,call_crash/5]).
-export([temp_name/1]).
-export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]).
-export([app_test/1, app_test/2, appup_test/1]).
-export([is_native/1]).
-export([comment/1, make_priv_dir/0]).
-export([os_type/0]).
-export([run_on_shielded_node/2]).
-export([is_cover/0,is_debug/0,is_commercial/0]).
-export([break/1,break/2,break/3,continue/0,continue/1]).
%%% DEBUGGER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([purify_new_leaks/0, purify_format/2, purify_new_fds_inuse/0,
purify_is_running/0]).
%%% PRIVATE EXPORTED %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-include("test_server_internal.hrl").
-include_lib("kernel/include/file.hrl").
init_target_info() ->
[$.|Emu] = code:objfile_extension(),
{_, OTPRel} = init:script_id(),
TestServerDir = filename:absname(filename:dirname(code:which(?MODULE))),
#target_info{os_family=test_server_sup:get_os_family(),
os_type=os:type(),
version=erlang:system_info(version),
system_version=erlang:system_info(system_version),
root_dir=code:root_dir(),
test_server_dir=TestServerDir,
emulator=Emu,
otp_release=OTPRel,
username=test_server_sup:get_username(),
cookie=atom_to_list(erlang:get_cookie())}.
init_purify() ->
purify_new_leaks().
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% cover_compile(#cover{app=App,incl=Include,excl=Exclude,cross=Cross}) ->
%% {ok,#cover{mods=AnalyseModules}} | {error,Reason}
%%
%% App = atom() , name of application to be compiled
%% Exclude = [atom()], list of modules to exclude
%% Include = [atom()], list of modules outside of App that should be included
%% in the cover compilation
%% Cross = [atoms()], list of modules outside of App shat should be included
%% in the cover compilation, but that shall not be part of
%% the cover analysis for this application.
%% AnalyseModules = [atom()], list of successfully compiled modules
%%
%% Cover compile the given application. Return {ok,CoverInfo} if
%% compilation succeeds, else (if application is not found and there
%% are no modules to compile) {error,application_not_found}.
cover_compile(CoverInfo=#cover{app=none,incl=Include,cross=Cross}) ->
CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross),
CompileMods = Include++CrossMods,
case length(CompileMods) of
0 ->
io:fwrite("WARNING: No modules to cover compile!\n\n",[]),
cover:start(), % start cover server anyway
{ok,CoverInfo#cover{mods=[]}};
N ->
io:fwrite("Cover compiling ~w modules - "
"this may take some time... ",[N]),
do_cover_compile(CompileMods),
io:fwrite("done\n\n",[]),
{ok,CoverInfo#cover{mods=Include}}
end;
cover_compile(CoverInfo=#cover{app=App,excl=all,incl=Include,cross=Cross}) ->
CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross),
CompileMods = Include++CrossMods,
case length(CompileMods) of
0 ->
io:fwrite("WARNING: No modules to cover compile!\n\n",[]),
cover:start(), % start cover server anyway
{ok,CoverInfo#cover{mods=[]}};
N ->
io:fwrite("Cover compiling '~w' (~w files) - "
"this may take some time... ",[App,N]),
io:format("\nWARNING: All modules in \'~w\' are excluded\n"
"Only cover compiling modules in include list "
"and the modules\nin the cross cover file:\n"
"~tp\n", [App,CompileMods]),
do_cover_compile(CompileMods),
io:fwrite("done\n\n",[]),
{ok,CoverInfo#cover{mods=Include}}
end;
cover_compile(CoverInfo=#cover{app=App,excl=Exclude,
incl=Include,cross=Cross}) ->
CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross),
case code:lib_dir(App) of
{error,bad_name} ->
case Include++CrossMods of
[] ->
io:format("\nWARNING: Can't find lib_dir for \'~w\'\n"
"Not cover compiling!\n\n",[App]),
{error,application_not_found};
CompileMods ->
io:fwrite("Cover compiling '~w' (~w files) - "
"this may take some time... ",
[App,length(CompileMods)]),
io:format("\nWARNING: Can't find lib_dir for \'~w\'\n"
"Only cover compiling modules in include list: "
"~tp\n", [App,Include]),
do_cover_compile(CompileMods),
io:fwrite("done\n\n",[]),
{ok,CoverInfo#cover{mods=Include}}
end;
LibDir ->
EbinDir = filename:join([LibDir,"ebin"]),
WC = filename:join(EbinDir,"*.beam"),
AllMods = module_names(filelib:wildcard(WC)),
AnalyseMods = (AllMods ++ Include) -- Exclude,
CompileMods = AnalyseMods ++ CrossMods,
case length(CompileMods) of
0 ->
io:fwrite("WARNING: No modules to cover compile!\n\n",[]),
cover:start(), % start cover server anyway
{ok,CoverInfo#cover{mods=[]}};
N ->
io:fwrite("Cover compiling '~w' (~w files) - "
"this may take some time... ",[App,N]),
do_cover_compile(CompileMods),
io:fwrite("done\n\n",[]),
{ok,CoverInfo#cover{mods=AnalyseMods}}
end
end.
module_names(Beams) ->
[list_to_atom(filename:basename(filename:rootname(Beam))) || Beam <- Beams].
do_cover_compile(Modules) ->
cover:start(),
pmap1(fun(M) -> do_cover_compile1(M) end,lists:usort(Modules)),
ok.
do_cover_compile1(M) ->
case {code:is_sticky(M),code:is_loaded(M)} of
{true,_} ->
code:unstick_mod(M),
case cover:compile_beam(M) of
{ok,_} ->
ok;
Error ->
io:fwrite("\nWARNING: Could not cover compile ~w: ~p\n",
[M,Error])
end,
code:stick_mod(M);
{false,false} ->
case code:load_file(M) of
{module,_} ->
do_cover_compile1(M);
Error ->
io:fwrite("\nWARNING: Could not load ~w: ~p\n",[M,Error])
end;
{false,_} ->
case cover:compile_beam(M) of
{ok,_} ->
ok;
Error ->
io:fwrite("\nWARNING: Could not cover compile ~w: ~p\n",
[M,Error])
end
end.
pmap1(Fun,List) ->
NTot = length(List),
NProcs = erlang:system_info(schedulers) * 2,
NPerProc = (NTot div NProcs) + 1,
{[],Pids} =
lists:foldr(
fun(_,{L,Ps}) ->
{L1,L2} = if length(L)>=NPerProc -> lists:split(NPerProc,L);
true -> {L,[]} % last chunk
end,
{P,_Ref} =
spawn_monitor(fun() ->
exit(lists:map(Fun,L1))
end),
{L2,[P|Ps]}
end,
{List,[]},
lists:seq(1,NProcs)),
collect(Pids,[]).
collect([],Acc) ->
lists:append(Acc);
collect([Pid|Pids],Acc) ->
receive
{'DOWN', _Ref, process, Pid, Result} ->
%% collect(lists:delete(Pid,Pids),[Result|Acc])
collect(Pids,[Result|Acc])
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% cover_analyse(Dir,#cover{level=Analyse,mods=Modules,stop=Stop) ->
%% [{M,{Cov,NotCov,Details}}]
%%
%% Dir = string()
%% Analyse = details | overview
%% Modules = [atom()], the modules to analyse
%%
%% Cover analysis. If Analyse==details analyse_to_file is used.
%%
%% If Analyse==overview analyse_to_file is not used, only an overview
%% containing the number of covered/not covered lines in each module.
%%
%% Also, cover data will be exported to a file called all.coverdata in
%% the given directory.
%%
%% Finally, if Stop==true, then cover will be stopped after the
%% analysis is completed. Stopping cover causes the original (non
%% cover compiled) modules to be loaded back in. If a process at this
%% point is still running old code of any of the cover compiled
%% modules, meaning that is has not done any fully qualified function
%% call after the cover compilation, the process will now be
%% killed. To avoid this scenario, it is possible to set Stop=false,
%% which means that the modules will stay cover compiled. Note that
%% this is only recommended if the erlang node is being terminated
%% after the test is completed.
cover_analyse(Dir,#cover{level=Analyse,mods=Modules,stop=Stop}) ->
io:fwrite(user, "Cover analysing... ", []),
DetailsFun =
case Analyse of
details ->
case cover:export(filename:join(Dir,"all.coverdata")) of
ok ->
fun(M) ->
OutFile = filename:join(Dir,
atom_to_list(M) ++
".COVER.html"),
case cover:analyse_to_file(M,OutFile,[html]) of
{ok,_} ->
{file,OutFile};
Error ->
Error
end
end;
Error ->
fun(_) -> Error end
end;
overview ->
case cover:export(filename:join(Dir,"all.coverdata")) of
ok ->
fun(_) -> undefined end;
Error ->
fun(_) -> Error end
end
end,
R = pmap2(
fun(M) ->
case cover:analyse(M,module) of
{ok,{M,{Cov,NotCov}}} ->
{M,{Cov,NotCov,DetailsFun(M)}};
Err ->
io:fwrite(user,
"\nWARNING: Analysis failed for ~w. Reason: ~p\n",
[M,Err]),
{M,Err}
end
end, Modules),
io:fwrite(user, "done\n\n", []),
case Stop of
true ->
Sticky = unstick_all_sticky(node()),
cover:stop(),
stick_all_sticky(node(),Sticky);
false ->
ok
end,
R.
pmap2(Fun,List) ->
Collector = self(),
Pids = lists:map(fun(E) ->
spawn(fun() ->
Collector ! {res,self(),Fun(E)}
end)
end, List),
lists:map(fun(Pid) ->
receive
{res,Pid,Res} ->
Res
end
end, Pids).
do_cover_for_node(Node,CoverFunc) ->
do_cover_for_node(Node,CoverFunc,true).
do_cover_for_node(Node,CoverFunc,StickUnstick) ->
%% In case a slave node is starting another slave node! I.e. this
%% function is executed on a slave node - then the cover function
%% must be executed on the master node. This is for instance the
%% case in test_server's own tests.
MainCoverNode = cover:get_main_node(),
Sticky =
if StickUnstick -> unstick_all_sticky(MainCoverNode,Node);
true -> ok
end,
rpc:call(MainCoverNode,cover,CoverFunc,[Node]),
if StickUnstick -> stick_all_sticky(Node,Sticky);
true -> ok
end.
unstick_all_sticky(Node) ->
unstick_all_sticky(node(),Node).
unstick_all_sticky(MainCoverNode,Node) ->
lists:filter(
fun(M) ->
case code:is_sticky(M) of
true ->
rpc:call(Node,code,unstick_mod,[M]),
true;
false ->
false
end
end,
rpc:call(MainCoverNode,cover,modules,[])).
stick_all_sticky(Node,Sticky) ->
lists:foreach(
fun(M) ->
rpc:call(Node,code,stick_mod,[M])
end,
Sticky).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% run_test_case_apply(Mod,Func,Args,Name,RunInit,TimetrapData) ->
%% {Time,Value,Loc,Opts,Comment} | {died,Reason,unknown,Comment}
%%
%% Time = float() (seconds)
%% Value = term()
%% Loc = term()
%% Comment = string()
%% Reason = term()
%%
%% Spawns off a process (case process) that actually runs the test suite.
%% The case process will have the job process as group leader, which makes
%% it possible to capture all it's output from io:format/2, etc.
%%
%% The job process then sits down and waits for news from the case process.
%%
%% Returns a tuple with the time spent (in seconds) in the test case,
%% the return value from the test case or an {'EXIT',Reason} if the case
%% failed, Loc points out where the test case crashed (if it did). Loc
%% is either the name of the function, or {<Module>,<Line>} of the last
%% line executed that had a ?line macro. If the test case did execute
%% erase/0 or similar, it may be empty. Comment is the last comment added
%% by test_server:comment/1, the reason if test_server:fail has been
%% called or the comment given by the return value {comment,Comment} from
%% a test case.
%%
%% {died,Reason,unknown,Comment} is returned if the test case was killed
%% by some other process. Reason is the kill reason provided.
%%
%% TimetrapData = {MultiplyTimetrap,ScaleTimetrap}, which indicates a
%% possible extension of all timetraps. Timetraps will be multiplied by
%% MultiplyTimetrap. If it is infinity, no timetraps will be started at all.
%% ScaleTimetrap indicates if test_server should attemp to automatically
%% compensate timetraps for runtime delays introduced by e.g. tools like
%% cover.
run_test_case_apply({CaseNum,Mod,Func,Args,Name,
RunInit,TimetrapData}) ->
purify_format("Test case #~w ~w:~w/1", [CaseNum, Mod, Func]),
case os:getenv("TS_RUN_VALGRIND") of
false ->
ok;
_ ->
os:putenv("VALGRIND_LOGFILE_INFIX",atom_to_list(Mod)++"."++
atom_to_list(Func)++"-")
end,
ProcBef = erlang:system_info(process_count),
Result = run_test_case_apply(Mod, Func, Args, Name, RunInit,
TimetrapData),
ProcAft = erlang:system_info(process_count),
purify_new_leaks(),
DetFail = get(test_server_detected_fail),
{Result,DetFail,ProcBef,ProcAft}.
-type tc_status() :: 'starting' | 'running' | 'init_per_testcase' |
'end_per_testcase' | {'framework',atom(),atom()} |
'tc'.
-record(st,
{
ref :: reference(),
pid :: pid(),
mf :: {atom(),atom()},
last_known_loc :: term(),
status :: tc_status() | 'undefined',
ret_val :: term(),
comment :: list(char()),
timeout :: non_neg_integer() | 'infinity',
config :: list() | 'undefined',
end_conf_pid :: pid() | 'undefined'
}).
run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
print_timestamp(minor,"Started at "),
print(minor, "", [], internal_raw),
TCCallback = get(test_server_testcase_callback),
LogOpts = get(test_server_logopts),
Ref = make_ref(),
Pid =
spawn_link(
fun() ->
run_test_case_eval(Mod, Func, Args, Name, Ref,
RunInit, TimetrapData,
LogOpts, TCCallback)
end),
put(test_server_detected_fail, []),
St = #st{ref=Ref,pid=Pid,mf={Mod,Func},last_known_loc=unknown,
status=starting,ret_val=[],comment="",timeout=infinity,
config=hd(Args)},
run_test_case_msgloop(St).
%% Ugly bug (pre R5A):
%% If this process (group leader of the test case) terminates before
%% all messages have been replied back to the io server, the io server
%% hangs. Fixed by the 20 milli timeout check here, and by using monitor in
%% io.erl.
%%
%% A test case is known to have failed if it returns {'EXIT', _} tuple,
%% or sends a message {failed, File, Line} to it's group_leader
%%
run_test_case_msgloop(#st{ref=Ref,pid=Pid,end_conf_pid=EndConfPid0}=St0) ->
receive
{set_tc_state=Tag,From,{Status,Config0}} ->
Config = case Config0 of
unknown -> St0#st.config;
_ -> Config0
end,
St = St0#st{status=Status,config=Config},
From ! {self(),Tag,ok},
run_test_case_msgloop(St);
{abort_current_testcase,_,_}=Abort when St0#st.status =:= starting ->
%% we're in init phase, must must postpone this operation
%% until test case execution is in progress (or FW:init_tc
%% gets killed)
self() ! Abort,
erlang:yield(),
run_test_case_msgloop(St0);
{abort_current_testcase,Reason,From} ->
Line = case is_process_alive(Pid) of
true -> get_loc(Pid);
false -> unknown
end,
Mon = erlang:monitor(process, Pid),
exit(Pid,{testcase_aborted,Reason,Line}),
erlang:yield(),
From ! {self(),abort_current_testcase,ok},
St = receive
{'DOWN', Mon, process, Pid, _} ->
St0
after 10000 ->
%% Pid is probably trapping exits, hit it harder...
exit(Pid, kill),
%% here's the only place we know Reason, so we save
%% it as a comment, potentially replacing user data
Error = lists:flatten(io_lib:format("Aborted: ~p",
[Reason])),
Error1 = lists:flatten([string:strip(S,left) ||
S <- string:tokens(Error,
[$\n])]),
Comment = if length(Error1) > 63 ->
string:substr(Error1,1,60) ++ "...";
true ->
Error1
end,
St0#st{comment=Comment}
end,
run_test_case_msgloop(St);
{sync_apply,From,MFA} ->
do_sync_apply(false,From,MFA),
run_test_case_msgloop(St0);
{sync_apply_proxy,Proxy,From,MFA} ->
do_sync_apply(Proxy,From,MFA),
run_test_case_msgloop(St0);
{comment,NewComment0} ->
NewComment1 = test_server_ctrl:to_string(NewComment0),
NewComment = test_server_sup:framework_call(format_comment,
[NewComment1],
NewComment1),
run_test_case_msgloop(St0#st{comment=NewComment});
{read_comment,From} ->
From ! {self(),read_comment,St0#st.comment},
run_test_case_msgloop(St0);
{make_priv_dir,From} ->
Config = case St0#st.config of
undefined -> [];
Config0 -> Config0
end,
Result =
case proplists:get_value(priv_dir, Config) of
undefined ->
{error,no_priv_dir_in_config};
PrivDir ->
case file:make_dir(PrivDir) of
ok ->
ok;
{error, eexist} ->
ok;
MkDirError ->
{error,{MkDirError,PrivDir}}
end
end,
From ! {self(),make_priv_dir,Result},
run_test_case_msgloop(St0);
{'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} ->
RetVal = {Time/1000000,Value,Loc,Opts},
St = setup_termination(RetVal, St0#st{config=undefined}),
run_test_case_msgloop(St);
{'EXIT',Pid,Reason} ->
%% This exit typically happens when an unknown external process
%% has caused a test case process to terminate (e.g. if a linked
%% process has crashed).
St =
case Reason of
{What,[Loc0={_M,_F,A,[{file,_}|_]}|_]} when
is_integer(A) ->
Loc = rewrite_loc_item(Loc0),
handle_tc_exit(What, St0#st{last_known_loc=[Loc]});
{What,[Details,Loc0={_M,_F,A,[{file,_}|_]}|_]} when
is_integer(A) ->
Loc = rewrite_loc_item(Loc0),
handle_tc_exit({What,Details}, St0#st{last_known_loc=[Loc]});
_ ->
handle_tc_exit(Reason, St0)
end,
run_test_case_msgloop(St);
{EndConfPid0,{call_end_conf,Data,_Result}} ->
#st{mf={Mod,Func},config=CurrConf} = St0,
case CurrConf of
_ when is_list(CurrConf) ->
{_Mod,_Func,TCPid,TCExitReason,Loc} = Data,
spawn_fw_call(Mod,Func,CurrConf,TCPid,
TCExitReason,Loc,self()),
St = St0#st{config=undefined,end_conf_pid=undefined},
run_test_case_msgloop(St);
_ ->
run_test_case_msgloop(St0)
end;
{_FwCallPid,fw_notify_done,{T,Value,Loc,Opts,AddToComment}} ->
%% the framework has been notified, we're finished
RetVal = {T,Value,Loc,Opts},
Comment0 = St0#st.comment,
Comment = case AddToComment of
undefined ->
Comment0;
_ ->
if Comment0 =:= "" ->
AddToComment;
true ->
Comment0 ++
test_server_ctrl:xhtml("<br>",
"<br />") ++
AddToComment
end
end,
St = setup_termination(RetVal, St0#st{comment=Comment,
config=undefined}),
run_test_case_msgloop(St);
{'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} ->
%% a framework function failed
CB = os:getenv("TEST_SERVER_FRAMEWORK"),
Loc = case CB of
FW when FW =:= false; FW =:= "undefined" ->
[{test_server,Func}];
_ ->
[{list_to_atom(CB),Func}]
end,
RetVal = {died,{framework_error,Loc,Error},Loc},
St = setup_termination(RetVal, St0#st{comment="Framework error",
config=undefined}),
run_test_case_msgloop(St);
{failed,File,Line} ->
put(test_server_detected_fail,
[{File, Line}| get(test_server_detected_fail)]),
run_test_case_msgloop(St0);
{user_timetrap,Pid,_TrapTime,StartTime,E={user_timetrap_error,_},_} ->
case update_user_timetraps(Pid, StartTime) of
proceed ->
self() ! {abort_current_testcase,E,Pid};
ignore ->
ok
end,
run_test_case_msgloop(St0);
{user_timetrap,Pid,TrapTime,StartTime,ElapsedTime,Scale} ->
%% a user timetrap is triggered, ignore it if new
%% timetrap has been started since
case update_user_timetraps(Pid, StartTime) of
proceed ->
TotalTime = if is_integer(TrapTime) ->
TrapTime + ElapsedTime;
true ->
TrapTime
end,
timetrap(TrapTime, TotalTime, Pid, Scale);
ignore ->
ok
end,
run_test_case_msgloop(St0);
{timetrap_cancel_one,Handle,_From} ->
timetrap_cancel_one(Handle, false),
run_test_case_msgloop(St0);
{timetrap_cancel_all,TCPid,_From} ->
timetrap_cancel_all(TCPid, false),
run_test_case_msgloop(St0);
{get_timetrap_info,From,TCPid} ->
Info = get_timetrap_info(TCPid, false),
From ! {self(),get_timetrap_info,Info},
run_test_case_msgloop(St0);
_Other when not is_tuple(_Other) ->
%% ignore anything not generated by test server
run_test_case_msgloop(St0);
_Other when element(1, _Other) /= 'EXIT',
element(1, _Other) /= started,
element(1, _Other) /= finished,
element(1, _Other) /= print ->
%% ignore anything not generated by test server
run_test_case_msgloop(St0)
after St0#st.timeout ->
#st{ret_val=RetVal,comment=Comment} = St0,
erlang:append_element(RetVal, Comment)
end.
setup_termination(RetVal, #st{pid=Pid}=St) ->
timetrap_cancel_all(Pid, false),
St#st{ret_val=RetVal,timeout=20}.
set_tc_state(State) ->
set_tc_state(State,unknown).
set_tc_state(State, Config) ->
tc_supervisor_req(set_tc_state, {State,Config}).
handle_tc_exit(killed, St) ->
%% probably the result of an exit(TestCase,kill) call, which is the
%% only way to abort a testcase process that traps exits
%% (see abort_current_testcase).
#st{config=Config,mf={Mod,Func},pid=Pid} = St,
Msg = testcase_aborted_or_killed,
spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()),
St;
handle_tc_exit({testcase_aborted,{user_timetrap_error,_}=Msg,_}, St) ->
#st{config=Config,mf={Mod,Func},pid=Pid} = St,
spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()),
St;
handle_tc_exit(Reason, #st{status={framework,FwMod,FwFunc},
config=Config,pid=Pid}=St) ->
R = case Reason of
{timetrap_timeout,TVal,_} ->
{timetrap,TVal};
{testcase_aborted=E,AbortReason,_} ->
{E,AbortReason};
{fw_error,{FwMod,FwFunc,FwError}} ->
FwError;
Other ->
Other
end,
Error = {framework_error,R},
spawn_fw_call(FwMod, FwFunc, Config, Pid, Error, unknown, self()),
St;
handle_tc_exit(Reason, #st{status=tc,config=Config0,mf={Mod,Func},pid=Pid}=St)
when is_list(Config0) ->
{R,Loc1,F} = case Reason of
{timetrap_timeout=E,TVal,Loc0} ->
{{E,TVal},Loc0,E};
{testcase_aborted=E,AbortReason,Loc0} ->
Msg = {E,AbortReason},
{Msg,Loc0,Msg};
Other ->
{{'EXIT',Other},unknown,Other}
end,
Timeout = end_conf_timeout(Reason, St),
Config = [{tc_status,{failed,F}}|Config0],
EndConfPid = call_end_conf(Mod, Func, Pid, R, Loc1, Config, Timeout),
St#st{end_conf_pid=EndConfPid};
handle_tc_exit(Reason, #st{config=Config,mf={Mod,Func0},pid=Pid,
status=Status}=St) ->
{R,Loc1} = case Reason of
{timetrap_timeout=E,TVal,Loc0} ->
{{E,TVal},Loc0};
{testcase_aborted=E,AbortReason,Loc0} ->
{{E,AbortReason},Loc0};
Other ->
{{'EXIT',Other},St#st.last_known_loc}
end,
Func = case Status of
init_per_testcase=F -> {F,Func0};
end_per_testcase=F -> {F,Func0};
_ -> Func0
end,
spawn_fw_call(Mod, Func, Config, Pid, R, Loc1, self()),
St.
end_conf_timeout({timetrap_timeout,Timeout,_}, _) ->
Timeout;
end_conf_timeout(_, #st{config=Config}) when is_list(Config) ->
proplists:get_value(default_timeout, Config, ?DEFAULT_TIMETRAP_SECS*1000);
end_conf_timeout(_, _) ->
?DEFAULT_TIMETRAP_SECS*1000.
call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) ->
Starter = self(),
Data = {Mod,Func,TCPid,TCExitReason,Loc},
case erlang:function_exported(Mod,end_per_testcase,2) of
false ->
spawn_link(fun() ->
Starter ! {self(),{call_end_conf,Data,ok}}
end);
true ->
do_call_end_conf(Starter,Mod,Func,Data,Conf,TVal)
end.
do_call_end_conf(Starter,Mod,Func,Data,Conf,TVal) ->
EndConfProc =
fun() ->
process_flag(trap_exit,true), % to catch timetraps
Supervisor = self(),
EndConfApply =
fun() ->
timetrap(TVal),
try apply(Mod,end_per_testcase,[Func,Conf]) of
_ -> ok
catch
_:Why ->
timer:sleep(1),
group_leader() ! {printout,12,
"WARNING! "
"~w:end_per_testcase(~w, ~p)"
" crashed!\n\tReason: ~p\n",
[Mod,Func,Conf,Why]}
end,
Supervisor ! {self(),end_conf}
end,
Pid = spawn_link(EndConfApply),
receive
{Pid,end_conf} ->
Starter ! {self(),{call_end_conf,Data,ok}};
{'EXIT',Pid,Reason} ->
group_leader() ! {printout,12,
"WARNING! ~w:end_per_testcase(~w, ~p)"
" failed!\n\tReason: ~p\n",
[Mod,Func,Conf,Reason]},
Starter ! {self(),{call_end_conf,Data,{error,Reason}}};
{'EXIT',_OtherPid,Reason} ->
%% Probably the parent - not much to do about that
exit(Reason)
end
end,
spawn_link(EndConfProc).
spawn_fw_call(Mod,{init_per_testcase,Func},CurrConf,Pid,
{timetrap_timeout,TVal}=Why,
Loc,SendTo) ->
FwCall =
fun() ->
Skip = {skip,{failed,{Mod,init_per_testcase,Why}}},
%% if init_per_testcase fails, the test case
%% should be skipped
try do_end_tc_call(Mod,Func, {Pid,Skip,[CurrConf]}, Why) of
_ -> ok
catch
_:FwEndTCErr ->
exit({fw_notify_done,end_tc,FwEndTCErr})
end,
%% finished, report back
SendTo ! {self(),fw_notify_done,
{TVal/1000,Skip,Loc,[],undefined}}
end,
spawn_link(FwCall);
spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid,
{timetrap_timeout,TVal}=Why,_Loc,SendTo) ->
FwCall =
fun() ->
{RetVal,Report} =
case proplists:get_value(tc_status, EndConf) of
undefined ->
E = {failed,{Mod,end_per_testcase,Why}},
{E,E};
E = {failed,Reason} ->
{E,{error,Reason}};
Result ->
E = {failed,{Mod,end_per_testcase,Why}},
{Result,E}
end,
group_leader() ! {printout,12,
"WARNING! ~w:end_per_testcase(~w, ~p)"
" failed!\n\tReason: timetrap timeout"
" after ~w ms!\n", [Mod,Func,EndConf,TVal]},
FailLoc = proplists:get_value(tc_fail_loc, EndConf),
try do_end_tc_call(Mod,Func,
{Pid,Report,[EndConf]}, Why) of
_ -> ok
catch
_:FwEndTCErr ->
exit({fw_notify_done,end_tc,FwEndTCErr})
end,
Warn = "<font color=\"red\">"
"WARNING: end_per_testcase timed out!</font>",
%% finished, report back (if end_per_testcase fails, a warning
%% should be printed as part of the comment)
SendTo ! {self(),fw_notify_done,
{TVal/1000,RetVal,FailLoc,[],Warn}}
end,
spawn_link(FwCall);
spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) ->
FwCall =
fun() ->
test_server_sup:framework_call(report, [framework_error,
{{FwMod,FwFunc},
FwError}]),
Comment =
lists:flatten(
io_lib:format("<font color=\"red\">"
"WARNING! ~w:~w failed!</font>",
[FwMod,FwFunc])),
%% finished, report back
SendTo ! {self(),fw_notify_done,
{died,{error,{FwMod,FwFunc,FwError}},
{FwMod,FwFunc},[],Comment}}
end,
spawn_link(FwCall);
spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) ->
Func1 = case Func of
{_InitOrEndPerTC,F} -> F;
F -> F
end,
FwCall =
fun() ->
try fw_error_notify(Mod,Func1,[],
Error,Loc) of
_ -> ok
catch
_:FwErrorNotifyErr ->
exit({fw_notify_done,error_notification,
FwErrorNotifyErr})
end,
Conf = [{tc_status,{failed,Error}}|CurrConf],
try do_end_tc_call(Mod,Func1,
{Pid,Error,[Conf]},Error) of
_ -> ok
catch
_:FwEndTCErr ->
exit({fw_notify_done,end_tc,FwEndTCErr})
end,
%% finished, report back
SendTo ! {self(),fw_notify_done,{died,Error,Loc,[],undefined}}
end,
spawn_link(FwCall).
%% The job proxy process forwards messages between the test case
%% process on a shielded node (and its descendants) and the job process.
%%
%% The job proxy process have to be started by the test-case process
%% on the shielded node!
start_job_proxy() ->
group_leader(spawn(fun () -> job_proxy_msgloop() end), self()), ok.
%% The io_reply_proxy is not the most satisfying solution but it works...
io_reply_proxy(ReplyTo) ->
receive
IoReply when is_tuple(IoReply),
element(1, IoReply) == io_reply ->
ReplyTo ! IoReply;
_ ->
io_reply_proxy(ReplyTo)
end.
job_proxy_msgloop() ->
receive
%%
%% Messages that need intervention by proxy...
%%
%% io stuff ...
IoReq when tuple_size(IoReq) >= 2,
element(1, IoReq) == io_request ->
ReplyProxy = spawn(fun () -> io_reply_proxy(element(2, IoReq)) end),
group_leader() ! setelement(2, IoReq, ReplyProxy);
%% test_server stuff...
{sync_apply, From, MFA} ->
group_leader() ! {sync_apply_proxy, self(), From, MFA};
{sync_result_proxy, To, Result} ->
To ! {sync_result, Result};
%%
%% Messages that need no intervention by proxy...
%%
Msg ->
group_leader() ! Msg
end,
job_proxy_msgloop().
%% A test case is known to have failed if it returns {'EXIT', _} tuple,
%% or sends a message {failed, File, Line} to it's group_leader
run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit,
TimetrapData, LogOpts, TCCallback) ->
put(test_server_multiply_timetraps, TimetrapData),
put(test_server_logopts, LogOpts),
Where = [{Mod,Func}],
put(test_server_loc, Where),
FWInitResult = test_server_sup:framework_call(init_tc,[Mod,Func,Args0],
{ok,Args0}),
set_tc_state(running),
{{Time,Value},Loc,Opts} =
case FWInitResult of
{ok,Args} ->
run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback);
Error = {error,_Reason} ->
NewResult = do_end_tc_call(Mod,Func, {Error,Args0},
{auto_skip,{failed,Error}}),
{{0,NewResult},Where,[]};
{fail,Reason} ->
Conf = [{tc_status,{failed,Reason}} | hd(Args0)],
fw_error_notify(Mod, Func, Conf, Reason),
NewResult = do_end_tc_call(Mod,Func, {{error,Reason},[Conf]},
{fail,Reason}),
{{0,NewResult},Where,[]};
Skip = {SkipType,_Reason} when SkipType == skip;
SkipType == skipped ->
NewResult = do_end_tc_call(Mod,Func,
{Skip,Args0}, Skip),
{{0,NewResult},Where,[]};
AutoSkip = {auto_skip,_Reason} ->
%% special case where a conf case "pretends" to be skipped
NewResult =
do_end_tc_call(Mod,Func, {AutoSkip,Args0}, AutoSkip),
{{0,NewResult},Where,[]}
end,
exit({Ref,Time,Value,Loc,Opts}).
run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) ->
case RunInit of
run_init ->
set_tc_state(init_per_testcase, hd(Args)),
ensure_timetrap(Args),
case init_per_testcase(Mod, Func, Args) of
Skip = {SkipType,Reason} when SkipType == skip;
SkipType == skipped ->
Line = get_loc(),
Conf = [{tc_status,{skipped,Reason}}|hd(Args)],
NewRes = do_end_tc_call(Mod,Func,
{Skip,[Conf]}, Skip),
{{0,NewRes},Line,[]};
{skip_and_save,Reason,SaveCfg} ->
Line = get_loc(),
Conf = [{tc_status,{skipped,Reason}},
{save_config,SaveCfg}|hd(Args)],
NewRes = do_end_tc_call(Mod,Func, {{skip,Reason},[Conf]},
{skip,Reason}),
{{0,NewRes},Line,[]};
FailTC = {fail,Reason} -> % user fails the testcase
EndConf = [{tc_status,{failed,Reason}} | hd(Args)],
fw_error_notify(Mod, Func, EndConf, Reason),
NewRes = do_end_tc_call(Mod,Func,
{{error,Reason},[EndConf]},
FailTC),
{{0,NewRes},[{Mod,Func}],[]};
{ok,NewConf} ->
%% call user callback function if defined
NewConf1 =
user_callback(TCCallback, Mod, Func, init, NewConf),
%% save current state in controller loop
set_tc_state(tc, NewConf1),
%% execute the test case
{{T,Return},Loc} = {ts_tc(Mod,Func,[NewConf1]), get_loc()},
{EndConf,TSReturn,FWReturn} =
case Return of
{E,TCError} when E=='EXIT' ; E==failed ->
fw_error_notify(Mod, Func, NewConf1,
TCError, Loc),
{[{tc_status,{failed,TCError}},
{tc_fail_loc,Loc}|NewConf1],
Return,{error,TCError}};
SaveCfg={save_config,_} ->
{[{tc_status,ok},SaveCfg|NewConf1],Return,ok};
{skip_and_save,Why,SaveCfg} ->
Skip = {skip,Why},
{[{tc_status,{skipped,Why}},
{save_config,SaveCfg}|NewConf1],
Skip,Skip};
{SkipType,Why} when SkipType == skip;
SkipType == skipped ->
{[{tc_status,{skipped,Why}}|NewConf1],Return,
Return};
_ ->
{[{tc_status,ok}|NewConf1],Return,ok}
end,
%% call user callback function if defined
EndConf1 =
user_callback(TCCallback, Mod, Func, 'end', EndConf),
%% update current state in controller loop
{FWReturn1,TSReturn1,EndConf2} =
case end_per_testcase(Mod, Func, EndConf1) of
SaveCfg1={save_config,_} ->
{FWReturn,TSReturn,
[SaveCfg1|lists:keydelete(save_config,1,
EndConf1)]};
{fail,ReasonToFail} ->
%% user has failed the testcase
fw_error_notify(Mod, Func, EndConf1,
ReasonToFail),
{{error,ReasonToFail},
{failed,ReasonToFail},
EndConf1};
{failed,{_,end_per_testcase,_}} = Failure when
FWReturn == ok ->
%% unexpected termination in end_per_testcase
%% report this as the result to the framework
{Failure,TSReturn,EndConf1};
_ ->
%% test case result should be reported to
%% framework no matter the status of
%% end_per_testcase
{FWReturn,TSReturn,EndConf1}
end,
%% clear current state in controller loop
case do_end_tc_call(Mod,Func,
{FWReturn1,[EndConf2]}, TSReturn1) of
{failed,Reason} = NewReturn ->
fw_error_notify(Mod,Func,EndConf2, Reason),
{{T,NewReturn},[{Mod,Func}],[]};
NewReturn ->
{{T,NewReturn},Loc,[]}
end
end;
skip_init ->
set_tc_state(running, hd(Args)),
%% call user callback function if defined
Args1 = user_callback(TCCallback, Mod, Func, init, Args),
ensure_timetrap(Args1),
%% ts_tc does a catch
%% if this is a named conf group, the test case (init or end conf)
%% should be called with the name as the first argument
Args2 = if Name == undefined -> Args1;
true -> [Name | Args1]
end,
%% execute the conf test case
{{T,Return},Loc} = {ts_tc(Mod, Func, Args2),get_loc()},
%% call user callback function if defined
Return1 = user_callback(TCCallback, Mod, Func, 'end', Return),
{Return2,Opts} = process_return_val([Return1], Mod, Func,
Args1, [{Mod,Func}], Return1),
{{T,Return2},Loc,Opts}
end.
do_end_tc_call(Mod, Func, Res, Return) ->
FwMod = os:getenv("TEST_SERVER_FRAMEWORK"),
Ref = make_ref(),
if FwMod == "ct_framework" ; FwMod == "undefined"; FwMod == false ->
case test_server_sup:framework_call(
end_tc, [Mod,Func,Res, Return], ok) of
{fail,FWReason} ->
{failed,FWReason};
ok ->
case Return of
{fail,Reason} ->
{failed,Reason};
Return ->
Return
end;
NewReturn ->
NewReturn
end;
true ->
case test_server_sup:framework_call(FwMod, end_tc,
[Mod,Func,Res], Ref) of
{fail,FWReason} ->
{failed,FWReason};
_Else ->
Return
end
end.
%% the return value is a list and we have to check if it contains
%% the result of an end conf case or if it's a Config list
process_return_val([Return], M,F,A, Loc, Final) when is_list(Return) ->
ReturnTags = [skip,skip_and_save,save_config,comment,return_group_result],
%% check if all elements in the list are valid end conf return value tuples
case lists:all(fun(Val) when is_tuple(Val) ->
lists:any(fun(T) -> T == element(1, Val) end,
ReturnTags);
(ok) ->
true;
(_) ->
false
end, Return) of
true -> % must be return value from end conf case
process_return_val1(Return, M,F,A, Loc, Final, []);
false -> % must be Config value from init conf case
case do_end_tc_call(M, F, {ok,A}, Return) of
{failed, FWReason} = Failed ->
fw_error_notify(M,F,A, FWReason),
{Failed, []};
NewReturn ->
{NewReturn, []}
end
end;
%% the return value is not a list, so it's the return value from an
%% end conf case or it's a dummy value that can be ignored
process_return_val(Return, M,F,A, Loc, Final) ->
process_return_val1(Return, M,F,A, Loc, Final, []).
process_return_val1([Failed={E,TCError}|_], M,F,A=[Args], Loc, _, SaveOpts)
when E=='EXIT';
E==failed ->
fw_error_notify(M,F,A, TCError, Loc),
case do_end_tc_call(M,F, {{error,TCError},
[[{tc_status,{failed,TCError}}|Args]]},
Failed) of
{failed,FWReason} ->
{{failed,FWReason},SaveOpts};
NewReturn ->
{NewReturn,SaveOpts}
end;
process_return_val1([SaveCfg={save_config,_}|Opts], M,F,[Args],
Loc, Final, SaveOpts) ->
process_return_val1(Opts, M,F,[[SaveCfg|Args]], Loc, Final, SaveOpts);
process_return_val1([{skip_and_save,Why,SaveCfg}|Opts], M,F,[Args],
Loc, _, SaveOpts) ->
process_return_val1(Opts, M,F,[[{save_config,SaveCfg}|Args]],
Loc, {skip,Why}, SaveOpts);
process_return_val1([GR={return_group_result,_}|Opts], M,F,A,
Loc, Final, SaveOpts) ->
process_return_val1(Opts, M,F,A, Loc, Final, [GR|SaveOpts]);
process_return_val1([RetVal={Tag,_}|Opts], M,F,A,
Loc, _, SaveOpts) when Tag==skip;
Tag==comment ->
process_return_val1(Opts, M,F,A, Loc, RetVal, SaveOpts);
process_return_val1([_|Opts], M,F,A, Loc, Final, SaveOpts) ->
process_return_val1(Opts, M,F,A, Loc, Final, SaveOpts);
process_return_val1([], M,F,A, _Loc, Final, SaveOpts) ->
case do_end_tc_call(M,F, {Final,A}, Final) of
{failed,FWReason} ->
{{failed,FWReason},SaveOpts};
NewReturn ->
{NewReturn,lists:reverse(SaveOpts)}
end.
user_callback(undefined, _, _, _, Args) ->
Args;
user_callback({CBMod,CBFunc}, Mod, Func, InitOrEnd,
[Args]) when is_list(Args) ->
case catch apply(CBMod, CBFunc, [InitOrEnd,Mod,Func,Args]) of
Args1 when is_list(Args1) ->
[Args1];
_ ->
[Args]
end;
user_callback({CBMod,CBFunc}, Mod, Func, InitOrEnd, Args) ->
case catch apply(CBMod, CBFunc, [InitOrEnd,Mod,Func,Args]) of
Args1 when is_list(Args1) ->
Args1;
_ ->
Args
end.
init_per_testcase(Mod, Func, Args) ->
case code:is_loaded(Mod) of
false -> code:load_file(Mod);
_ -> ok
end,
case erlang:function_exported(Mod, init_per_testcase, 2) of
true ->
do_init_per_testcase(Mod, [Func|Args]);
false ->
%% Optional init_per_testcase is not defined -- keep quiet.
[Config] = Args,
{ok, Config}
end.
do_init_per_testcase(Mod, Args) ->
try apply(Mod, init_per_testcase, Args) of
{Skip,Reason} when Skip =:= skip; Skip =:= skipped ->
{skip,Reason};
{skip_and_save,_,_}=Res ->
Res;
NewConf when is_list(NewConf) ->
case lists:filter(fun(T) when is_tuple(T) -> false;
(_) -> true end, NewConf) of
[] ->
{ok,NewConf};
Bad ->
group_leader() ! {printout,12,
"ERROR! init_per_testcase has returned "
"bad elements in Config: ~p\n",[Bad]},
{skip,{failed,{Mod,init_per_testcase,bad_return}}}
end;
{fail,_Reason}=Res ->
Res;
_Other ->
group_leader() ! {printout,12,
"ERROR! init_per_testcase did not return "
"a Config list.\n",[]},
{skip,{failed,{Mod,init_per_testcase,bad_return}}}
catch
throw:{Skip,Reason} when Skip =:= skip; Skip =:= skipped ->
{skip,Reason};
exit:{Skip,Reason} when Skip =:= skip; Skip =:= skipped ->
{skip,Reason};
throw:Other ->
set_loc(erlang:get_stacktrace()),
Line = get_loc(),
FormattedLoc = test_server_sup:format_loc(Line),
group_leader() ! {printout,12,
"ERROR! init_per_testcase thrown!\n"
"\tLocation: ~ts\n\tReason: ~p\n",
[FormattedLoc, Other]},
{skip,{failed,{Mod,init_per_testcase,Other}}};
_:Reason0 ->
Stk = erlang:get_stacktrace(),
Reason = {Reason0,Stk},
set_loc(Stk),
Line = get_loc(),
FormattedLoc = test_server_sup:format_loc(Line),
group_leader() ! {printout,12,
"ERROR! init_per_testcase crashed!\n"
"\tLocation: ~ts\n\tReason: ~p\n",
[FormattedLoc,Reason]},
{skip,{failed,{Mod,init_per_testcase,Reason}}}
end.
end_per_testcase(Mod, Func, Conf) ->
case erlang:function_exported(Mod,end_per_testcase,2) of
true ->
do_end_per_testcase(Mod,end_per_testcase,Func,Conf);
false ->
%% Backwards compatibility!
case erlang:function_exported(Mod,fin_per_testcase,2) of
true ->
do_end_per_testcase(Mod,fin_per_testcase,Func,Conf);
false ->
ok
end
end.
do_end_per_testcase(Mod,EndFunc,Func,Conf) ->
set_tc_state(end_per_testcase, Conf),
try Mod:EndFunc(Func, Conf) of
{save_config,_}=SaveCfg ->
SaveCfg;
{fail,_}=Fail ->
Fail;
_ ->
ok
catch
throw:Other ->
Comment0 = case read_comment() of
"" -> "";
Cmt -> Cmt ++ test_server_ctrl:xhtml("<br>",
"<br />")
end,
set_loc(erlang:get_stacktrace()),
comment(io_lib:format("~ts<font color=\"red\">"
"WARNING: ~w thrown!"
"</font>\n",[Comment0,EndFunc])),
group_leader() ! {printout,12,
"WARNING: ~w thrown!\n"
"Reason: ~p\n"
"Line: ~ts\n",
[EndFunc, Other,
test_server_sup:format_loc(get_loc())]},
{failed,{Mod,end_per_testcase,Other}};
Class:Reason ->
Stk = erlang:get_stacktrace(),
set_loc(Stk),
Why = case Class of
exit -> {'EXIT',Reason};
error -> {'EXIT',{Reason,Stk}}
end,
Comment0 = case read_comment() of
"" -> "";
Cmt -> Cmt ++ test_server_ctrl:xhtml("<br>",
"<br />")
end,
comment(io_lib:format("~ts<font color=\"red\">"
"WARNING: ~w crashed!"
"</font>\n",[Comment0,EndFunc])),
group_leader() ! {printout,12,
"WARNING: ~w crashed!\n"
"Reason: ~p\n"
"Line: ~ts\n",
[EndFunc, Reason,
test_server_sup:format_loc(get_loc())]},
{failed,{Mod,end_per_testcase,Why}}
end.
get_loc() ->
get(test_server_loc).
get_loc(Pid) ->
[{current_stacktrace,Stk0},{dictionary,Dict}] =
process_info(Pid, [current_stacktrace,dictionary]),
lists:foreach(fun({Key,Val}) -> put(Key, Val) end, Dict),
Stk = [rewrite_loc_item(Loc) || Loc <- Stk0],
case get(test_server_loc) of
[{Suite,Case}] ->
%% Location info unknown, check if {Suite,Case,Line}
%% is available in stacktrace and if so, use stacktrace
%% instead of current test_server_loc.
%% If location is the last expression in a test case
%% function, the info is not available due to tail call
%% elimination. We need to check if the test case has been
%% called by ts_tc/3 and, if so, insert the test case info
%% at that position.
case [match || {S,C,_L} <- Stk, S == Suite, C == Case] of
[match|_] ->
put(test_server_loc, Stk);
_ ->
{PreTC,PostTC} =
lists:splitwith(fun({test_server,ts_tc,_}) ->
false;
(_) ->
true
end, Stk),
if PostTC == [] ->
ok;
true ->
put(test_server_loc,
PreTC++[{Suite,Case,last_expr} | PostTC])
end
end;
_ ->
put(test_server_loc, Stk)
end,
get_loc().
fw_error_notify(Mod, Func, Args, Error) ->
test_server_sup:framework_call(error_notification,
[Mod,Func,[Args],
{Error,unknown}]).
fw_error_notify(Mod, Func, Args, Error, Loc) ->
test_server_sup:framework_call(error_notification,
[Mod,Func,[Args],
{Error,Loc}]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% print(Detail,Format,Args,Printer) -> ok
%% Detail = integer()
%% Format = string()
%% Args = [term()]
%%
%% Just like io:format, except that depending on the Detail value, the output
%% is directed to console, major and/or minor log files.
%% print(Detail,Format,Args) ->
%% test_server_ctrl:print(Detail, Format, Args).
print(Detail,Format,Args,Printer) ->
test_server_ctrl:print(Detail, Format, Args, Printer).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% print_timsteamp(Detail,Leader) -> ok
%%
%% Prints Leader followed by a time stamp (date and time). Depending on
%% the Detail value, the output is directed to console, major and/or minor
%% log files.
print_timestamp(Detail,Leader) ->
test_server_ctrl:print_timestamp(Detail, Leader).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% lookup_config(Key,Config) -> {value,{Key,Value}} | undefined
%% Key = term()
%% Value = term()
%% Config = [{Key,Value},...]
%%
%% Looks up a specific key in the config list, and returns the value
%% of the associated key, or undefined if the key doesn't exist.
lookup_config(Key,Config) ->
case lists:keysearch(Key,1,Config) of
{value,{Key,Val}} ->
Val;
_ ->
io:format("Could not find element ~p in Config.~n",[Key]),
undefined
end.
%%
%% IMPORTANT: get_loc/1 uses the name of this function when analysing
%% stack traces. If the name changes, get_loc/1 must be updated!
%%
ts_tc(M, F, A) ->
Before = erlang:now(),
Result = try
apply(M, F, A)
catch
throw:{skip, Reason} -> {skip, Reason};
throw:{skipped, Reason} -> {skip, Reason};
exit:{skip, Reason} -> {skip, Reason};
exit:{skipped, Reason} -> {skip, Reason};
Type:Reason ->
Stk = erlang:get_stacktrace(),
set_loc(Stk),
case Type of
throw ->
{failed,{thrown,Reason}};
error ->
{'EXIT',{Reason,Stk}};
exit ->
{'EXIT',Reason}
end
end,
After = erlang:now(),
Elapsed =
(element(1,After)*1000000000000
+element(2,After)*1000000+element(3,After)) -
(element(1,Before)*1000000000000
+element(2,Before)*1000000+element(3,Before)),
{Elapsed, Result}.
set_loc(Stk) ->
Loc = case [rewrite_loc_item(I) || {_,_,_,_}=I <- Stk] of
[{M,F,0}|Stack] ->
[{M,F}|Stack];
Other ->
Other
end,
put(test_server_loc, Loc).
rewrite_loc_item({M,F,_,Loc}) ->
{M,F,proplists:get_value(line, Loc, 0)}.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% TEST SUITE SUPPORT FUNCTIONS %%
%% %%
%% Note: Some of these functions have been moved to test_server_sup %%
%% in an attempt to keep this modules small (yeah, right!) %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% format(Format) -> IoLibReturn
%% format(Detail,Format) -> IoLibReturn
%% format(Format,Args) -> IoLibReturn
%% format(Detail,Format,Args) -> IoLibReturn
%% Detail = integer()
%% Format = string()
%% Args = [term(),...]
%% IoLibReturn = term()
%%
%% Logs the Format string and Args, similar to io:format/1/2 etc. If
%% Detail is not specified, the default detail level (which is 50) is used.
%% Which log files the string will be logged in depends on the thresholds
%% set with set_levels/3. Typically with default detail level, only the
%% minor log file is used.
format(Format) ->
format(minor, Format, []).
format(major, Format) ->
format(major, Format, []);
format(minor, Format) ->
format(minor, Format, []);
format(Detail, Format) when is_integer(Detail) ->
format(Detail, Format, []);
format(Format, Args) ->
format(minor, Format, Args).
format(Detail, Format, Args) ->
Str =
case catch io_lib:format(Format,Args) of
{'EXIT',_} ->
io_lib:format("illegal format; ~p with args ~p.\n",
[Format,Args]);
Valid -> Valid
end,
log({Detail, Str}).
log(Msg) ->
group_leader() ! {structured_io, self(), Msg},
ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% capture_start() -> ok
%% capture_stop() -> ok
%%
%% Starts/stops capturing all output from io:format, and similar. Capturing
%% output doesn't stop output from happening. It just makes it possible
%% to retrieve the output using capture_get/0.
%% Starting and stopping capture doesn't affect already captured output.
%% All output is stored as messages in the message queue until retrieved
capture_start() ->
group_leader() ! {capture,self()},
ok.
capture_stop() ->
group_leader() ! {capture,false},
ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% capture_get() -> Output
%% Output = [string(),...]
%%
%% Retrieves all the captured output since last call to capture_get/0.
%% Note that since output arrive as messages to the process, it takes
%% a short while from the call to io:format until all output is available
%% by capture_get/0. It is not necessary to call capture_stop/0 before
%% retreiving the output.
capture_get() ->
test_server_sup:capture_get([]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% messages_get() -> Messages
%% Messages = [term(),...]
%%
%% Returns all messages in the message queue.
messages_get() ->
test_server_sup:messages_get([]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% permit_io(GroupLeader, FromPid) -> ok
%%
%% Make sure proceeding IO from FromPid won't get rejected
permit_io(GroupLeader, FromPid) ->
GroupLeader ! {permit_io,FromPid}.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% sleep(Time) -> ok
%% Time = integer() | float() | infinity
%%
%% Sleeps the specified number of milliseconds. This sleep also accepts
%% floating point numbers (which are truncated) and the atom 'infinity'.
sleep(infinity) ->
receive
after infinity ->
ok
end;
sleep(MSecs) ->
receive
after trunc(MSecs) ->
ok
end,
ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% adjusted_sleep(Time) -> ok
%% Time = integer() | float() | infinity
%%
%% Sleeps the specified number of milliseconds, multiplied by the
%% 'multiply_timetraps' value (if set) and possibly also automatically scaled
%% up if 'scale_timetraps' is set to true (which is default).
%% This function also accepts floating point numbers (which are truncated) and
%% the atom 'infinity'.
adjusted_sleep(infinity) ->
receive
after infinity ->
ok
end;
adjusted_sleep(MSecs) ->
{Multiplier,ScaleFactor} =
case test_server_ctrl:get_timetrap_parameters() of
{undefined,undefined} ->
{1,1};
{undefined,false} ->
{1,1};
{undefined,true} ->
{1,timetrap_scale_factor()};
{infinity,_} ->
{infinity,1};
{Mult,undefined} ->
{Mult,1};
{Mult,false} ->
{Mult,1};
{Mult,true} ->
{Mult,timetrap_scale_factor()}
end,
receive
after trunc(MSecs*Multiplier*ScaleFactor) ->
ok
end,
ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% fail(Reason) -> exit({suite_failed,Reason})
%%
%% Immediately calls exit. Included because test suites are easier
%% to read when using this function, rather than exit directly.
fail(Reason) ->
comment(cast_to_list(Reason)),
try
exit({suite_failed,Reason})
catch
Class:R ->
case erlang:get_stacktrace() of
[{?MODULE,fail,1,_}|Stk] -> ok;
Stk -> ok
end,
erlang:raise(Class, R, Stk)
end.
cast_to_list(X) when is_list(X) -> X;
cast_to_list(X) when is_atom(X) -> atom_to_list(X);
cast_to_list(X) -> lists:flatten(io_lib:format("~p", [X])).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% fail() -> exit(suite_failed)
%%
%% Immediately calls exit. Included because test suites are easier
%% to read when using this function, rather than exit directly.
fail() ->
try
exit(suite_failed)
catch
Class:R ->
case erlang:get_stacktrace() of
[{?MODULE,fail,0,_}|Stk] -> ok;
Stk -> ok
end,
erlang:raise(Class, R, Stk)
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% break(Comment) -> ok
%%
%% Break a test case so part of the test can be done manually.
%% Use continue/0 to continue.
break(Comment) ->
break(?MODULE, Comment).
break(CBM, Comment) ->
break(CBM, '', Comment).
break(CBM, TestCase, Comment) ->
timetrap_cancel(),
{TCName,CntArg,PName} =
if TestCase == '' ->
{"", "", test_server_break_process};
true ->
Str = atom_to_list(TestCase),
{[32 | Str], Str,
list_to_atom("test_server_break_process_" ++ Str)}
end,
io:format(user,
"\n\n\n--- SEMIAUTOMATIC TESTING ---"
"\nThe test case~ts executes on process ~w"
"\n\n\n~ts"
"\n\n\n-----------------------------\n\n"
"Continue with --> ~w:continue(~ts).\n",
[TCName,self(),Comment,CBM,CntArg]),
case whereis(PName) of
undefined ->
spawn_break_process(self(), PName);
OldBreakProcess ->
OldBreakProcess ! cancel,
spawn_break_process(self(), PName)
end,
receive continue -> ok end.
spawn_break_process(Pid, PName) ->
spawn(fun() ->
register(PName, self()),
receive
continue -> continue(Pid);
cancel -> ok
end
end).
continue() ->
case whereis(test_server_break_process) of
undefined -> ok;
BreakProcess -> BreakProcess ! continue
end.
continue(TestCase) when is_atom(TestCase) ->
PName = list_to_atom("test_server_break_process_" ++
atom_to_list(TestCase)),
case whereis(PName) of
undefined -> ok;
BreakProcess -> BreakProcess ! continue
end;
continue(Pid) when is_pid(Pid) ->
Pid ! continue.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timetrap_scale_factor() -> Factor
%%
%% Returns the amount to scale timetraps with.
%% {X, fun() -> check() end} <- multiply scale with X if Fun() is true
timetrap_scale_factor() ->
timetrap_scale_factor([
{ 2, fun() -> has_lock_checking() end},
{ 3, fun() -> has_superfluous_schedulers() end},
{ 5, fun() -> purify_is_running() end},
{ 6, fun() -> is_debug() end},
{10, fun() -> is_cover() end}
]).
timetrap_scale_factor(Scales) ->
%% The fun in {S, Fun} a filter input to the list comprehension
lists:foldl(fun(S,O) -> O*S end, 1, [ S || {S,F} <- Scales, F()]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timetrap(Timeout) -> Handle
%% Handle = term()
%%
%% Creates a time trap, that will kill the calling process if the
%% trap is not cancelled with timetrap_cancel/1, within Timeout milliseconds.
timetrap(Timeout) ->
MultAndScale =
case get(test_server_multiply_timetraps) of
undefined -> {fun(T) -> T end, true};
{undefined,false} -> {fun(T) -> T end, false};
{undefined,_} -> {fun(T) -> T end, true};
{infinity,_} -> {fun(_) -> infinity end, false};
{Int,Scale} -> {fun(infinity) -> infinity;
(T) -> T*Int end, Scale}
end,
timetrap(Timeout, Timeout, self(), MultAndScale).
%% when the function is called from different process than
%% the test case, the test_server_multiply_timetraps data
%% is unknown and must be passed as argument
timetrap(Timeout, TCPid, MultAndScale) ->
timetrap(Timeout, Timeout, TCPid, MultAndScale).
timetrap(Timeout0, TimeToReport0, TCPid, MultAndScale = {Multiplier,Scale}) ->
%% the time_ms call will either convert Timeout to ms or spawn a
%% user timetrap which sends the result to the IO server process
Timeout = time_ms(Timeout0, TCPid, MultAndScale),
Timeout1 = Multiplier(Timeout),
TimeToReport = if Timeout0 == TimeToReport0 ->
Timeout1;
true ->
%% only convert to ms, don't start a
%% user timetrap
time_ms_check(TimeToReport0)
end,
cancel_default_timetrap(self() == TCPid),
Handle = case Timeout1 of
infinity ->
infinity;
_ ->
spawn_link(test_server_sup,timetrap,[Timeout1,TimeToReport,
Scale,TCPid])
end,
%% ERROR! This sets dict on IO process instead of testcase process
%% if Timeout is return value from previous user timetrap!!
case get(test_server_timetraps) of
undefined ->
put(test_server_timetraps,[{Handle,TCPid,{TimeToReport,Scale}}]);
List ->
List1 = lists:delete({infinity,TCPid,{infinity,false}}, List),
put(test_server_timetraps,[{Handle,TCPid,
{TimeToReport,Scale}}|List1])
end,
Handle.
ensure_timetrap(Config) ->
case get(test_server_timetraps) of
[_|_] ->
ok;
_ ->
case get(test_server_default_timetrap) of
undefined -> ok;
Garbage ->
erase(test_server_default_timetrap),
format("=== WARNING: garbage in "
"test_server_default_timetrap: ~p~n",
[Garbage])
end,
DTmo = case lists:keysearch(default_timeout,1,Config) of
{value,{default_timeout,Tmo}} -> Tmo;
_ -> ?DEFAULT_TIMETRAP_SECS
end,
format("=== test_server setting default "
"timetrap of ~p seconds~n",
[DTmo]),
put(test_server_default_timetrap, timetrap(seconds(DTmo)))
end.
%% executing on IO process, no default timetrap ever set here
cancel_default_timetrap(false) ->
ok;
cancel_default_timetrap(true) ->
case get(test_server_default_timetrap) of
undefined ->
ok;
TimeTrap when is_pid(TimeTrap) ->
timetrap_cancel(TimeTrap),
erase(test_server_default_timetrap),
format("=== test_server canceled default timetrap "
"since another timetrap was set~n"),
ok;
Garbage ->
erase(test_server_default_timetrap),
format("=== WARNING: garbage in "
"test_server_default_timetrap: ~p~n",
[Garbage]),
error
end.
time_ms({hours,N}, _, _) -> hours(N);
time_ms({minutes,N}, _, _) -> minutes(N);
time_ms({seconds,N}, _, _) -> seconds(N);
time_ms({Other,_N}, _, _) ->
format("=== ERROR: Invalid time specification: ~p. "
"Should be seconds, minutes, or hours.~n", [Other]),
exit({invalid_time_format,Other});
time_ms(Ms, _, _) when is_integer(Ms) -> Ms;
time_ms(infinity, _, _) -> infinity;
time_ms(Fun, TCPid, MultAndScale) when is_function(Fun) ->
time_ms_apply(Fun, TCPid, MultAndScale);
time_ms({M,F,A}=MFA, TCPid, MultAndScale) when is_atom(M),
is_atom(F),
is_list(A) ->
time_ms_apply(MFA, TCPid, MultAndScale);
time_ms(Other, _, _) -> exit({invalid_time_format,Other}).
time_ms_check(MFA = {M,F,A}) when is_atom(M), is_atom(F), is_list(A) ->
MFA;
time_ms_check(Fun) when is_function(Fun) ->
Fun;
time_ms_check(Other) ->
time_ms(Other, undefined, undefined).
time_ms_apply(Func, TCPid, MultAndScale) ->
{_,GL} = process_info(TCPid, group_leader),
WhoAmI = self(), % either TC or IO server
T0 = now(),
UserTTSup =
spawn(fun() ->
user_timetrap_supervisor(Func, WhoAmI, TCPid,
GL, T0, MultAndScale)
end),
receive
{UserTTSup,infinity} ->
%% remember the user timetrap so that it can be cancelled
save_user_timetrap(TCPid, UserTTSup, T0),
%% we need to make sure the user timetrap function
%% gets time to execute and return
timetrap(infinity, TCPid, MultAndScale)
after 5000 ->
exit(UserTTSup, kill),
if WhoAmI /= GL ->
exit({user_timetrap_error,time_ms_apply});
true ->
format("=== ERROR: User timetrap execution failed!", []),
ignore
end
end.
user_timetrap_supervisor(Func, Spawner, TCPid, GL, T0, MultAndScale) ->
process_flag(trap_exit, true),
Spawner ! {self(),infinity},
MonRef = monitor(process, TCPid),
UserTTSup = self(),
group_leader(GL, UserTTSup),
UserTT = spawn_link(fun() -> call_user_timetrap(Func, UserTTSup) end),
receive
{UserTT,Result} ->
demonitor(MonRef, [flush]),
Elapsed = trunc(timer:now_diff(now(), T0) / 1000),
try time_ms_check(Result) of
TimeVal ->
%% this is the new timetrap value to set (return value
%% from a fun or an MFA)
GL ! {user_timetrap,TCPid,TimeVal,T0,Elapsed,MultAndScale}
catch _:_ ->
%% when other than a legal timetrap value is returned
%% which will be the normal case for user timetraps
GL ! {user_timetrap,TCPid,0,T0,Elapsed,MultAndScale}
end;
{'EXIT',UserTT,Error} when Error /= normal ->
demonitor(MonRef, [flush]),
GL ! {user_timetrap,TCPid,0,T0,{user_timetrap_error,Error},
MultAndScale};
{'DOWN',MonRef,_,_,_} ->
demonitor(MonRef, [flush]),
exit(UserTT, kill)
end.
call_user_timetrap(Func, Sup) when is_function(Func) ->
try Func() of
Result ->
Sup ! {self(),Result}
catch _:Error ->
exit({Error,erlang:get_stacktrace()})
end;
call_user_timetrap({M,F,A}, Sup) ->
try apply(M,F,A) of
Result ->
Sup ! {self(),Result}
catch _:Error ->
exit({Error,erlang:get_stacktrace()})
end.
save_user_timetrap(TCPid, UserTTSup, StartTime) ->
%% save pid of user timetrap supervisor process so that
%% it may be stopped even before the timetrap func has returned
NewUserTT = {TCPid,{UserTTSup,StartTime}},
case get(test_server_user_timetrap) of
undefined ->
put(test_server_user_timetrap, [NewUserTT]);
UserTTSups ->
case proplists:get_value(TCPid, UserTTSups) of
undefined ->
put(test_server_user_timetrap,
[NewUserTT | UserTTSups]);
PrevTTSup ->
%% remove prev user timetrap
remove_user_timetrap(PrevTTSup),
put(test_server_user_timetrap,
[NewUserTT | proplists:delete(TCPid,
UserTTSups)])
end
end.
update_user_timetraps(TCPid, StartTime) ->
%% called when a user timetrap is triggered
case get(test_server_user_timetrap) of
undefined ->
proceed;
UserTTs ->
case proplists:get_value(TCPid, UserTTs) of
{_UserTTSup,StartTime} -> % same timetrap
put(test_server_user_timetrap,
proplists:delete(TCPid, UserTTs)),
proceed;
{OtherUserTTSup,OtherStartTime} ->
case timer:now_diff(OtherStartTime, StartTime) of
Diff when Diff >= 0 ->
ignore;
_ ->
exit(OtherUserTTSup, kill),
put(test_server_user_timetrap,
proplists:delete(TCPid, UserTTs)),
proceed
end;
undefined ->
proceed
end
end.
remove_user_timetrap(TTSup) ->
exit(TTSup, kill).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timetrap_cancel(Handle) -> ok
%% Handle = term()
%%
%% Cancels a time trap.
timetrap_cancel(Handle) ->
timetrap_cancel_one(Handle, true).
timetrap_cancel_one(infinity, _SendToServer) ->
ok;
timetrap_cancel_one(Handle, SendToServer) ->
case get(test_server_timetraps) of
undefined ->
ok;
[{Handle,_,_}] ->
erase(test_server_timetraps);
Timers ->
case lists:keysearch(Handle, 1, Timers) of
{value,_} ->
put(test_server_timetraps,
lists:keydelete(Handle, 1, Timers));
false when SendToServer == true ->
group_leader() ! {timetrap_cancel_one,Handle,self()};
false ->
ok
end
end,
test_server_sup:timetrap_cancel(Handle).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timetrap_cancel() -> ok
%%
%% Cancels timetrap for current test case.
timetrap_cancel() ->
timetrap_cancel_all(self(), true).
timetrap_cancel_all(TCPid, SendToServer) ->
case get(test_server_timetraps) of
undefined ->
ok;
Timers ->
[timetrap_cancel_one(Handle, false) ||
{Handle,Pid,_} <- Timers, Pid == TCPid]
end,
case get(test_server_user_timetrap) of
undefined ->
ok;
UserTTs ->
case proplists:get_value(TCPid, UserTTs) of
{UserTTSup,_StartTime} ->
remove_user_timetrap(UserTTSup),
put(test_server_user_timetrap,
proplists:delete(TCPid, UserTTs));
undefined ->
ok
end
end,
if SendToServer == true ->
group_leader() ! {timetrap_cancel_all,TCPid,self()};
true ->
ok
end,
ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% get_timetrap_info() -> {Timeout,Scale} | undefined
%%
%% Read timetrap info for current test case
get_timetrap_info() ->
get_timetrap_info(self(), true).
get_timetrap_info(TCPid, SendToServer) ->
case get(test_server_timetraps) of
undefined ->
undefined;
Timers ->
case [Info || {Handle,Pid,Info} <- Timers,
Pid == TCPid, Handle /= infinity] of
[I|_] ->
I;
[] when SendToServer == true ->
tc_supervisor_req({get_timetrap_info,TCPid});
[] ->
undefined
end
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% hours(N) -> Milliseconds
%% minutes(N) -> Milliseconds
%% seconds(N) -> Milliseconds
%% N = integer() | float()
%% Milliseconds = integer()
%%
%% Transforms the named units to milliseconds. Fractions in the input
%% are accepted. The output is an integer.
hours(N) -> trunc(N * 1000 * 60 * 60).
minutes(N) -> trunc(N * 1000 * 60).
seconds(N) -> trunc(N * 1000).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% tc_supervisor_req(Tag) -> Result
%% tc_supervisor_req(Tag, Msg) -> Result
%%
tc_supervisor_req(Tag) ->
Pid = test_server_gl:get_tc_supervisor(group_leader()),
Pid ! {Tag,self()},
receive
{Pid,Tag,Result} ->
Result
after 5000 ->
error(no_answer_from_tc_supervisor)
end.
tc_supervisor_req(Tag, Msg) ->
Pid = test_server_gl:get_tc_supervisor(group_leader()),
Pid ! {Tag,self(),Msg},
receive
{Pid,Tag,Result} ->
Result
after 5000 ->
error(no_answer_from_tc_supervisor)
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timecall(M,F,A) -> {Time,Val}
%% Time = float()
%%
%% Measures the time spent evaluating MFA. The measurement is done with
%% erlang:now/0, and should have pretty good accuracy on most platforms.
%% The function is not evaluated in a catch context.
timecall(M, F, A) ->
test_server_sup:timecall(M,F,A).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% do_times(N,M,F,A) -> ok
%% do_times(N,Fun) ->
%% N = integer()
%% Fun = fun() -> void()
%%
%% Evaluates MFA or Fun N times, and returns ok.
do_times(N,M,F,A) when N>0 ->
apply(M,F,A),
do_times(N-1,M,F,A);
do_times(0,_,_,_) ->
ok.
do_times(N,Fun) when N>0 ->
Fun(),
do_times(N-1,Fun);
do_times(0,_) ->
ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% m_out_of_n(M,N,Fun) -> ok | exit({m_out_of_n_failed,{R,left_to_do}})
%% M = integer()
%% N = integer()
%% Fun = fun() -> void()
%% R = integer()
%%
%% Repeats evaluating the given function until it succeeded (didn't crash)
%% M times. If, after N times, M successful attempts have not been
%% accomplished, the process crashes with reason {m_out_of_n_failed
%% {R,left_to_do}}, where R indicates how many cases that remained to be
%% successfully completed.
%%
%% For example:
%% m_out_of_n(1,4,fun() -> tricky_test_case() end)
%% Tries to run tricky_test_case() up to 4 times,
%% and is happy if it succeeds once.
%%
%% m_out_of_n(7,8,fun() -> clock_sanity_check() end)
%% Tries running clock_sanity_check() up to 8
%% times and allows the function to fail once.
%% This might be useful if clock_sanity_check/0
%% is known to fail if the clock crosses an hour
%% boundary during the test (and the up to 8
%% test runs could never cross 2 boundaries)
m_out_of_n(0,_,_) ->
ok;
m_out_of_n(M,0,_) ->
exit({m_out_of_n_failed,{M,left_to_do}});
m_out_of_n(M,N,Fun) ->
case catch Fun() of
{'EXIT',_} ->
m_out_of_n(M,N-1,Fun);
_Other ->
m_out_of_n(M-1,N-1,Fun)
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%call_crash(M,F,A)
%%call_crash(Time,M,F,A)
%%call_crash(Time,Crash,M,F,A)
%% M - atom()
%% F - atom()
%% A - [term()]
%% Time - integer() in milliseconds.
%% Crash - term()
%%
%% Spaws a new process that calls MFA. The call is considered
%% successful if the call crashes with the given reason (Crash),
%% or any other reason if Crash is not specified.
%% ** The call must terminate withing the given Time (defaults
%% to infinity), or it is considered a failure (exit with reason
%% 'call_crash_timeout' is generated).
call_crash(M,F,A) ->
call_crash(infinity,M,F,A).
call_crash(Time,M,F,A) ->
call_crash(Time,any,M,F,A).
call_crash(Time,Crash,M,F,A) ->
test_server_sup:call_crash(Time,Crash,M,F,A).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% start_node(SlaveName, Type, Options) ->
%% {ok, Slave} | {error, Reason}
%%
%% SlaveName = string(), atom().
%% Type = slave | peer
%% Options = [{tuple(), term()}]
%%
%% OptionList is a tuplelist wich may contain one
%% or more of these members:
%%
%% Slave and Peer:
%% {remote, true} - Start the node on a remote host. If not specified,
%% the node will be started on the local host (with
%% some exceptions, for instance VxWorks,
%% where all nodes are started on a remote host).
%% {args, Arguments} - Arguments passed directly to the node.
%% {cleanup, false} - Nodes started with this option will not be killed
%% by the test server after completion of the test case
%% Therefore it is IMPORTANT that the USER terminates
%% the node!!
%% {erl, ReleaseList} - Use an Erlang emulator determined by ReleaseList
%% when starting nodes, instead of the same emulator
%% as the test server is running. ReleaseList is a list
%% of specifiers, where a specifier is either
%% {release, Rel}, {prog, Prog}, or 'this'. Rel is
%% either the name of a release, e.g., "r7a" or
%% 'latest'. 'this' means using the same emulator as
%% the test server. Prog is the name of an emulator
%% executable. If the list has more than one element,
%% one of them is picked randomly. (Only
%% works on Solaris and Linux, and the test
%% server gives warnings when it notices that
%% nodes are not of the same version as
%% itself.)
%%
%% Peer only:
%% {wait, false} - Don't wait for the node to be started.
%% {fail_on_error, false} - Returns {error, Reason} rather than failing
%% the test case. This option can only be used with
%% peer nodes.
%% Note that slave nodes always act as if they had
%% fail_on_error==false.
%%
start_node(Name, Type, Options) ->
lists:foreach(
fun(N) ->
case firstname(N) of
Name ->
format("=== WARNING: Trying to start node \'~w\' when node"
" with same first name exists: ~w", [Name, N]);
_other -> ok
end
end,
nodes()),
group_leader() ! {sync_apply,
self(),
{test_server_ctrl,start_node,[Name,Type,Options]}},
Result = receive {sync_result,R} -> R end,
case Result of
{ok,Node} ->
%% Cannot run cover on shielded node or on a node started
%% by a shielded node.
Cover = case is_cover(Node) of
true ->
proplists:get_value(start_cover,Options,true);
false ->
false
end,
net_adm:ping(Node),
case Cover of
true ->
do_cover_for_node(Node,start);
_ ->
ok
end,
{ok,Node};
{fail,Reason} -> fail(Reason);
Error -> Error
end.
firstname(N) ->
list_to_atom(upto($@,atom_to_list(N))).
%% This should!!! crash if H is not member in list.
upto(H, [H | _T]) -> [];
upto(H, [X | T]) -> [X | upto(H,T)].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% wait_for_node(Name) -> ok | {error,timeout}
%%
%% If a node is started with the options {wait,false}, this function
%% can be used to wait for the node to come up from the
%% test server point of view (i.e. wait until it has contacted
%% the test server controller after startup)
wait_for_node(Slave) ->
group_leader() ! {sync_apply,
self(),
{test_server_ctrl,wait_for_node,[Slave]}},
Result = receive {sync_result,R} -> R end,
case Result of
ok ->
net_adm:ping(Slave),
case is_cover(Slave) of
true ->
do_cover_for_node(Slave,start);
_ ->
ok
end;
_ ->
ok
end,
Result.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% stop_node(Name) -> true|false
%%
%% Kills a (remote) node.
%% Also inform test_server_ctrl so it can clean up!
stop_node(Slave) ->
Cover = is_cover(Slave),
if Cover -> do_cover_for_node(Slave,flush,false);
true -> ok
end,
group_leader() ! {sync_apply,self(),{test_server_ctrl,stop_node,[Slave]}},
Result = receive {sync_result,R} -> R end,
case Result of
ok ->
erlang:monitor_node(Slave, true),
slave:stop(Slave),
receive
{nodedown, Slave} ->
format(minor, "Stopped slave node: ~w", [Slave]),
format(major, "=node_stop ~w", [Slave]),
if Cover -> do_cover_for_node(Slave,stop,false);
true -> ok
end,
true
after 30000 ->
format("=== WARNING: Node ~w does not seem to terminate.",
[Slave]),
erlang:monitor_node(Slave, false),
receive {nodedown, Slave} -> ok after 0 -> ok end,
false
end;
{error, _Reason} ->
%% Either, the node is already dead or it was started
%% with the {cleanup,false} option, or it was started
%% in some other way than test_server:start_node/3
format("=== WARNING: Attempt to stop a nonexisting slavenode (~w)~n"
"=== Trying to kill it anyway!!!",
[Slave]),
case net_adm:ping(Slave)of
pong ->
erlang:monitor_node(Slave, true),
slave:stop(Slave),
receive
{nodedown, Slave} ->
format(minor, "Stopped slave node: ~w", [Slave]),
format(major, "=node_stop ~w", [Slave]),
if Cover -> do_cover_for_node(Slave,stop,false);
true -> ok
end,
true
after 30000 ->
format("=== WARNING: Node ~w does not seem to terminate.",
[Slave]),
erlang:monitor_node(Slave, false),
receive {nodedown, Slave} -> ok after 0 -> ok end,
false
end;
pang ->
if Cover -> do_cover_for_node(Slave,stop,false);
true -> ok
end,
false
end
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% is_release_available(Release) -> true | false
%% Release -> string()
%%
%% Test if a release (such as "r10b") is available to be
%% started using start_node/3.
is_release_available(Release) ->
group_leader() ! {sync_apply,
self(),
{test_server_ctrl,is_release_available,[Release]}},
receive {sync_result,R} -> R end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% run_on_shielded_node(Fun, CArgs) -> term()
%% Fun -> function()
%% CArg -> list()
%%
%%
%% Fun is executed in a process on a temporarily created
%% hidden node. Communication with the job process goes
%% via a job proxy process on the hidden node, i.e. the
%% group leader of the test case process is the job proxy
%% process. This makes it possible to start nodes from the
%% hidden node that are unaware of the test server node.
%% Without the job proxy process all processes would have
%% a process residing on the test_server node as group_leader.
%%
%% Fun - Function to execute
%% CArg - Extra command line arguments to use when starting
%% the shielded node.
%%
%% If Fun is successfully executed, the result is returned.
%%
run_on_shielded_node(Fun, CArgs) when is_function(Fun), is_list(CArgs) ->
{A,B,C} = now(),
Name = "shielded_node-" ++ integer_to_list(A) ++ "-" ++ integer_to_list(B)
++ "-" ++ integer_to_list(C),
Node = case start_node(Name, slave, [{args, "-hidden " ++ CArgs}]) of
{ok, N} -> N;
Err -> fail({failed_to_start_shielded_node, Err})
end,
Master = self(),
Ref = make_ref(),
Slave = spawn(Node,
fun () ->
start_job_proxy(),
receive
Ref ->
Master ! {Ref, Fun()}
end,
receive after infinity -> infinity end
end),
MRef = erlang:monitor(process, Slave),
Slave ! Ref,
receive
{'DOWN', MRef, _, _, Info} ->
stop_node(Node),
fail(Info);
{Ref, Res} ->
stop_node(Node),
receive
{'DOWN', MRef, _, _, _} ->
Res
end
end.
%% Return true if Name or node() is a shielded node
is_shielded(Name) ->
case {cast_to_list(Name),atom_to_list(node())} of
{"shielded_node"++_,_} -> true;
{_,"shielded_node"++_} -> true;
_ -> false
end.
same_version(Name) ->
ThisVersion = erlang:system_info(version),
OtherVersion = rpc:call(Name, erlang, system_info, [version]),
ThisVersion =:= OtherVersion.
is_cover(Name) ->
case is_cover() of
true ->
not is_shielded(Name) andalso same_version(Name);
false ->
false
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% temp_name(Stem) -> string()
%% Stem = string()
%%
%% Create a unique file name, based on (starting with) Stem.
%% A filename of the form <Stem><Number> is generated, and the
%% function checks that that file doesn't already exist.
temp_name(Stem) ->
{A,B,C} = erlang:now(),
RandomNum = A bxor B bxor C,
RandomName = Stem ++ integer_to_list(RandomNum),
{ok,Files} = file:list_dir(filename:dirname(Stem)),
case lists:member(RandomName,Files) of
true ->
%% oh, already exists - bad luck. Try again.
temp_name(Stem); %% recursively try again
false ->
RandomName
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% app_test/1
%%
app_test(App) ->
app_test(App, pedantic).
app_test(App, Mode) ->
test_server_sup:app_test(App, Mode).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% appup_test/1
%%
appup_test(App) ->
test_server_sup:appup_test(App).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% is_native(Mod) -> true | false
%%
%% Checks wether the module is natively compiled or not.
is_native(Mod) ->
case catch Mod:module_info(native_addresses) of
[_|_] -> true;
_Other -> false
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% comment(String) -> ok
%%
%% The given String will occur in the comment field
%% of the table on the test suite result page. If
%% called several times, only the last comment is
%% printed.
%% comment/1 is also overwritten by the return value
%% {comment,Comment} or fail/1 (which prints Reason
%% as a comment).
comment(String) ->
group_leader() ! {comment,String},
ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% read_comment() -> string()
%%
%% Read the current comment string stored in
%% state during test case execution.
read_comment() ->
tc_supervisor_req(read_comment).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% make_priv_dir() -> ok
%%
%% Order test server to create the private directory
%% for the current test case.
make_priv_dir() ->
tc_supervisor_req(make_priv_dir).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% os_type() -> OsType
%%
%% Returns the OsType of the target node. OsType is
%% the same as returned from os:type()
os_type() ->
os:type().
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% is_cover() -> boolean()
%%
%% Returns true if cover is running, else false
is_cover() ->
case whereis(cover_server) of
undefined -> false;
_ -> true
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% is_debug() -> boolean()
%%
%% Returns true if the emulator is debug-compiled, false otherwise.
is_debug() ->
case catch erlang:system_info(debug_compiled) of
{'EXIT', _} ->
case string:str(erlang:system_info(system_version), "debug") of
Int when is_integer(Int), Int > 0 -> true;
_ -> false
end;
Res ->
Res
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% has_lock_checking() -> boolean()
%%
%% Returns true if the emulator has lock checking enabled, false otherwise.
has_lock_checking() ->
case catch erlang:system_info(lock_checking) of
{'EXIT', _} -> false;
Res -> Res
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% has_superfluous_schedulers() -> boolean()
%%
%% Returns true if the emulator has more scheduler threads than logical
%% processors, false otherwise.
has_superfluous_schedulers() ->
case catch {erlang:system_info(schedulers),
erlang:system_info(logical_processors)} of
{S, P} when is_integer(S), is_integer(P), S > P -> true;
_ -> false
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% is_commercial_build() -> boolean()
%%
%% Returns true if the current emulator is commercially supported.
%% (The emulator will not have "[source]" in its start-up message.)
%% We might want to do more tests on a commercial platform, for instance
%% ensuring that all applications have documentation).
is_commercial() ->
case string:str(erlang:system_info(system_version), "source") of
Int when is_integer(Int), Int > 0 -> false;
_ -> true
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% DEBUGGER INTERFACE %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% purify_is_running() -> false|true
%%
%% Tests if Purify is currently running.
purify_is_running() ->
case catch erlang:system_info({error_checker, running}) of
{'EXIT', _} -> false;
Res -> Res
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% purify_new_leaks() -> false|BytesLeaked
%% BytesLeaked = integer()
%%
%% Checks for new memory leaks if Purify is active.
%% Returns the number of bytes leaked, or false if Purify
%% is not running.
purify_new_leaks() ->
case catch erlang:system_info({error_checker, memory}) of
{'EXIT', _} -> false;
Leaked when is_integer(Leaked) -> Leaked
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% purify_new_fds_inuse() -> false|FdsInuse
%% FdsInuse = integer()
%%
%% Checks for new file descriptors in use.
%% Returns the number of new file descriptors in use, or false
%% if Purify is not running.
purify_new_fds_inuse() ->
case catch erlang:system_info({error_checker, fd}) of
{'EXIT', _} -> false;
Inuse when is_integer(Inuse) -> Inuse
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% purify_format(Format, Args) -> ok
%% Format = string()
%% Args = lists()
%%
%% Outputs the formatted string to Purify's logfile,if Purify is active.
purify_format(Format, Args) ->
(catch erlang:system_info({error_checker, io_lib:format(Format, Args)})),
ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% Apply given function and reply to caller or proxy.
%%
do_sync_apply(Proxy, From, {M,F,A}) ->
Result = apply(M, F, A),
if is_pid(Proxy) -> Proxy ! {sync_result_proxy,From,Result};
true -> From ! {sync_result,Result}
end.