%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. %% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. %% %% %CopyrightEnd% %% -module(test_server). -define(DEFAULT_TIMETRAP_SECS, 60). %%% START %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -export([start/1,start/2]). %%% TEST_SERVER_CTRL INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -export([run_test_case_apply/1,init_target_info/0,init_purify/0]). -export([cover_compile/1,cover_analyse/2]). %%% TEST_SERVER_SUP INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -export([get_loc/1]). %%% TEST SUITE INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -export([lookup_config/2]). -export([fail/0,fail/1,format/1,format/2,format/3]). -export([capture_start/0,capture_stop/0,capture_get/0]). -export([messages_get/0]). -export([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]). -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([]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -record(state,{controller,jobs=[]}). -include("test_server_internal.hrl"). -include_lib("kernel/include/file.hrl"). -define(pl2a(M), test_server_sup:package_atom(M)). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% **** START *** CODE FOR REMOTE TARGET ONLY *** %% %% test_server %% This process is started only if the test is to be run on a remote target %% The process is then started on target %% A socket connection is established with the test_server_ctrl process %% on host, and information about target is sent to host. start([ControllerHost]) when is_atom(ControllerHost) -> start(atom_to_list(ControllerHost)); start(ControllerHost) when is_list(ControllerHost) -> start(ControllerHost,?MAIN_PORT). start(ControllerHost,ControllerPort) -> S = self(), Pid = spawn(fun() -> init(ControllerHost,ControllerPort,S) end), receive {Pid,started} -> {ok,Pid}; {Pid,Error} -> Error end. init(Host,Port,Starter) -> global:register_name(?MODULE,self()), process_flag(trap_exit,true), test_server_sup:cleanup_crash_dumps(), case gen_tcp:connect(Host,Port, [binary, {reuseaddr,true}, {packet,2}]) of {ok,MainSock} -> Starter ! {self(),started}, request(MainSock,{target_info,init_target_info()}), loop(#state{controller={Host,MainSock}}); Error -> Starter ! {self(),{error, {could_not_contact_controller,Error}}} end. init_target_info() -> [$.|Emu] = code:objfile_extension(), {_, OTPRel} = init:script_id(), TestServerDir = filename:absname(filename:dirname(code:which(?MODULE))), #target_info{os_family=test_server_sup:get_os_family(), os_type=os:type(), version=erlang:system_info(version), system_version=erlang:system_info(system_version), root_dir=code:root_dir(), test_server_dir=TestServerDir, emulator=Emu, otp_release=OTPRel, username=test_server_sup:get_username(), cookie=atom_to_list(erlang:get_cookie())}. loop(#state{controller={_,MainSock}} = State) -> receive {tcp, MainSock, <<1,Request/binary>>} -> State1 = decode_main(binary_to_term(Request),State), loop(State1); {tcp_closed, MainSock} -> gen_tcp:close(MainSock), halt(); {'EXIT',Pid,Reason} -> case lists:keysearch(Pid,1,State#state.jobs) of {value,{Pid,Name}} -> case Reason of normal -> ignore; _other -> request(MainSock,{job_proc_killed,Name,Reason}) end, NewJobs = lists:keydelete(Pid,1,State#state.jobs), loop(State#state{jobs = NewJobs}); false -> loop(State) end end. %% Decode request on main socket decode_main({job,Port,Name},#state{controller={Host,_},jobs=Jobs}=State) -> S = self(), NewJob = spawn_link(fun() -> job(Host,Port,S) end), receive {NewJob,started} -> State#state{jobs=[{NewJob,Name}|Jobs]}; {NewJob,_Error} -> State end. init_purify() -> purify_new_leaks(). %% Temporary job process on target %% This process will live while all test cases in the job are executed. %% A socket connection is established with the job process on host. job(Host,Port,Starter) -> process_flag(trap_exit,true), init_purify(), case gen_tcp:connect(Host,Port, [binary, {reuseaddr,true}, {packet,4}, {active,false}]) of {ok,JobSock} -> Starter ! {self(),started}, job(JobSock); Error -> Starter ! {self(),{error, {could_not_contact_controller,Error}}} end. job(JobSock) -> JobDir = get_jobdir(), ok = file:make_dir(JobDir), ok = file:make_dir(filename:join(JobDir,?priv_dir)), put(test_server_job_sock,JobSock), put(test_server_job_dir,JobDir), {ok,Cwd} = file:get_cwd(), job_loop(JobSock), ok = file:set_cwd(Cwd), send_privdir(JobDir,JobSock), % also recursively removes jobdir ok. get_jobdir() -> Now = now(), {{Y,M,D},{H,Mi,S}} = calendar:now_to_local_time(Now), Basename = io_lib:format("~w-~2.2.0w-~2.2.0w_~2.2.0w.~2.2.0w.~2.2.0w_~w", [Y,M,D,H,Mi,S,element(3,Now)]), %% if target has a file master, don't use prim_file to look up cwd case lists:keymember(master,1,init:get_arguments()) of true -> {ok,Cwd} = file:get_cwd(), Cwd ++ "/" ++ Basename; false -> filename:absname(Basename) end. send_privdir(JobDir,JobSock) -> LocalPrivDir = filename:join(JobDir,?priv_dir), case file:list_dir(LocalPrivDir) of {ok,List} when List/=[] -> Tarfile0 = ?priv_dir ++ ".tar.gz", Tarfile = filename:join(JobDir,Tarfile0), {ok,Tar} = erl_tar:open(Tarfile,[write,compressed,cooked]), ok = erl_tar:add(Tar,LocalPrivDir,?priv_dir,[]), ok = erl_tar:close(Tar), {ok,TarBin} = file:read_file(Tarfile), file:delete(Tarfile), ok = del_dir(JobDir), request(JobSock,{{privdir,Tarfile0},TarBin}); _ -> ok = del_dir(JobDir), request(JobSock,{privdir,empty_priv_dir}) end. del_dir(Dir) -> case file:read_file_info(Dir) of {ok,#file_info{type=directory}} -> {ok,Cont} = file:list_dir(Dir), lists:foreach(fun(F) -> del_dir(filename:join(Dir,F)) end, Cont), ok = file:del_dir(Dir); {ok,#file_info{}} -> ok = file:delete(Dir); _r -> %% This might be a symlink - let's try to delete it! catch file:delete(Dir), ok end. %% %% Receive and decode request on job socket %% job_loop(JobSock) -> Request = recv(JobSock), case decode_job(Request) of ok -> job_loop(JobSock); {stop,R} -> R end. decode_job({{beam,Mod,Which},Beam}) -> % FIXME, shared directory structure on host and target required, % "Library beams" are not loaded from HOST... /Patrik code:add_patha(filename:dirname(Which)), % End of Patriks uglyness... {module,Mod} = code:load_binary(Mod,Which,Beam), ok; decode_job({{datadir,Tarfile0},Archive}) -> JobDir = get(test_server_job_dir), Tarfile = filename:join(JobDir,Tarfile0), ok = file:write_file(Tarfile,Archive), % Cooked is temporary removed/broken % ok = erl_tar:extract(Tarfile,[compressed,{cwd,JobDir},cooked]), ok = erl_tar:extract(Tarfile,[compressed,{cwd,JobDir}]), ok = file:delete(Tarfile), ok; decode_job({test_case,Case}) -> Result = run_test_case_apply(Case), JobSock = get(test_server_job_sock), request(JobSock,{test_case_result,Result}), case test_server_sup:tar_crash_dumps() of {error,no_crash_dumps} -> request(JobSock,{crash_dumps,no_crash_dumps}); {ok,TarFile} -> {ok,TarBin} = file:read_file(TarFile), file:delete(TarFile), request(JobSock,{{crash_dumps,filename:basename(TarFile)},TarBin}) end, ok; decode_job({sync_apply,{M,F,A}}) -> R = apply(M,F,A), request(get(test_server_job_sock),{sync_result,R}), ok; decode_job(job_done) -> {stop,stopped}. %% %% **** STOP *** CODE FOR REMOTE TARGET ONLY *** %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% cover_compile({App,Include,Exclude,Cross}) -> %% {ok,AnalyseModules} | {error,Reason} %% %% App = atom() , name of application to be compiled %% Exclude = [atom()], list of modules to exclude %% Include = [atom()], list of modules outside of App that should be included %% in the cover compilation %% Cross = [atoms()], list of modules outside of App shat should be included %% in the cover compilation, but that shall not be part of %% the cover analysis for this application. %% %% Cover compile the given application. Return {ok,AnalyseMods} if application %% is found, else {error,application_not_found}. cover_compile({none,_Exclude,Include,Cross}) -> CompileMods = Include++Cross, case length(CompileMods) of 0 -> io:fwrite("WARNING: No modules to cover compile!\n\n",[]), cover:start(), % start cover server anyway {ok,[]}; N -> io:fwrite("Cover compiling ~w modules - " "this may take some time... ",[N]), do_cover_compile(CompileMods), io:fwrite("done\n\n",[]), {ok,Include} end; cover_compile({App,all,Include,Cross}) -> CompileMods = Include++Cross, case length(CompileMods) of 0 -> io:fwrite("WARNING: No modules to cover compile!\n\n",[]), cover:start(), % start cover server anyway {ok,[]}; N -> io:fwrite("Cover compiling '~w' (~w files) - " "this may take some time... ",[App,N]), io:format("\nWARNING: All modules in \'~w\' are excluded\n" "Only cover compiling modules in include list " "and the modules\nin the cross cover file:\n" "~p\n", [App,CompileMods]), do_cover_compile(CompileMods), io:fwrite("done\n\n",[]), {ok,Include} end; cover_compile({App,Exclude,Include,Cross}) -> case code:lib_dir(App) of {error,bad_name} -> case Include++Cross of [] -> io:format("\nWARNING: Can't find lib_dir for \'~w\'\n" "Not cover compiling!\n\n",[App]), {error,application_not_found}; CompileMods -> io:fwrite("Cover compiling '~w' (~w files) - " "this may take some time... ", [App,length(CompileMods)]), io:format("\nWARNING: Can't find lib_dir for \'~w\'\n" "Only cover compiling modules in include list: " "~p\n", [App,Include]), do_cover_compile(CompileMods), io:fwrite("done\n\n",[]), {ok,Include} end; LibDir -> EbinDir = filename:join([LibDir,"ebin"]), WC = filename:join(EbinDir,"*.beam"), AllMods = module_names(filelib:wildcard(WC)), AnalyseMods = (AllMods ++ Include) -- Exclude, CompileMods = AnalyseMods ++ Cross, case length(CompileMods) of 0 -> io:fwrite("WARNING: No modules to cover compile!\n\n",[]), cover:start(), % start cover server anyway {ok,[]}; N -> io:fwrite("Cover compiling '~w' (~w files) - " "this may take some time... ",[App,N]), do_cover_compile(CompileMods), io:fwrite("done\n\n",[]), {ok,AnalyseMods} end end. module_names(Beams) -> [list_to_atom(filename:basename(filename:rootname(Beam))) || Beam <- Beams]. do_cover_compile(Modules) -> do_cover_compile1(lists:usort(Modules)). % remove duplicates do_cover_compile1([Dont|Rest]) when Dont=:=cover; Dont=:=test_server; Dont=:=test_server_ctrl -> do_cover_compile1(Rest); do_cover_compile1([M|Rest]) -> case {code:is_sticky(M),code:is_loaded(M)} of {true,_} -> code:unstick_mod(M), case cover:compile_beam(M) of {ok,_} -> ok; Error -> io:fwrite("\nWARNING: Could not cover compile ~w: ~p\n", [M,Error]) end, code:stick_mod(M), do_cover_compile1(Rest); {false,false} -> case code:load_file(M) of {module,_} -> do_cover_compile1([M|Rest]); Error -> io:fwrite("\nWARNING: Could not load ~w: ~p\n",[M,Error]), do_cover_compile1(Rest) end; {false,_} -> case cover:compile_beam(M) of {ok,_} -> ok; Error -> io:fwrite("\nWARNING: Could not cover compile ~w: ~p\n", [M,Error]) end, do_cover_compile1(Rest) end; do_cover_compile1([]) -> ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% cover_analyse(Analyse,Modules) -> [{M,{Cov,NotCov,Details}}] %% %% Analyse = {details,Dir} | details | {overview,void()} | overview %% Modules = [atom()], the modules to analyse %% %% Cover analysis. If this is a remote target, analyse_to_file can not be used. %% In that case the analyse level 'line' is used instead if Analyse==details. %% %% If this is a local target, the test directory is given %% (Analyse=={details,Dir}) and analyse_to_file can be used directly. %% %% If Analyse==overview | {overview,Dir} analyse_to_file is not used, only %% an overview containing the number of covered/not covered lines in each module. %% %% Also, if a Dir exists, cover data will be exported to a file called %% all.coverdata in that directory. cover_analyse(Analyse,Modules) -> io:fwrite("Cover analysing...\n",[]), DetailsFun = case Analyse of {details,Dir} -> case cover:export(filename:join(Dir,"all.coverdata")) of ok -> fun(M) -> OutFile = filename:join(Dir, atom_to_list(M) ++ ".COVER.html"), case cover:analyse_to_file(M,OutFile,[html]) of {ok,_} -> {file,OutFile}; Error -> Error end end; Error -> fun(_) -> Error end end; details -> fun(M) -> case cover:analyse(M,line) of {ok,Lines} -> {lines,Lines}; Error -> Error end end; {overview,Dir} -> case cover:export(filename:join(Dir,"all.coverdata")) of ok -> fun(_) -> undefined end; Error -> fun(_) -> Error end end; overview -> fun(_) -> undefined end end, R = pmap( fun(M) -> case cover:analyse(M,module) of {ok,{M,{Cov,NotCov}}} -> {M,{Cov,NotCov,DetailsFun(M)}}; Err -> io:fwrite("WARNING: Analysis failed for ~w. Reason: ~p\n", [M,Err]), {M,Err} end end, Modules), Sticky = unstick_all_sticky(node()), cover:stop(), stick_all_sticky(node(),Sticky), R. pmap(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). unstick_all_sticky(Node) -> lists:filter( fun(M) -> case code:is_sticky(M) of true -> rpc:call(Node,code,unstick_mod,[M]), true; false -> false end end, cover:modules()). stick_all_sticky(Node,Sticky) -> lists:foreach( fun(M) -> rpc:call(Node,code,stick_mod,[M]) end, Sticky). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% run_test_case_apply(Mod,Func,Args,Name,RunInit,TimetrapData,RejectIoReqs) -> %% {Time,Value,Loc,Opts,Comment} | {died,Reason,unknown,Comment} %% %% Time = float() (seconds) %% Value = term() %% Loc = term() %% Comment = string() %% Reason = term() %% %% Spawns off a process (case process) that actually runs the test suite. %% The case process will have the job process as group leader, which makes %% it possible to capture all it's output from io:format/2, etc. %% %% The job process then sits down and waits for news from the case process. %% This might be io requests (which are redirected to the log files). %% %% Returns a tuple with the time spent (in seconds) in the test case, %% the return value from the test case or an {'EXIT',Reason} if the case %% failed, Loc points out where the test case crashed (if it did). Loc %% is either the name of the function, or {<Module>,<Line>} of the last %% line executed that had a ?line macro. If the test case did execute %% erase/0 or similar, it may be empty. Comment is the last comment added %% by test_server:comment/1, the reason if test_server:fail has been %% called or the comment given by the return value {comment,Comment} from %% a test case. %% %% {died,Reason,unknown,Comment} is returned if the test case was killed %% by some other process. Reason is the kill reason provided. %% %% 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. %% %% RejectIoReqs (bool) is information about whether printouts to stdout %% should be visible in the minor log file or not. run_test_case_apply({CaseNum,Mod,Func,Args,Name, RunInit,TimetrapData,RejectIoReqs}) -> purify_format("Test case #~w ~w:~w/1", [CaseNum, Mod, Func]), case os:getenv("TS_RUN_VALGRIND") of false -> ok; _ -> os:putenv("VALGRIND_LOGFILE_INFIX",atom_to_list(Mod)++"."++ atom_to_list(Func)++"-") end, test_server_h:testcase({Mod,Func,1}), ProcBef = erlang:system_info(process_count), Result = run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData, RejectIoReqs), ProcAft = erlang:system_info(process_count), purify_new_leaks(), DetFail = get(test_server_detected_fail), {Result,DetFail,ProcBef,ProcAft}. run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData, RejectIoReqs) -> case get(test_server_job_dir) of undefined -> %% i'm a local target do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData, RejectIoReqs); JobDir -> %% i'm a remote target case Args of [Config] when is_list(Config) -> {value,{data_dir,HostDataDir}} = lists:keysearch(data_dir, 1, Config), DataBase = filename:basename(HostDataDir), TargetDataDir = filename:join(JobDir, DataBase), Config1 = lists:keyreplace(data_dir, 1, Config, {data_dir,TargetDataDir}), TargetPrivDir = filename:join(JobDir, ?priv_dir), Config2 = lists:keyreplace(priv_dir, 1, Config1, {priv_dir,TargetPrivDir}), do_run_test_case_apply(Mod, Func, [Config2], Name, RunInit, TimetrapData, RejectIoReqs); _other -> do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData, RejectIoReqs) end end. do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData, RejectIoReqs) -> {ok,Cwd} = file:get_cwd(), Args2Print = case Args of [Args1] when is_list(Args1) -> lists:keydelete(tc_group_result, 1, Args1); _ -> Args end, print(minor, "Test case started with:\n~s:~s(~p)\n", [Mod,Func,Args2Print]), print(minor, "Current directory is ~p\n", [Cwd]), print_timestamp(minor,"Started at "), print(minor, "", [], internal_raw), TCCallback = get(test_server_testcase_callback), LogOpts = get(test_server_logopts), Ref = make_ref(), OldGLeader = group_leader(), %% Set ourself to group leader for the spawned process group_leader(self(),self()), Pid = spawn_link( fun() -> run_test_case_eval(Mod, Func, Args, Name, Ref, RunInit, TimetrapData, LogOpts, TCCallback) end), group_leader(OldGLeader, self()), put(test_server_detected_fail, []), run_test_case_msgloop(Ref, Pid, false, RejectIoReqs, false, "", undefined, starting). %% Ugly bug (pre R5A): %% If this process (group leader of the test case) terminates before %% all messages have been replied back to the io server, the io server %% hangs. Fixed by the 20 milli timeout check here, and by using monitor in %% io.erl (livrem OCH hangslen mao :) %% %% A test case is known to have failed if it returns {'EXIT', _} tuple, %% or sends a message {failed, File, Line} to it's group_leader %% run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, Comment, CurrConf, Status) -> %% NOTE: Keep job_proxy_msgloop/0 up to date when changes %% are made in this function! {Timeout,ReturnValue} = case Terminate of {true, ReturnVal} -> %% stop any timetrap timers for the test case %% that have been started by this process timetrap_cancel_all(Pid, false), {20, ReturnVal}; false -> {infinity, should_never_appear} end, receive {test_case_initialized,Pid} -> run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,running); Abort = {abort_current_testcase,_,_} when 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(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {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}, NewComment = receive {'DOWN', Mon, process, Pid, _} -> Comment after 10000 -> %% Pid is probably trapping exits, hit it harder... exit(Pid, kill), %% here's the only place we know Reason, so we save %% it as a comment, potentially replacing user data Error = lists:flatten(io_lib:format("Aborted: ~p", [Reason])), Error1 = lists:flatten([string:strip(S,left) || S <- string:tokens(Error, [$\n])]), if length(Error1) > 63 -> string:substr(Error1,1,60) ++ "..."; true -> Error1 end end, run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, NewComment,CurrConf,Status); {permit_io,FromPid} -> put({permit_io,FromPid},true), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}} when is_list(Format) -> Msg = (catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, Msg,From,Func), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}} when is_atom(Format) -> Msg = (catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, Msg,From,Func), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,Bytes}} -> run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, Bytes,From,put_chars), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,unicode,io_lib,Func,[Format,Args]}} when is_list(Format) -> Msg = unicode_to_latin1(catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, Msg,From,Func), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,latin1,io_lib,Func,[Format,Args]}} when is_list(Format) -> Msg = (catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, Msg,From,Func), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,unicode,io_lib,Func,[Format,Args]}} when is_atom(Format) -> Msg = unicode_to_latin1(catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, Msg,From,Func), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,latin1,io_lib,Func,[Format,Args]}} when is_atom(Format) -> Msg = (catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, Msg,From,Func), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,unicode,Bytes}} -> run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, unicode_to_latin1(Bytes),From,put_chars), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,latin1,Bytes}} -> run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, Bytes,From,put_chars), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); IoReq when element(1, IoReq) == io_request -> %% something else, just pass it on group_leader() ! IoReq, run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {structured_io,ClientPid,Msg} -> output(Msg, ClientPid), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {capture,NewCapture} -> run_test_case_msgloop(Ref,Pid,NewCapture,RejectIoReqs,Terminate, Comment,CurrConf,Status); {sync_apply,From,MFA} -> sync_local_or_remote_apply(false,From,MFA), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {sync_apply_proxy,Proxy,From,MFA} -> sync_local_or_remote_apply(Proxy,From,MFA), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {printout,Detail,Format,Args} -> print(Detail,Format,Args), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {comment,NewComment} -> NewComment1 = test_server_ctrl:to_string(NewComment), NewComment2 = test_server_sup:framework_call(format_comment, [NewComment1], NewComment1), Terminate1 = case Terminate of {true,{Time,Value,Loc,Opts,_OldComment}} -> {true,{Time,Value,mod_loc(Loc),Opts,NewComment2}}; Other -> Other end, run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate1, NewComment2,CurrConf,Status); {read_comment,From} -> From ! {self(),read_comment,Comment}, run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {set_curr_conf,From,NewCurrConf} -> From ! {self(),set_curr_conf,ok}, run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,NewCurrConf,Status); {make_priv_dir,From} when CurrConf == undefined -> From ! {self(),make_priv_dir,{error,no_priv_dir_in_config}}, run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {make_priv_dir,From} -> Result = case proplists:get_value(priv_dir, element(2, CurrConf)) 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(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, Comment,CurrConf,Status); {'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} -> RetVal = {Time/1000000,Value,mod_loc(Loc),Opts,Comment}, run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, {true,RetVal},Comment,undefined,Status); {'EXIT',Pid,Reason} -> case Reason of {timetrap_timeout,TVal,Loc} -> %% convert Loc to form that can be formatted case mod_loc(Loc) of {FwMod,FwFunc,framework} -> %% timout during framework call spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, {framework_error,{timetrap,TVal}}, unknown,self()), run_test_case_msgloop(Ref,Pid, CaptureStdout,RejectIoReqs, Terminate,Comment, undefined,Status); Loc1 -> %% call end_per_testcase on a separate process, %% only so that the user has a chance to %% clean up after init_per_testcase, even after %% a timetrap timeout NewCurrConf = case CurrConf of {{Mod,Func},Conf} -> EndConfPid = call_end_conf( Mod,Func,Pid, {timetrap_timeout,TVal}, Loc1,[{tc_status, {failed, timetrap_timeout}}|Conf], TVal), {EndConfPid,{Mod,Func},Conf}; _ -> {Mod,Func} = get_mf(Loc1), %% The framework functions mustn't %% execute on this group leader process %% or io will cause deadlock, so we %% spawn a dedicated process for the %% operation and let the group leader %% go back to handle io. spawn_fw_call(Mod,Func,CurrConf,Pid, {timetrap_timeout,TVal}, Loc1,self()), undefined end, run_test_case_msgloop(Ref,Pid, CaptureStdout,RejectIoReqs, Terminate,Comment, NewCurrConf,Status) end; {timetrap_timeout,TVal,Loc,InitOrEnd} -> case mod_loc(Loc) of {FwMod,FwFunc,framework} -> %% timout during framework call spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, {framework_error,{timetrap,TVal}}, unknown,self()); Loc1 -> {Mod,_Func} = get_mf(Loc1), spawn_fw_call(Mod,InitOrEnd,CurrConf,Pid, {timetrap_timeout,TVal}, Loc1,self()) end, run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, Terminate,Comment,CurrConf,Status); {testcase_aborted,ErrorMsg={user_timetrap_error,_},AbortLoc} -> %% user timetrap function caused exit %% during start of test case {Mod,Func} = get_mf(mod_loc(AbortLoc)), spawn_fw_call(Mod,Func,CurrConf,Pid, ErrorMsg,unknown,self()), run_test_case_msgloop(Ref,Pid, CaptureStdout,RejectIoReqs, Terminate,Comment, undefined,Status); {testcase_aborted,AbortReason,AbortLoc} -> ErrorMsg = {testcase_aborted,AbortReason}, case mod_loc(AbortLoc) of {FwMod,FwFunc,framework} -> %% abort during framework call spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, {framework_error,ErrorMsg}, unknown,self()), run_test_case_msgloop(Ref,Pid, CaptureStdout,RejectIoReqs, Terminate,Comment, undefined,Status); Loc1 -> %% call end_per_testcase on a separate process, %% only so that the user has a chance to clean up %% after init_per_testcase, even after abortion NewCurrConf = case CurrConf of {{Mod,Func},Conf} -> TVal = case lists:keysearch(default_timeout, 1, Conf) of {value,{default_timeout,Tmo}} -> Tmo; _ -> ?DEFAULT_TIMETRAP_SECS*1000 end, EndConfPid = call_end_conf( Mod,Func,Pid, ErrorMsg,Loc1, [{tc_status, {failed,ErrorMsg}}|Conf],TVal), {EndConfPid,{Mod,Func},Conf}; _ -> {Mod,Func} = get_mf(Loc1), spawn_fw_call(Mod,Func,CurrConf,Pid, ErrorMsg,Loc1,self()), undefined end, run_test_case_msgloop(Ref,Pid, CaptureStdout,RejectIoReqs, Terminate,Comment, NewCurrConf,Status) end; killed -> %% result of an exit(TestCase,kill) call, which is the %% only way to abort a testcase process that traps exits %% (see abort_current_testcase) {Mod,Func} = case CurrConf of {MF,_} -> MF; _ -> {undefined,undefined} end, spawn_fw_call(Mod,Func,CurrConf,Pid, testcase_aborted_or_killed, unknown,self()), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, Terminate,Comment,CurrConf,Status); {fw_error,{FwMod,FwFunc,FwError}} -> spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, {framework_error,FwError}, unknown,self()), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, Terminate,Comment,CurrConf,Status); _Other -> %% the testcase has terminated because of Reason (e.g. an exit %% because a linked process failed) {Mod,Func} = case CurrConf of {MF,_} -> MF; _ -> {undefined,undefined} end, spawn_fw_call(Mod,Func,CurrConf,Pid, Reason,unknown,self()), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, Terminate,Comment,CurrConf,Status) end; {EndConfPid,{call_end_conf,Data,_Result}} -> case CurrConf of {EndConfPid,{Mod,Func},_Conf} -> {_Mod,_Func,TCPid,TCExitReason,Loc} = Data, spawn_fw_call(Mod,Func,CurrConf,TCPid, TCExitReason,Loc,self()), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, Terminate,Comment,undefined,Status); _ -> run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, Terminate,Comment,CurrConf,Status) end; {_FwCallPid,fw_notify_done,{T,Value,Loc,Opts,AddToComment}} -> %% the framework has been notified, we're finished RetVal = case AddToComment of undefined -> {T,Value,Loc,Opts,Comment}; _ -> Comment1 = if Comment == "" -> AddToComment; true -> Comment ++ test_server_ctrl:xhtml("<br>", "<br />") ++ AddToComment end, {T,Value,Loc,Opts,Comment1} end, run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, {true,RetVal},Comment,undefined,Status); {'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,"Framework error"}, run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, {true,RetVal},Comment,undefined,Status); {failed,File,Line} -> put(test_server_detected_fail, [{File, Line}| get(test_server_detected_fail)]), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, Terminate,Comment,CurrConf,Status); {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(Ref,Pid,CaptureStdout,RejectIoReqs, Terminate,Comment,CurrConf,Status); {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(Ref,Pid,CaptureStdout,RejectIoReqs, Terminate,Comment,CurrConf,Status); {timetrap_cancel_one,Handle,_From} -> timetrap_cancel_one(Handle, false), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, Terminate,Comment,CurrConf,Status); {timetrap_cancel_all,TCPid,_From} -> timetrap_cancel_all(TCPid, false), run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, Terminate,Comment,CurrConf,Status); {get_timetrap_info,TCPid,From} -> Info = get_timetrap_info(TCPid, false), From ! {self(),get_timetrap_info,Info}, run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, Terminate,Comment,CurrConf,Status); _Other when not is_tuple(_Other) -> %% ignore anything not generated by test server run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, Terminate,Comment,CurrConf,Status); _Other when element(1, _Other) /= 'EXIT', element(1, _Other) /= started, element(1, _Other) /= finished, element(1, _Other) /= print -> %% ignore anything not generated by test server run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, Terminate,Comment,CurrConf,Status) after Timeout -> ReturnValue end. run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, Msg,From,Func) -> case Msg of {'EXIT',_} -> From ! {io_reply,ReplyAs,{error,Func}}; _ -> From ! {io_reply,ReplyAs,ok} end, Proceed = if RejectIoReqs -> get({permit_io,From}); true -> true end, if Proceed -> if CaptureStdout /= false -> CaptureStdout ! {captured,Msg}; true -> ok end, output({minor,Msg},From); true -> ok end. output(Msg,Sender) -> local_or_remote_apply({test_server_ctrl,output,[Msg,Sender]}). call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) -> %% Starter is also the group leader process Starter = self(), Data = {Mod,Func,TCPid,TCExitReason,Loc}, EndConfProc = fun() -> group_leader(Starter, self()), Supervisor = self(), EndConfApply = fun() -> case catch apply(Mod,end_per_testcase,[Func,Conf]) of {'EXIT',Why} -> timer:sleep(1), group_leader() ! {printout,12, "WARNING! " "~p:end_per_testcase(~p, ~p)" " crashed!\n\tReason: ~p\n", [Mod,Func,Conf,Why]}; _ -> ok end, Supervisor ! {self(),end_conf} end, Pid = spawn_link(EndConfApply), receive {Pid,end_conf} -> Starter ! {self(),{call_end_conf,Data,ok}}; {'EXIT',Pid,Reason} -> Starter ! {self(),{call_end_conf,Data,{error,Reason}}} after TVal -> exit(Pid, kill), group_leader() ! {printout,12, "WARNING! ~p:end_per_testcase(~p, ~p)" " failed!\n\tReason: timetrap timeout" " after ~w ms!\n", [Mod,Func,Conf,TVal]}, Starter ! {self(),{call_end_conf,Data,{error,timeout}}} end end, spawn_link(EndConfProc). spawn_fw_call(Mod,{init_per_testcase,Func},_,Pid,{timetrap_timeout,TVal}=Why, Loc,SendTo) -> FwCall = fun() -> %% set group leader so that printouts/comments %% from the framework get printed in the logs group_leader(SendTo, self()), Skip = {skip,{failed,{Mod,init_per_testcase,Why}}}, %% if init_per_testcase fails, the test case %% should be skipped case catch do_end_tc_call(Mod,Func, Loc, {Pid,Skip,[[]]}, Why) of {'EXIT',FwEndTCErr} -> exit({fw_notify_done,end_tc,FwEndTCErr}); _ -> ok 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) -> %%! This is a temporary fix that keeps Test Server alive during %%! execution of a parallel test case group, when sometimes %%! this clause gets called with EndConf == undefined. See OTP-9594 %%! for more info. EndConf1 = if EndConf == undefined -> [{tc_status,{failed,{Mod,end_per_testcase,Why}}}]; true -> EndConf end, FwCall = fun() -> %% set group leader so that printouts/comments %% from the framework get printed in the logs group_leader(SendTo, self()), {RetVal,Report} = case proplists:get_value(tc_status, EndConf1) 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! ~p:end_per_testcase(~p, ~p)" " failed!\n\tReason: timetrap timeout" " after ~w ms!\n", [Mod,Func,EndConf,TVal]}, FailLoc = proplists:get_value(tc_fail_loc, EndConf1), case catch do_end_tc_call(Mod,Func, FailLoc, {Pid,Report,[EndConf1]}, Why) of {'EXIT',FwEndTCErr} -> exit({fw_notify_done,end_tc,FwEndTCErr}); _ -> ok 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() -> %% set group leader so that printouts/comments %% from the framework get printed in the logs group_leader(SendTo, self()), 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) -> {Mod1,Func1} = case {Mod,Func,CurrConf} of {undefined,undefined,{{M,F},_}} -> {M,F}; _ -> {Mod,Func} end, FwCall = fun() -> %% set group leader so that printouts/comments %% from the framework get printed in the logs group_leader(SendTo, self()), case catch fw_error_notify(Mod1,Func1,[], Error,Loc) of {'EXIT',FwErrorNotifyErr} -> exit({fw_notify_done,error_notification, FwErrorNotifyErr}); _ -> ok end, Conf = [{tc_status,{failed,timetrap_timeout}}], case catch do_end_tc_call(Mod1,Func1, Loc, {Pid,Error,[Conf]},Error) of {'EXIT',FwEndTCErr} -> exit({fw_notify_done,end_tc,FwEndTCErr}); _ -> ok 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), FWInitResult = test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0], {ok,Args0}), group_leader() ! {test_case_initialized,self()}, {{Time,Value},Loc,Opts} = case FWInitResult of {ok,Args} -> run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback); Error = {error,_Reason} -> Where = {Mod,Func}, NewResult = do_end_tc_call(Mod,Func, Where, {Error,Args0}, {skip,{failed,Error}}), {{0,NewResult},Where,[]}; {fail,Reason} -> Conf = [{tc_status,{failed,Reason}} | hd(Args0)], Where = {Mod,Func}, fw_error_notify(Mod, Func, Conf, Reason), NewResult = do_end_tc_call(Mod,Func, Where, {{error,Reason},[Conf]}, {fail,Reason}), {{0,NewResult},Where,[]}; Skip = {skip,_Reason} -> Where = {Mod,Func}, NewResult = do_end_tc_call(Mod,Func, Where, {Skip,Args0}, Skip), {{0,NewResult},Where,[]}; {auto_skip,Reason} -> Where = {Mod,Func}, NewResult = do_end_tc_call(Mod,Func, Where, {{skip,Reason},Args0}, {skip,Reason}), {{0,NewResult},Where,[]} end, exit({Ref,Time,Value,Loc,Opts}). run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> %% save current state in controller loop sync_send(group_leader(),set_curr_conf,{{Mod,Func},hd(Args)}, 5000, fun() -> exit(no_answer_from_group_leader) end), case RunInit of run_init -> put(test_server_init_or_end_conf,{init_per_testcase,Func}), put(test_server_loc, {Mod,{init_per_testcase,Func}}), ensure_timetrap(Args), case init_per_testcase(Mod, Func, Args) of Skip = {skip,Reason} -> Line = get_loc(), Conf = [{tc_status,{skipped,Reason}}], NewRes = do_end_tc_call(Mod,Func, Line, {Skip,[Conf]}, Skip), {{0,NewRes},Line,[]}; {skip_and_save,Reason,SaveCfg} -> Line = get_loc(), Conf = [{tc_status,{skipped,Reason}},{save_config,SaveCfg}], NewRes = do_end_tc_call(Mod,Func, Line, {{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, {Mod,Func}, {{error,Reason},[EndConf]}, FailTC), {{0,NewRes},{Mod,Func},[]}; {ok,NewConf} -> put(test_server_init_or_end_conf,undefined), %% call user callback function if defined NewConf1 = user_callback(TCCallback, Mod, Func, init, NewConf), %% save current state in controller loop sync_send(group_leader(),set_curr_conf,{{Mod,Func},NewConf1}, 5000, fun() -> exit(no_answer_from_group_leader) end), put(test_server_loc, {Mod,Func}), %% execute the test case {{T,Return},Loc} = {ts_tc(Mod, Func, [NewConf1]),get_loc()}, {EndConf,TSReturn,FWReturn} = case Return of {E,TCError} when E=='EXIT' ; E==failed -> ModLoc = mod_loc(Loc), fw_error_notify(Mod, Func, NewConf1, TCError, ModLoc), {[{tc_status,{failed,TCError}}, {tc_fail_loc,ModLoc}|NewConf1], Return,{error,TCError}}; SaveCfg={save_config,_} -> {[{tc_status,ok},SaveCfg|NewConf1],Return,ok}; {skip_and_save,Why,SaveCfg} -> Skip = {skip,Why}, {[{tc_status,{skipped,Why}}, {save_config,SaveCfg}|NewConf1], Skip,Skip}; {skip,Why} -> {[{tc_status,{skipped,Why}}|NewConf1],Return,Return}; _ -> {[{tc_status,ok}|NewConf1],Return,ok} end, %% call user callback function if defined EndConf1 = user_callback(TCCallback, Mod, Func, 'end', EndConf), %% update current state in controller loop sync_send(group_leader(),set_curr_conf,EndConf1, 5000, fun() -> exit(no_answer_from_group_leader) end), {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 sync_send(group_leader(),set_curr_conf,undefined, 5000, fun() -> exit(no_answer_from_group_leader) end), put(test_server_init_or_end_conf,undefined), case do_end_tc_call(Mod,Func, Loc, {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 -> %% call user callback function if defined Args1 = user_callback(TCCallback, Mod, Func, init, Args), ensure_timetrap(Args1), %% ts_tc does a catch put(test_server_loc, {Mod,Func}), %% if this is a named conf group, the test case (init or end conf) %% should be called with the name as the first argument Args2 = if Name == undefined -> Args1; true -> [Name | Args1] end, %% execute the conf test case {{T,Return},Loc} = {ts_tc(Mod, Func, Args2),get_loc()}, %% call user callback function if defined Return1 = user_callback(TCCallback, Mod, Func, 'end', Return), {Return2,Opts} = process_return_val([Return1], Mod, Func, Args1, {Mod,Func}, Return1), {{T,Return2},Loc,Opts} end. do_end_tc_call(M,F, Loc, Res, Return) -> IsSuite = case lists:reverse(atom_to_list(M)) of [$E,$T,$I,$U,$S,$_|_] -> true; _ -> false end, FwMod = os:getenv("TEST_SERVER_FRAMEWORK"), {Mod,Func} = if FwMod == M ; FwMod == "undefined"; FwMod == false -> {M,F}; (not IsSuite) and is_list(Loc) and (length(Loc)>1) -> %% If failure in other module (M) than suite, try locate %% suite name in Loc list and call end_tc with Suite:TestCase %% instead of M:F. GetSuite = fun(S,TC) -> case lists:reverse(atom_to_list(S)) of [$E,$T,$I,$U,$S,$_|_] -> [{S,TC}]; _ -> [] end end, case lists:flatmap(fun({S,TC,_}) -> GetSuite(S,TC); ({{S,TC},_}) -> GetSuite(S,TC); ({S,TC}) -> GetSuite(S,TC); (_) -> [] end, Loc) of [] -> {M,F}; [FoundSuite|_] -> FoundSuite end; true -> {M,F} end, Ref = make_ref(), if FwMod == "ct_framework" ; FwMod == "undefined"; FwMod == false -> case test_server_sup:framework_call( end_tc, [?pl2a(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, [?pl2a(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, Loc, {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, mod_loc(Loc)), case do_end_tc_call(M,F, Loc, {{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, Loc, {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:Other -> set_loc(erlang:get_stacktrace()), Line = get_loc(), FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), group_leader() ! {printout,12, "ERROR! init_per_testcase thrown!\n" "\tLocation: ~s\n\tReason: ~p\n", [FormattedLoc, Other]}, {skip,{failed,{Mod,init_per_testcase,Other}}}; _:Reason0 -> Stk = erlang:get_stacktrace(), Reason = {Reason0,Stk}, set_loc(Stk), Line = get_loc(), FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), group_leader() ! {printout,12, "ERROR! init_per_testcase crashed!\n" "\tLocation: ~s\n\tReason: ~p\n", [FormattedLoc,Reason]}, {skip,{failed,{Mod,init_per_testcase,Reason}}} end. end_per_testcase(Mod, Func, Conf) -> case erlang:function_exported(Mod,end_per_testcase,2) of true -> do_end_per_testcase(Mod,end_per_testcase,Func,Conf); false -> %% Backwards compatibility! case erlang:function_exported(Mod,fin_per_testcase,2) of true -> do_end_per_testcase(Mod,fin_per_testcase,Func,Conf); false -> ok end end. do_end_per_testcase(Mod,EndFunc,Func,Conf) -> put(test_server_init_or_end_conf,{EndFunc,Func}), put(test_server_loc, {Mod,{EndFunc,Func}}), 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("~s<font color=\"red\">" "WARNING: ~w thrown!" "</font>\n",[Comment0,EndFunc])), group_leader() ! {printout,12, "WARNING: ~w thrown!\n" "Reason: ~p\n" "Line: ~s\n", [EndFunc, Other, test_server_sup:format_loc( mod_loc(get_loc()))]}, {failed,{Mod,end_per_testcase,Other}}; 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("~s<font color=\"red\">" "WARNING: ~w crashed!" "</font>\n",[Comment0,EndFunc])), group_leader() ! {printout,12, "WARNING: ~w crashed!\n" "Reason: ~p\n" "Line: ~s\n", [EndFunc, Reason, test_server_sup:format_loc( mod_loc(get_loc()))]}, {failed,{Mod,end_per_testcase,Why}} 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 undefined -> put(test_server_loc, Stk); {Suite,Case} -> %% location info unknown, check if {Suite,Case,Line} %% is available in stacktrace. and if so, use stacktrace %% instead of currect test_server_loc case [match || {S,C,_L} <- Stk, S == Suite, C == Case] of [match|_] -> put(test_server_loc, Stk); _ -> ok end; _ -> ok end, get_loc(). %% find the latest known Suite:Testcase get_mf(MFs) -> get_mf(MFs, {undefined,undefined}). get_mf([MF|MFs], _Found) when is_tuple(MF) -> ModFunc = {Mod,_} = case MF of {M,F,_} -> {M,F}; MF -> MF end, case is_suite(Mod) of true -> ModFunc; false -> get_mf(MFs, ModFunc) end; get_mf(_, Found) -> Found. is_suite(Mod) -> case lists:reverse(atom_to_list(Mod)) of "ETIUS" ++ _ -> true; _ -> false end. mod_loc(Loc) -> %% handle diff line num versions case Loc of [{{_M,_F},_L}|_] -> [begin if L /= 0 -> {?pl2a(M),F,L}; true -> {?pl2a(M),F} end end || {{M,F},L} <- Loc]; [{_M,_F}|_] -> [{?pl2a(M),F} || {M,F} <- Loc]; {{M,F},0} -> [{?pl2a(M),F}]; {{M,F},L} -> [{?pl2a(M),F,L}]; {M,ForL} -> [{?pl2a(M),ForL}]; {M,F,0} -> [{M,F}]; [{M,F,0}|Stack] -> [{M,F}|Stack]; _ -> Loc end. fw_error_notify(Mod, Func, Args, Error) -> test_server_sup:framework_call(error_notification, [?pl2a(Mod),Func,[Args], {Error,unknown}]). fw_error_notify(Mod, Func, Args, Error, Loc) -> test_server_sup:framework_call(error_notification, [?pl2a(Mod),Func,[Args], {Error,Loc}]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% print(Detail,Format,Args,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) -> local_or_remote_apply({test_server_ctrl,print,[Detail,Format,Args]}). print(Detail,Format,Args,Printer) -> local_or_remote_apply({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) -> local_or_remote_apply({test_server_ctrl,print_timestamp,[Detail,Leader]}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% lookup_config(Key,Config) -> {value,{Key,Value}} | undefined %% Key = term() %% Value = term() %% Config = [{Key,Value},...] %% %% Looks up a specific key in the config list, and returns the value %% of the associated key, or undefined if the key doesn't exist. lookup_config(Key,Config) -> case lists:keysearch(Key,1,Config) of {value,{Key,Val}} -> Val; _ -> io:format("Could not find element ~p in Config.~n",[Key]), undefined end. %% timer:tc/3 ts_tc(M, F, A) -> Before = erlang:now(), Result = try apply(M, F, A) catch 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 = [rewrite_loc_item(I) || {_,_,_,_}=I <- Stk], 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!) %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% unicode_to_latin1(Chars) when is_list(Chars); is_binary(Chars) -> lists:flatten( [ case X of High when High > 255 -> io_lib:format("\\{~.8B}",[X]); Low -> Low end || X <- unicode:characters_to_list(Chars,unicode) ]); unicode_to_latin1(Garbage) -> Garbage. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% format(Format) -> IoLibReturn %% format(Detail,Format) -> IoLibReturn %% format(Format,Args) -> IoLibReturn %% format(Detail,Format,Args) -> IoLibReturn %% Detail = integer() %% Format = string() %% Args = [term(),...] %% IoLibReturn = term() %% %% Logs the Format string and Args, similar to io:format/1/2 etc. If %% Detail is not specified, the default detail level (which is 50) is used. %% Which log files the string will be logged in depends on the thresholds %% set with set_levels/3. Typically with default detail level, only the %% minor log file is used. format(Format) -> format(minor, Format, []). format(major, Format) -> format(major, Format, []); format(minor, Format) -> format(minor, Format, []); format(Detail, Format) when is_integer(Detail) -> format(Detail, Format, []); format(Format, Args) -> format(minor, Format, Args). format(Detail, Format, Args) -> Str = case catch io_lib:format(Format,Args) of {'EXIT',_} -> io_lib:format("illegal format; ~p with args ~p.\n", [Format,Args]); Valid -> Valid end, log({Detail, Str}). log(Msg) -> group_leader() ! {structured_io, self(), Msg}, ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% capture_start() -> ok %% capture_stop() -> ok %% %% Starts/stops capturing all output from io:format, and similar. Capturing %% output doesn't stop output from happening. It just makes it possible %% to retrieve the output using capture_get/0. %% Starting and stopping capture doesn't affect already captured output. %% All output is stored as messages in the message queue until retrieved capture_start() -> group_leader() ! {capture,self()}, ok. capture_stop() -> group_leader() ! {capture,false}, ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% capture_get() -> Output %% Output = [string(),...] %% %% Retrieves all the captured output since last call to capture_get/0. %% Note that since output arrive as messages to the process, it takes %% a short while from the call to io:format until all output is available %% by capture_get/0. It is not necessary to call capture_stop/0 before %% retreiving the output. capture_get() -> test_server_sup:capture_get([]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% messages_get() -> Messages %% Messages = [term(),...] %% %% Returns all messages in the message queue. messages_get() -> test_server_sup:messages_get([]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% 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~s executes on process ~w" "\n\n\n~s" "\n\n\n-----------------------------\n\n" "Continue with --> ~w:continue(~s).\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. timetrap_scale_factor() -> F0 = case test_server:purify_is_running() of true -> 5; false -> 1 end, F1 = case {is_debug(), has_lock_checking()} of {true,_} -> 6 * F0; {false,true} -> 2 * F0; {false,false} -> F0 end, F2 = case has_superfluous_schedulers() of true -> 3*F1; false -> F1 end, F = case test_server_sup:get_os_family() of vxworks -> 5 * F2; _ -> F2 end, case test_server:is_cover() of true -> 10 * F; false -> F end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% timetrap(Timeout) -> Handle %% Handle = term() %% %% Creates a time trap, that will kill the calling process if the %% trap is not cancelled with timetrap_cancel/1, within Timeout milliseconds. timetrap(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 -> MsgLooper = group_leader(), MsgLooper ! {get_timetrap_info,TCPid,self()}, receive {MsgLooper,get_timetrap_info,I} -> I end; [] -> 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). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% sync_send(Pid,Tag,Msg,Timeout,DoAfter) -> Result %% sync_send(Pid,Tag,Msg,Timeout,DoAfter) -> Pid ! {Tag,self(),Msg}, receive {Pid,Tag,Result} -> Result after Timeout -> DoAfter() 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() of true -> not is_shielded(Name) andalso same_version(Node); false -> false end, net_adm:ping(Node), case Cover of true -> Sticky = unstick_all_sticky(Node), cover:start(Node), stick_all_sticky(Node,Sticky); _ -> ok end, {ok,Node}; {fail,Reason} -> fail(Reason); Error -> Error end. firstname(N) -> list_to_atom(upto($@,atom_to_list(N))). %% This should!!! crash if H is not member in list. upto(H, [H | _T]) -> []; upto(H, [X | T]) -> [X | upto(H,T)]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% wait_for_node(Name) -> ok | {error,timeout} %% %% If a node is started with the options {wait,false}, this function %% can be used to wait for the node to come up from the %% test server point of view (i.e. wait until it has contacted %% the test server controller after startup) wait_for_node(Slave) -> group_leader() ! {sync_apply, self(), {test_server_ctrl,wait_for_node,[Slave]}}, receive {sync_result,R} -> R end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% stop_node(Name) -> true|false %% %% Kills a (remote) node. %% Also inform test_server_ctrl so it can clean up! stop_node(Slave) -> Nocover = is_shielded(Slave) orelse not same_version(Slave), case is_cover() of true when not Nocover -> Sticky = unstick_all_sticky(Slave), cover:stop(Slave), stick_all_sticky(Slave,Sticky); _ -> ok end, group_leader() ! {sync_apply,self(),{test_server_ctrl,stop_node,[Slave]}}, Result = receive {sync_result,R} -> R end, case Result of ok -> erlang:monitor_node(Slave, true), slave:stop(Slave), receive {nodedown, Slave} -> format(minor, "Stopped slave node: ~p", [Slave]), format(major, "=node_stop ~p", [Slave]), true after 30000 -> format("=== WARNING: Node ~p does not seem to terminate.", [Slave]), false end; {error, _Reason} -> %% Either, the node is already dead or it was started %% with the {cleanup,false} option, or it was started %% in some other way than test_server:start_node/3 format("=== WARNING: Attempt to stop a nonexisting slavenode (~p)~n" "=== Trying to kill it anyway!!!", [Slave]), case net_adm:ping(Slave)of pong -> slave:stop(Slave), true; pang -> false end end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% is_release_available(Release) -> true | false %% Release -> string() %% %% Test if a release (such as "r10b") is available to be %% started using start_node/3. is_release_available(Release) -> group_leader() ! {sync_apply, self(), {test_server_ctrl,is_release_available,[Release]}}, receive {sync_result,R} -> R end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% run_on_shielded_node(Fun, CArgs) -> term() %% Fun -> function() %% CArg -> list() %% %% %% Fun is executed in a process on a temporarily created %% hidden node. Communication with the job process goes %% via a job proxy process on the hidden node, i.e. the %% group leader of the test case process is the job proxy %% process. This makes it possible to start nodes from the %% hidden node that are unaware of the test server node. %% Without the job proxy process all processes would have %% a process residing on the test_server node as group_leader. %% %% Fun - Function to execute %% CArg - Extra command line arguments to use when starting %% the shielded node. %% %% If Fun is successfully executed, the result is returned. %% run_on_shielded_node(Fun, CArgs) when is_function(Fun), is_list(CArgs) -> {A,B,C} = now(), Name = "shielded_node-" ++ integer_to_list(A) ++ "-" ++ integer_to_list(B) ++ "-" ++ integer_to_list(C), Node = case start_node(Name, slave, [{args, "-hidden " ++ CArgs}]) of {ok, N} -> N; Err -> fail({failed_to_start_shielded_node, Err}) end, Master = self(), Ref = make_ref(), Slave = spawn(Node, fun () -> start_job_proxy(), receive Ref -> Master ! {Ref, Fun()} end, receive after infinity -> infinity end end), MRef = erlang:monitor(process, Slave), Slave ! Ref, receive {'DOWN', MRef, _, _, Info} -> stop_node(Node), fail(Info); {Ref, Res} -> stop_node(Node), receive {'DOWN', MRef, _, _, _} -> Res end end. %% Return true if Name or node() is a shielded node is_shielded(Name) -> case {cast_to_list(Name),atom_to_list(node())} of {"shielded_node"++_,_} -> true; {_,"shielded_node"++_} -> true; _ -> false end. same_version(Name) -> ThisVersion = erlang:system_info(version), OtherVersion = rpc:call(Name, erlang, system_info, [version]), ThisVersion =:= OtherVersion. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% temp_name(Stem) -> string() %% Stem = string() %% %% Create a unique file name, based on (starting with) Stem. %% A filename of the form <Stem><Number> is generated, and the %% function checks that that file doesn't already exist. temp_name(Stem) -> {A,B,C} = erlang:now(), RandomNum = A bxor B bxor C, RandomName = Stem ++ integer_to_list(RandomNum), {ok,Files} = file:list_dir(filename:dirname(Stem)), case lists:member(RandomName,Files) of true -> %% oh, already exists - bad luck. Try again. temp_name(Stem); %% recursively try again false -> RandomName end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% app_test/1 %% app_test(App) -> app_test(App, pedantic). app_test(App, Mode) -> test_server_sup:app_test(App, Mode). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% 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() -> MsgLooper = group_leader(), MsgLooper ! {read_comment,self()}, receive {MsgLooper,read_comment,Comment} -> Comment after 5000 -> "" end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% make_priv_dir() -> ok %% %% Order test server to create the private directory %% for the current test case. make_priv_dir() -> MsgLooper = group_leader(), group_leader() ! {make_priv_dir,self()}, receive {MsgLooper,make_priv_dir,Result} -> Result after 5000 -> error end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% os_type() -> OsType %% %% Returns the OsType of the target node. OsType is %% the same as returned from os:type() os_type() -> test_server_ctrl:get_target_os_type(). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% is_cover() -> boolean() %% %% Returns true if cover is running, else false is_cover() -> case whereis(cover_server) of undefined -> false; _ -> true end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% is_debug() -> boolean() %% %% Returns true if the emulator is debug-compiled, false otherwise. is_debug() -> case catch erlang:system_info(debug_compiled) of {'EXIT', _} -> case string:str(erlang:system_info(system_version), "debug") of Int when is_integer(Int), Int > 0 -> true; _ -> false end; Res -> Res end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% has_lock_checking() -> boolean() %% %% Returns true if the emulator has lock checking enabled, false otherwise. has_lock_checking() -> case catch erlang:system_info(lock_checking) of {'EXIT', _} -> false; Res -> Res end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% has_superfluous_schedulers() -> boolean() %% %% Returns true if the emulator has more scheduler threads than logical %% processors, false otherwise. has_superfluous_schedulers() -> case catch {erlang:system_info(schedulers), erlang:system_info(logical_processors)} of {S, P} when is_integer(S), is_integer(P), S > P -> true; _ -> false end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% is_commercial_build() -> boolean() %% %% Returns true if the current emulator is commercially supported. %% (The emulator will not have "[source]" in its start-up message.) %% We might want to do more tests on a commercial platform, for instance %% ensuring that all applications have documentation). is_commercial() -> case string:str(erlang:system_info(system_version), "source") of Int when is_integer(Int), Int > 0 -> false; _ -> true end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% DEBUGGER INTERFACE %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% purify_is_running() -> false|true %% %% Tests if Purify is currently running. purify_is_running() -> case catch erlang:system_info({error_checker, running}) of {'EXIT', _} -> false; Res -> Res end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% purify_new_leaks() -> false|BytesLeaked %% BytesLeaked = integer() %% %% Checks for new memory leaks if Purify is active. %% Returns the number of bytes leaked, or false if Purify %% is not running. purify_new_leaks() -> case catch erlang:system_info({error_checker, memory}) of {'EXIT', _} -> false; Leaked when is_integer(Leaked) -> Leaked end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% purify_new_fds_inuse() -> false|FdsInuse %% FdsInuse = integer() %% %% Checks for new file descriptors in use. %% Returns the number of new file descriptors in use, or false %% if Purify is not running. purify_new_fds_inuse() -> case catch erlang:system_info({error_checker, fd}) of {'EXIT', _} -> false; Inuse when is_integer(Inuse) -> Inuse end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% purify_format(Format, Args) -> ok %% Format = string() %% Args = lists() %% %% Outputs the formatted string to Purify's logfile,if Purify is active. purify_format(Format, Args) -> (catch erlang:system_info({error_checker, io_lib:format(Format, Args)})), ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% Generic send functions for communication with host %% sync_local_or_remote_apply(Proxy,From,{M,F,A} = MFA) -> case get(test_server_job_sock) of undefined -> %% i'm a local target Result = apply(M,F,A), if is_pid(Proxy) -> Proxy ! {sync_result_proxy,From,Result}; true -> From ! {sync_result,Result} end; JobSock -> %% i'm a remote target request(JobSock,{sync_apply,MFA}), {sync_result,Result} = recv(JobSock), if is_pid(Proxy) -> Proxy ! {sync_result_proxy,From,Result}; true -> From ! {sync_result,Result} end end. local_or_remote_apply({M,F,A} = MFA) -> case get(test_server_job_sock) of undefined -> %% i'm a local target apply(M,F,A), ok; JobSock -> %% i'm a remote target request(JobSock,{apply,MFA}), ok end. request(Sock,Request) -> gen_tcp:send(Sock,<<1,(term_to_binary(Request))/binary>>). %% %% Generic receive function for communication with host %% recv(Sock) -> case gen_tcp:recv(Sock,0) of {error,closed} -> gen_tcp:close(Sock), exit(connection_lost); {ok,<<1,Request/binary>>} -> binary_to_term(Request); {ok,<<0,B/binary>>} -> B end.