diff options
Diffstat (limited to 'lib/test_server/src')
| -rw-r--r-- | lib/test_server/src/erl2html2.erl | 247 | ||||
| -rw-r--r-- | lib/test_server/src/test_server.erl | 1044 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_ctrl.erl | 729 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_h.erl | 5 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_internal.hrl | 4 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_io.erl | 8 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_node.erl | 256 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_sup.erl | 39 | ||||
| -rw-r--r-- | lib/test_server/src/ts.erl | 101 | ||||
| -rw-r--r-- | lib/test_server/src/ts_run.erl | 2 |
10 files changed, 714 insertions, 1721 deletions
diff --git a/lib/test_server/src/erl2html2.erl b/lib/test_server/src/erl2html2.erl index 6891e87e48..9c459c05d4 100644 --- a/lib/test_server/src/erl2html2.erl +++ b/lib/test_server/src/erl2html2.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -18,19 +18,9 @@ %% %%%------------------------------------------------------------------ -%%% Purpose:Convert Erlang files to html. (Pretty faaast... :-) +%%% Purpose:Convert Erlang files to html. %%%------------------------------------------------------------------ -%-------------------------------------------------------------------- -% Some stats (Sparc5@110Mhz): -% 4109 lines (erl_parse.erl): 3.00 secs -% 1847 lines (application_controller.erl): 0.57 secs -% 3160 lines (test_server.erl): 1.00 secs -% 1199 lines (ts_estone.erl): 0.35 secs -% -% Avg: ~4.5e-4s/line, or ~0.45s/1000 lines, or ~2200 lines/sec. -%-------------------------------------------------------------------- - -module(erl2html2). -export([convert/2, convert/3]). @@ -52,134 +42,141 @@ convert(File, Dest) -> "<body bgcolor=\"white\" text=\"black\"" " link=\"blue\" vlink=\"purple\" alink=\"red\">\n"], convert(File, Dest, Header). - + + convert(File, Dest, Header) -> - case file:read_file(File) of - {ok, Bin} -> - Code=binary_to_list(Bin), - statistics(runtime), - {Html1, Lines} = root(Code, [], 1), - Html = [Header, - "<pre>\n", Html1, "</pre>\n", - footer(Lines),"</body>\n</html>\n"], - file:write_file(Dest, Html); - {error, Reason} -> - {error, Reason} + %% statistics(runtime), + case parse_file(File) of + {ok,Functions} -> + %% {_, Time1} = statistics(runtime), + %% io:format("Parsed file in ~.2f Seconds.~n",[Time1/1000]), + case file:open(File,[raw,{read_ahead,10000}]) of + {ok,SFd} -> + case file:open(Dest,[write,raw]) of + {ok,DFd} -> + file:write(DFd,[Header,"<pre>\n"]), + Lines = build_html(SFd,DFd,Functions), + file:write(DFd,["</pre>\n",footer(), + "</body>\n</html>\n"]), + %% {_, Time2} = statistics(runtime), + %% io:format("Converted ~p lines in ~.2f Seconds.~n", + %% [Lines, Time2/1000]), + file:close(SFd), + file:close(DFd), + ok; + Error -> + Error + end; + Error -> + Error + end; + Error -> + Error end. -root([], Res, Line) -> - {Res, Line}; -root([Char0|Code], Res, Line0) -> - Char = [Char0], - case Char of - "-" -> - {Match, Line1, NewCode0, AttName} = - read_to_char(Line0+1, Code, [], [$(, $.]), - {_, Line2, NewCode, Stuff} = read_to_char(Line1, NewCode0, [], $\n), - NewRes = [Res,linenum(Line0),"-<b>",AttName, - "</b>",Match, Stuff, "\n"], - root(NewCode, NewRes, Line2); - "%" -> - {_, Line, NewCode, Stuff} = read_to_char(Line0+1, Code, [], $\n), - NewRes = [Res,linenum(Line0),"<i>%",Stuff,"</i>\n"], - root(NewCode, NewRes, Line); - "\n" -> - root(Code, [Res,linenum(Line0), "\n"], Line0+1); - " " -> - {_, Line, NewCode, Stuff} = read_to_char(Line0+1, Code, [], $\n), - root(NewCode, [Res,linenum(Line0)," ",Stuff, "\n"], - Line); - "\t" -> - {_, Line, NewCode, Stuff} = read_to_char(Line0+1, Code, [], $\n), - root(NewCode, [Res,linenum(Line0),"\t",Stuff, "\n"], - Line); - [Chr|_] when Chr>96, Chr<123 -> - %% Assumed to be function/clause start. - %% FIXME: This will trivially generate non-unique anchors - %% (one for each clause) --- which is illegal HTML. - {_, Line1, NewCode0, FName0} = read_to_char(Line0+1, Code, [], $(), - {_, Line2, NewCode, Stuff} = - read_to_char(Line1,NewCode0, [], $\n), - FuncName = [[Chr],FName0], - NewRes=[Res,"<a name=",FuncName,">", - linenum(Line0),"<b>",FuncName,"</b></a>", - "(",Stuff, "\n"], - root(NewCode, NewRes, Line2); - Chr -> - {_, Line, NewCode, Stuff} = read_to_char(Line0+1, Code, [], $\n), - root(NewCode, [Res,linenum(Line0),Chr,Stuff, "\n"], - Line) +%%%----------------------------------------------------------------- +%%% Parse the input file to get the line numbers for all function +%%% definitions. This will be used when creating link targets for each +%%% function in build_html/5. +%%% +%%% All function clauses are also marked in order to allow +%%% possibly_enhance/2 to write these in bold. +parse_file(File) -> + case epp:open(File, [], []) of + {ok,Epp} -> + Forms = parse_file(Epp,File,false), + epp:close(Epp), + {ok,Forms}; + {error,E} -> + {error,E} end. -read_to_char(Line0, [], Res, _Chr) -> - {nomatch, Line0, [], Res}; -read_to_char(Line0, [Char|Code], Res, Chr) -> - case Char of - Chr -> {Char, Line0, Code, Res}; - _ when is_list(Chr) -> - case lists:member(Char,Chr) of - true -> - {Char, Line0, Code, Res}; - false -> - {Line,NewCode,NewRes} = maybe_convert(Line0,Code,Res,Char), - read_to_char(Line, NewCode, NewRes, Chr) + +parse_file(Epp,File,InCorrectFile) -> + case epp:parse_erl_form(Epp) of + {ok,Form} -> + case Form of + {attribute,_,file,{File,_}} -> + parse_file(Epp,File,true); + {attribute,_,file,{_OtherFile,_}} -> + parse_file(Epp,File,false); + {function,L,F,A,[_|C]} when InCorrectFile -> + Clauses = [{clause,CL} || {clause,CL,_,_,_} <- C], + [{atom_to_list(F),A,L} | Clauses] ++ + parse_file(Epp,File,true); + _ -> + parse_file(Epp,File,InCorrectFile) end; - _ -> - {Line,NewCode,NewRes} = maybe_convert(Line0,Code,Res,Char), - read_to_char(Line,NewCode, NewRes, Chr) + {error,_E} -> + parse_file(Epp,File,InCorrectFile); + {eof,_Location} -> + [] end. -maybe_convert(Line0,Code,Res,Chr) -> - case Chr of - %% Quoted stuff should not have the highlighting like normal code - %% FIXME: unbalanced quotes (e.g. in comments) will cause trouble with - %% highlighting and line numbering in the rest of the module. - $" -> - {_, Line1, NewCode, Stuff0} = read_to_char(Line0, Code, [], $"), - {Line2,Stuff} = add_linenumbers(Line1,lists:flatten(Stuff0),[]), - {Line2,NewCode,[Res,$",Stuff,$"]}; - %% These chars have meaning in HTML, and *must* *not* be - %% written as themselves. - $& -> - {Line0, Code, [Res,"&"]}; - $< -> - {Line0, Code, [Res,"<"]}; - $> -> - {Line0, Code, [Res,">"]}; - %% Everything else is simply copied. - OtherChr -> - {Line0, Code, [Res,OtherChr]} - end. +%%%----------------------------------------------------------------- +%%% Add a link target for each line and one for each function definition. +build_html(SFd,DFd,Functions) -> + build_html(SFd,DFd,file:read_line(SFd),1,Functions,false). -add_linenumbers(Line,[Chr|Chrs],Res) -> - case Chr of - $\n -> add_linenumbers(Line+1,Chrs,[Res,$\n,linenum(Line)]); - _ -> add_linenumbers(Line,Chrs,[Res,Chr]) - end; -add_linenumbers(Line,[],Res) -> - {Line,Res}. +build_html(SFd,DFd,{ok,Str},L,[{F,A,L}|Functions],_IsFuncDef) -> + FALink = http_uri:encode(F++"-"++integer_to_list(A)), + file:write(DFd,["<a name=\"",FALink,"\"/>"]), + build_html(SFd,DFd,{ok,Str},L,Functions,true); +build_html(SFd,DFd,{ok,Str},L,[{clause,L}|Functions],_IsFuncDef) -> + build_html(SFd,DFd,{ok,Str},L,Functions,true); +build_html(SFd,DFd,{ok,Str},L,Functions,IsFuncDef) -> + LStr = line_number(L), + Str1 = line(Str,IsFuncDef), + file:write(DFd,[LStr,Str1]), + build_html(SFd,DFd,file:read_line(SFd),L+1,Functions,false); +build_html(_SFd,_DFd,eof,L,_Functions,_IsFuncDef) -> + L. -%% Make nicely indented line numbers. -linenum(Line) -> - Num = integer_to_list(Line), - A = case Line rem 10 of - 0 -> "<a name=\"" ++ Num ++"\"></a>"; - _ -> [] - end, +line_number(L) -> + LStr = integer_to_list(L), Pred = - case length(Num) of + case length(LStr) of Length when Length < 5 -> lists:duplicate(5-Length,$\s); _ -> [] end, - [A,Pred,integer_to_list(Line),":"]. + ["<a name=\"",LStr,"\"/>",Pred,LStr,": "]. + +line(Str,IsFuncDef) -> + Str1 = htmlize(Str), + possibly_enhance(Str1,IsFuncDef). + +%%%----------------------------------------------------------------- +%%% Substitute special characters that should not appear in HTML +htmlize([$<|Str]) -> + [$&,$l,$t,$;|htmlize(Str)]; +htmlize([$>|Str]) -> + [$&,$g,$t,$;|htmlize(Str)]; +htmlize([$&|Str]) -> + [$&,$a,$m,$p,$;|htmlize(Str)]; +htmlize([$"|Str]) -> + [$&,$q,$u,$o,$t,$;|htmlize(Str)]; +htmlize([Ch|Str]) -> + [Ch|htmlize(Str)]; +htmlize([]) -> + []. + +%%%----------------------------------------------------------------- +%%% Write comments in italic and function definitions in bold. +possibly_enhance(Str,true) -> + case lists:splitwith(fun($() -> false; (_) -> true end, Str) of + {_,[]} -> Str; + {F,A} -> ["<b>",F,"</b>",A] + end; +possibly_enhance([$%|_]=Str,_) -> + ["<i>",Str--"\n","</i>","\n"]; +possibly_enhance([$-|_]=Str,_) -> + possibly_enhance(Str,true); +possibly_enhance(Str,false) -> + Str. -footer(_Lines) -> +%%%----------------------------------------------------------------- +%%% End of the file +footer() -> "". -%% {_, Time} = statistics(runtime), -%% io:format("Converted ~p lines in ~.2f Seconds.~n", -%% [Lines, Time/1000]), -%% S = "<i>The transformation of this file (~p lines) took ~.2f seconds</i>", -%% F = lists:flatten(io_lib:format(S, [Lines, Time/1000])), -%% ["<hr size=1>",F,"<br>\n"]. diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index bcffe896c4..14cdfd391a 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -20,15 +20,12 @@ -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]). +-export([cover_compile/1,cover_analyse/3]). %%% TEST_SERVER_SUP INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([get_loc/1]). +-export([get_loc/1,set_tc_state/1]). %%% TEST SUITE INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -export([lookup_config/2]). @@ -60,49 +57,11 @@ -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(), @@ -118,171 +77,10 @@ init_target_info() -> 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} @@ -377,9 +175,7 @@ module_names(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([Dont|Rest]) when Dont=:=cover -> do_cover_compile1(Rest); do_cover_compile1([M|Rest]) -> case {code:is_sticky(M),code:is_loaded(M)} of @@ -416,7 +212,7 @@ do_cover_compile1([]) -> ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% cover_analyse(Analyse,Modules) -> [{M,{Cov,NotCov,Details}}] +%% cover_analyse(Analyse,Modules,Stop) -> [{M,{Cov,NotCov,Details}}] %% %% Analyse = {details,Dir} | details | {overview,void()} | overview %% Modules = [atom()], the modules to analyse @@ -432,8 +228,19 @@ do_cover_compile1([]) -> %% %% 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",[]), +%% +%% 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(Analyse,Modules,Stop) -> + print(stdout, "Cover analysing...\n", []), DetailsFun = case Analyse of {details,Dir} -> @@ -483,9 +290,15 @@ cover_analyse(Analyse,Modules) -> {M,Err} end end, Modules), - Sticky = unstick_all_sticky(node()), - cover:stop(), - stick_all_sticky(node(),Sticky), + + case Stop of + true -> + Sticky = unstick_all_sticky(node()), + cover:stop(), + stick_all_sticky(node(),Sticky); + false -> + ok + end, R. pmap(Fun,List) -> @@ -502,7 +315,20 @@ pmap(Fun,List) -> end end, Pids). + +do_cover_for_node(Node,CoverFunc) -> + %% 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 = unstick_all_sticky(MainCoverNode,Node), + rpc:call(MainCoverNode,cover,CoverFunc,[Node]), + stick_all_sticky(Node,Sticky). + unstick_all_sticky(Node) -> + unstick_all_sticky(node(),Node). +unstick_all_sticky(MainCoverNode,Node) -> lists:filter( fun(M) -> case code:is_sticky(M) of @@ -513,7 +339,7 @@ unstick_all_sticky(Node) -> false end end, - cover:modules()). + rpc:call(MainCoverNode,cover,modules,[])). stick_all_sticky(Node,Sticky) -> lists:foreach( @@ -578,34 +404,23 @@ run_test_case_apply({CaseNum,Mod,Func,Args,Name, DetFail = get(test_server_detected_fail), {Result,DetFail,ProcBef,ProcAft}. -run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> - case get(test_server_job_dir) of - undefined -> - %% i'm a local target - do_run_test_case_apply(Mod, Func, Args, Name, RunInit, - TimetrapData); - 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); - _other -> - do_run_test_case_apply(Mod, Func, Args, Name, RunInit, - TimetrapData) - end - end. +-type tc_status() :: 'starting' | 'running' | 'init_per_testcase' | + 'end_per_testcase' | {'framework',atom(),atom()} | + 'tc'. +-record(st, + { + ref :: reference(), + pid :: pid(), + mf :: {atom(),atom()}, + status :: tc_status() | 'undefined', + ret_val :: term(), + comment :: list(char()), + timeout :: non_neg_integer() | 'infinity', + config :: list() | 'undefined', + end_conf_pid :: pid() | 'undefined' + }). -do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> +run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> {ok,Cwd} = file:get_cwd(), Args2Print = case Args of [Args1] when is_list(Args1) -> @@ -628,8 +443,9 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> LogOpts, TCCallback) end), put(test_server_detected_fail, []), - run_test_case_msgloop(Ref, Pid, false, "", - undefined, starting). + St = #st{ref=Ref,pid=Pid,mf={Mod,Func},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 @@ -640,31 +456,23 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> %% 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, 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, +run_test_case_msgloop(#st{ref=Ref,pid=Pid,end_conf_pid=EndConfPid0}=St0) -> receive - {test_case_initialized,Pid} -> - run_test_case_msgloop(Ref,Pid,Terminate, - Comment,CurrConf,running); - Abort = {abort_current_testcase,_,_} when Status == starting -> + {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(Ref,Pid,Terminate, - Comment,CurrConf,Status); + run_test_case_msgloop(St0); {abort_current_testcase,Reason,From} -> Line = case is_process_alive(Pid) of true -> get_loc(Pid); @@ -674,65 +482,49 @@ run_test_case_msgloop(Ref, Pid, Terminate, Comment, CurrConf, Status) -> 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) || + 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])]), - if length(Error1) > 63 -> - string:substr(Error1,1,60) ++ "..."; - true -> - Error1 - end - end, - run_test_case_msgloop(Ref,Pid,Terminate, - NewComment,CurrConf,Status); + 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} -> sync_local_or_remote_apply(false,From,MFA), - run_test_case_msgloop(Ref,Pid,Terminate, - Comment,CurrConf,Status); + run_test_case_msgloop(St0); {sync_apply_proxy,Proxy,From,MFA} -> sync_local_or_remote_apply(Proxy,From,MFA), - run_test_case_msgloop(Ref,Pid,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,Terminate1, - NewComment2,CurrConf,Status); + 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,Comment}, - run_test_case_msgloop(Ref,Pid,Terminate, - Comment,CurrConf,Status); - {set_curr_conf,From,NewCurrConf} -> - From ! {self(),set_curr_conf,ok}, - run_test_case_msgloop(Ref,Pid,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,Terminate, - Comment,CurrConf,Status); + 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, element(2, CurrConf)) of + case proplists:get_value(priv_dir, Config) of undefined -> {error,no_priv_dir_in_config}; PrivDir -> @@ -746,207 +538,63 @@ run_test_case_msgloop(Ref, Pid, Terminate, Comment, CurrConf, Status) -> end end, From ! {self(),make_priv_dir,Result}, - run_test_case_msgloop(Ref,Pid,Terminate, - Comment,CurrConf,Status); + run_test_case_msgloop(St0); {'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} -> - RetVal = {Time/1000000,Value,mod_loc(Loc),Opts,Comment}, - run_test_case_msgloop(Ref,Pid, - {true,RetVal},Comment,undefined,Status); + RetVal = {Time/1000000,Value,Loc,Opts}, + St = setup_termination(RetVal, St0#st{config=undefined}), + run_test_case_msgloop(St); {'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, - 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, - 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, - 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, - 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, - 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, - 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, - 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, - 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, - Terminate,Comment,CurrConf,Status) - end; - {EndConfPid,{call_end_conf,Data,_Result}} -> + St = handle_tc_exit(Reason, St0), + run_test_case_msgloop(St); + {EndConfPid0,{call_end_conf,Data,_Result}} -> + #st{mf={Mod,Func},config=CurrConf} = St0, case CurrConf of - {EndConfPid,{Mod,Func},_Conf} -> + _ when is_list(CurrConf) -> {_Mod,_Func,TCPid,TCExitReason,Loc} = Data, spawn_fw_call(Mod,Func,CurrConf,TCPid, TCExitReason,Loc,self()), - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,undefined,Status); + St = St0#st{config=undefined,end_conf_pid=undefined}, + run_test_case_msgloop(St); _ -> - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,CurrConf,Status) + run_test_case_msgloop(St0) 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, - {true,RetVal},Comment,undefined,Status); + 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}; + [{test_server,Func}]; _ -> - {list_to_atom(CB),Func} + [{list_to_atom(CB),Func}] end, - RetVal = {died,{framework_error,Loc,Error},Loc,"Framework error"}, - run_test_case_msgloop(Ref,Pid, - {true,RetVal},Comment,undefined,Status); + 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(Ref,Pid, - Terminate,Comment,CurrConf,Status); + run_test_case_msgloop(St0); {user_timetrap,Pid,_TrapTime,StartTime,E={user_timetrap_error,_},_} -> case update_user_timetraps(Pid, StartTime) of @@ -955,8 +603,7 @@ run_test_case_msgloop(Ref, Pid, Terminate, Comment, CurrConf, Status) -> ignore -> ok end, - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,CurrConf,Status); + 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 @@ -971,44 +618,117 @@ run_test_case_msgloop(Ref, Pid, Terminate, Comment, CurrConf, Status) -> ignore -> ok end, - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,CurrConf,Status); + run_test_case_msgloop(St0); {timetrap_cancel_one,Handle,_From} -> timetrap_cancel_one(Handle, false), - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,CurrConf,Status); + run_test_case_msgloop(St0); {timetrap_cancel_all,TCPid,_From} -> timetrap_cancel_all(TCPid, false), - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,CurrConf,Status); + 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(Ref,Pid, - Terminate,Comment,CurrConf,Status); + run_test_case_msgloop(St0); _Other when not is_tuple(_Other) -> %% ignore anything not generated by test server - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,CurrConf,Status); + 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(Ref,Pid, - Terminate,Comment,CurrConf,Status) - after Timeout -> - ReturnValue + 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 -> + {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 -> + {Other,unknown} + 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}, EndConfProc = fun() -> + process_flag(trap_exit,true), % to catch timetraps Supervisor = self(), EndConfApply = fun() -> + timetrap(TVal), case catch apply(Mod,end_per_testcase,[Func,Conf]) of {'EXIT',Why} -> timer:sleep(1), @@ -1027,26 +747,26 @@ call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) -> {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}}} + " 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},_,Pid,{timetrap_timeout,TVal}=Why, +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 - case catch do_end_tc_call(Mod,Func, Loc, {Pid,Skip,[[]]}, Why) of + case catch do_end_tc_call(Mod,Func, {Pid,Skip,[CurrConf]}, Why) of {'EXIT',FwEndTCErr} -> exit({fw_notify_done,end_tc,FwEndTCErr}); _ -> @@ -1060,19 +780,10 @@ spawn_fw_call(Mod,{init_per_testcase,Func},_,Pid,{timetrap_timeout,TVal}=Why, 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() -> {RetVal,Report} = - case proplists:get_value(tc_status, EndConf1) of + case proplists:get_value(tc_status, EndConf) of undefined -> E = {failed,{Mod,end_per_testcase,Why}}, {E,E}; @@ -1086,9 +797,9 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid, "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 + FailLoc = proplists:get_value(tc_fail_loc, EndConf), + case catch do_end_tc_call(Mod,Func, + {Pid,Report,[EndConf]}, Why) of {'EXIT',FwEndTCErr} -> exit({fw_notify_done,end_tc,FwEndTCErr}); _ -> @@ -1122,14 +833,9 @@ spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) -> 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() -> - case catch fw_error_notify(Mod1,Func1,[], + case catch fw_error_notify(Mod,Func,[], Error,Loc) of {'EXIT',FwErrorNotifyErr} -> exit({fw_notify_done,error_notification, @@ -1137,8 +843,8 @@ spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) -> _ -> ok end, - Conf = [{tc_status,{failed,timetrap_timeout}}], - case catch do_end_tc_call(Mod1,Func1, Loc, + Conf = [{tc_status,{failed,timetrap_timeout}}|CurrConf], + case catch do_end_tc_call(Mod,Func, {Pid,Error,[Conf]},Error) of {'EXIT',FwEndTCErr} -> exit({fw_notify_done,end_tc,FwEndTCErr}); @@ -1203,81 +909,73 @@ 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,[?pl2a(Mod),Func,Args0], {ok,Args0}), - group_leader() ! {test_case_initialized,self()}, + 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} -> - Where = {Mod,Func}, - NewResult = do_end_tc_call(Mod,Func, Where, {Error,Args0}, + NewResult = do_end_tc_call(Mod,Func, {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]}, + NewResult = do_end_tc_call(Mod,Func, {{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), + NewResult = do_end_tc_call(Mod,Func, {Skip,Args0}, Skip), {{0,NewResult},Where,[]}; {auto_skip,Reason} -> - Where = {Mod,Func}, - NewResult = do_end_tc_call(Mod,Func, Where, {{skip,Reason},Args0}, + NewResult = do_end_tc_call(Mod,Func, {{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 - tc_supervisor_req(set_curr_conf, {{Mod,Func},hd(Args)}), 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}}), + set_tc_state(init_per_testcase, hd(Args)), 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), + 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}], - NewRes = do_end_tc_call(Mod,Func, Line, {{skip,Reason},[Conf]}, + 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, {Mod,Func}, + NewRes = do_end_tc_call(Mod,Func, {{error,Reason},[EndConf]}, FailTC), - {{0,NewRes},{Mod,Func},[]}; + {{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 - tc_supervisor_req(set_curr_conf, {{Mod,Func},NewConf1}), - put(test_server_loc, {Mod,Func}), + 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 -> - ModLoc = mod_loc(Loc), fw_error_notify(Mod, Func, NewConf1, - TCError, ModLoc), + TCError, Loc), {[{tc_status,{failed,TCError}}, - {tc_fail_loc,ModLoc}|NewConf1], + {tc_fail_loc,Loc}|NewConf1], Return,{error,TCError}}; SaveCfg={save_config,_} -> {[{tc_status,ok},SaveCfg|NewConf1],Return,ok}; @@ -1294,7 +992,6 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> %% call user callback function if defined EndConf1 = user_callback(TCCallback, Mod, Func, 'end', EndConf), %% update current state in controller loop - tc_supervisor_req(set_curr_conf, EndConf1), {FWReturn1,TSReturn1,EndConf2} = case end_per_testcase(Mod, Func, EndConf1) of SaveCfg1={save_config,_} -> @@ -1314,23 +1011,21 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> {FWReturn,TSReturn,EndConf1} end, %% clear current state in controller loop - tc_supervisor_req(set_curr_conf, undefined), - put(test_server_init_or_end_conf,undefined), - case do_end_tc_call(Mod,Func, Loc, + 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},[]}; + {{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 - 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; @@ -1341,43 +1036,12 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> %% 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), + 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, +do_end_tc_call(Mod, Func, Res, Return) -> 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( @@ -1419,7 +1083,7 @@ process_return_val([Return], M,F,A, Loc, Final) when is_list(Return) -> 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 + case do_end_tc_call(M, F, {ok,A}, Return) of {failed, FWReason} = Failed -> fw_error_notify(M,F,A, FWReason), {Failed, []}; @@ -1435,9 +1099,9 @@ process_return_val(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]]}, + 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}; @@ -1455,8 +1119,8 @@ process_return_val1([RetVal={Tag,_}|Opts], M,F,A, Loc, _, SaveOpts) when Tag==sk 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 +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 -> @@ -1522,7 +1186,7 @@ do_init_per_testcase(Mod, Args) -> throw:Other -> set_loc(erlang:get_stacktrace()), Line = get_loc(), - FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), + FormattedLoc = test_server_sup:format_loc(Line), group_leader() ! {printout,12, "ERROR! init_per_testcase thrown!\n" "\tLocation: ~s\n\tReason: ~p\n", @@ -1533,7 +1197,7 @@ do_init_per_testcase(Mod, Args) -> Reason = {Reason0,Stk}, set_loc(Stk), Line = get_loc(), - FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), + FormattedLoc = test_server_sup:format_loc(Line), group_leader() ! {printout,12, "ERROR! init_per_testcase crashed!\n" "\tLocation: ~s\n\tReason: ~p\n", @@ -1556,8 +1220,7 @@ end_per_testcase(Mod, Func, Conf) -> 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}}), + set_tc_state(end_per_testcase, Conf), try Mod:EndFunc(Func, Conf) of {save_config,_}=SaveCfg -> SaveCfg; @@ -1581,8 +1244,7 @@ do_end_per_testcase(Mod,EndFunc,Func,Conf) -> "Reason: ~p\n" "Line: ~s\n", [EndFunc, Other, - test_server_sup:format_loc( - mod_loc(get_loc()))]}, + test_server_sup:format_loc(get_loc())]}, {failed,{Mod,end_per_testcase,Other}}; Class:Reason -> Stk = erlang:get_stacktrace(), @@ -1604,8 +1266,7 @@ do_end_per_testcase(Mod,EndFunc,Func,Conf) -> "Reason: ~p\n" "Line: ~s\n", [EndFunc, Reason, - test_server_sup:format_loc( - mod_loc(get_loc()))]}, + test_server_sup:format_loc(get_loc())]}, {failed,{Mod,end_per_testcase,Why}} end. @@ -1618,66 +1279,19 @@ get_loc(Pid) -> 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} -> + [{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 + %% instead of current test_server_loc case [match || {S,C,_L} <- Stk, S == Suite, C == Case] of [match|_] -> put(test_server_loc, Stk); _ -> ok end; _ -> - ok + put(test_server_loc, Stk) 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], @@ -1699,10 +1313,10 @@ fw_error_notify(Mod, Func, Args, Error, Loc) -> %% 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]}). + test_server_ctrl:print(Detail, Format, Args). print(Detail,Format,Args,Printer) -> - local_or_remote_apply({test_server_ctrl,print,[Detail,Format,Args,Printer]}). + test_server_ctrl:print(Detail, Format, Args, Printer). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% print_timsteamp(Detail,Leader) -> ok @@ -1712,7 +1326,7 @@ print(Detail,Format,Args,Printer) -> %% log files. print_timestamp(Detail,Leader) -> - local_or_remote_apply({test_server_ctrl,print_timestamp,[Detail,Leader]}). + test_server_ctrl:print_timestamp(Detail, Leader). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1760,7 +1374,12 @@ ts_tc(M, F, A) -> {Elapsed, Result}. set_loc(Stk) -> - Loc = [rewrite_loc_item(I) || {_,_,_,_}=I <- 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}) -> @@ -2569,7 +2188,10 @@ start_node(Name, Type, Options) -> %% by a shielded node. Cover = case is_cover() of true -> - not is_shielded(Name) andalso same_version(Node); + not is_shielded(Name) + andalso same_version(Node) + andalso proplists:get_value(start_cover,Options, + true); false -> false end, @@ -2577,9 +2199,7 @@ start_node(Name, Type, Options) -> net_adm:ping(Node), case Cover of true -> - Sticky = unstick_all_sticky(Node), - cover:start(Node), - stick_all_sticky(Node,Sticky); + do_cover_for_node(Node,start); _ -> ok end, @@ -2607,7 +2227,27 @@ wait_for_node(Slave) -> group_leader() ! {sync_apply, self(), {test_server_ctrl,wait_for_node,[Slave]}}, - receive {sync_result,R} -> R end. + Result = receive {sync_result,R} -> R end, + case Result of + ok -> + Cover = case is_cover() of + true -> + not is_shielded(Slave) andalso same_version(Slave); + false -> + false + end, + + net_adm:ping(Slave), + case Cover of + true -> + do_cover_for_node(Slave,start); + _ -> + ok + end; + _ -> + ok + end, + Result. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2619,9 +2259,7 @@ 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); + do_cover_for_node(Slave,flush); _ -> ok end, @@ -2818,7 +2456,7 @@ make_priv_dir() -> %% 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(). + os:type(). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2937,47 +2575,9 @@ purify_format(Format, Args) -> %% %% 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 +sync_local_or_remote_apply(Proxy, From, {M,F,A}) -> + %% 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. diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index 7f04e2eb23..bc08c12089 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -34,118 +34,6 @@ %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% ARCHITECTURE -%% -%% The Erlang Test Server can be run on the target machine (local target) -%% or towards a remote target. The execution flow is mainly the same in -%% both cases, but with a remote target the test cases are (obviously) -%% executed on the target machine. Host and target communicates over -%% socket connections because the host should not be introduced as an -%% additional node in the distributed erlang system in which the test -%% cases are run. -%% -%% -%% Local Target: -%% ============= -%% -%% ----- -%% | | test_server_ctrl ({global,test_server}) -%% ----- (test_server_ctrl.erl) -%% | -%% | -%% ----- -%% | | JobProc -%% ----- (test_server_ctrl.erl and test_server.erl) -%% | -%% | -%% ----- -%% | | CaseProc -%% ----- (test_server.erl) -%% -%% -%% -%% test_server_ctrl is the main process in the system. It is a registered -%% process, and it will always be alive when testing is ongoing. -%% test_server_ctrl initiates testing and monitors JobProc(s). -%% -%% When target is local, and Test Server is *not* being used by a framework -%% application (where it might cause duplicate name problems in a distributed -%% test environment), the process is globally registered as 'test_server' -%% to be able to simulate the {global,test_server} process on a remote target. -%% -%% JobProc is spawned for each 'job' added to the test_server_ctrl. -%% A job can mean one test case, one test suite or one spec. -%% JobProc creates and writes logs and presents results from testing. -%% JobProc is the group leader for CaseProc. -%% -%% CaseProc is spawned for each test case. It runs the test case and -%% sends results and any other information to its group leader - JobProc. -%% -%% -%% -%% Remote Target: -%% ============== -%% -%% HOST TARGET -%% -%% ----- MainSock ----- -%% test_server_ctrl | |- - - - - - -| | {global,test_server} -%% (test_server_ctrl.erl) ----- ----- (test_server.erl) -%% | | -%% | | -%% ----- JobSock ----- -%% JobProcH | |- - - - - - -| | JobProcT -%% (test_server_ctrl.erl) ----- ----- (test_server.erl) -%% | -%% | -%% ----- -%% | | CaseProc -%% ----- (test_server.erl) -%% -%% -%% -%% -%% A separate test_server process only exists when target is remote. It -%% is then the main process on target. It is started when test_server_ctrl -%% is started, and a socket connection is established between -%% test_server_ctrl and test_server. The following information can be sent -%% over MainSock: -%% -%% HOST TARGET -%% -> {target_info, TargetInfo} (during initiation) -%% <- {job_proc_killed,Name,Reason} (if a JobProcT dies unexpectedly) -%% -> {job,Port,Name} (to start a new JobProcT) -%% -%% -%% When target is remote, JobProc is split into to processes: JobProcH -%% executing on Host and JobProcT executing on Target. (The two processes -%% execute the same code as JobProc does when target is local.) JobProcH -%% and JobProcT communicates over a socket connection. The following -%% information can be sent over JobSock: -%% -%% HOST TARGET -%% -> {test_case, Case} To start a new test case -%% -> {beam,Mod} .beam file as binary to be loaded -%% on target, e.g. a test suite -%% -> {datadir,Tarfile} Content of the datadir for a test suite -%% <- {apply,MFA} MFA to be applied on host, ignore return; -%% (apply is used for printing information in -%% log or console) -%% <- {sync_apply,MFA} MFA to be applied on host, wait for return -%% (used for starting and stopping slave nodes) -%% -> {sync_apply,MFA} MFA to be applied on target, wait for return -%% (used for cover compiling and analysing) -%% <-> {sync_result,Result} Return value from sync_apply -%% <- {test_case_result,Result} When a test case is finished -%% <- {crash_dumps,Tarfile} When a test case is finished -%% -> job_done When a job is finished -%% <- {privdir,Privdir} When a job is finished -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - - %%% SUPERVISOR INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -export([start/0, start/1, start_link/1, stop/0]). @@ -165,8 +53,8 @@ -export([reject_io_reqs/1, get_levels/0, set_levels/3]). -export([multiply_timetraps/1, scale_timetraps/1, get_timetrap_parameters/0]). -export([create_priv_dir/1]). --export([cover/2, cover/3, cover/7, - cross_cover_analyse/1, cross_cover_analyse/2, trc/1, stop_trace/0]). +-export([cover/2, cover/3, cover/8, + cross_cover_analyse/2, cross_cover_analyse/3, trc/1, stop_trace/0]). -export([testcase_callback/1]). -export([set_random_seed/1]). -export([kill_slavenodes/0]). @@ -177,7 +65,6 @@ -export([format/1, format/2, format/3, to_string/1]). -export([get_target_info/0]). -export([get_hosts/0]). --export([get_target_os_type/0]). -export([node_started/1]). %%% DEBUGGER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -463,8 +350,7 @@ wait_finish() -> ok. abort_current_testcase(Reason) -> - controller_call({abort_current_testcase,Reason}), - ok. + controller_call({abort_current_testcase,Reason}). abort() -> OldTrap = process_flag(trap_exit, true), @@ -521,9 +407,9 @@ cover(App, Analyse) when is_atom(App) -> cover(CoverFile, Analyse) -> cover(none, CoverFile, Analyse). cover(App, CoverFile, Analyse) -> - controller_call({cover,{App,CoverFile},Analyse}). -cover(App, CoverFile, Exclude, Include, Cross, Export, Analyse) -> - controller_call({cover,{App,{CoverFile,Exclude,Include,Cross,Export}},Analyse}). + controller_call({cover,{App,CoverFile},Analyse,true}). +cover(App, CoverFile, Exclude, Include, Cross, Export, Analyse, Stop) -> + controller_call({cover,{App,{CoverFile,Exclude,Include,Cross,Export}},Analyse,Stop}). testcase_callback(ModFunc) -> controller_call({testcase_callback,ModFunc}). @@ -537,20 +423,6 @@ kill_slavenodes() -> get_hosts() -> get(test_server_hosts). -get_target_os_type() -> - case whereis(?MODULE) of - undefined -> - %% This is probably called on the target node - os:type(); - Pid when Pid =:= self() -> - os:type(); - _pid -> - %% This is called on the controller, e.g. from a - %% specification clause of a test case - #target_info{os_type=OsType} = controller_call(get_target_info), - OsType - end. - %%-------------------------------------------------------------------- add_job(Name, TopCase) -> @@ -606,7 +478,7 @@ controller_call(Arg, Timeout) -> %% Mode 'lazy' ignores (and resets to []) any jobs in the state file %% -init([Param]) -> +init([_]) -> case os:getenv("TEST_SERVER_CALL_TRACE") of false -> ok; @@ -632,104 +504,14 @@ init([Param]) -> test_server_sup:cleanup_crash_dumps(), State = #state{jobs=[],finish=false}, put(test_server_free_targets,[]), - case contact_main_target(Param) of - {ok,TI} -> - ets:new(slave_tab, [named_table,set,public,{keypos,2}]), - set_hosts([TI#target_info.host]), - {ok,State#state{target_info=TI}}; - {error,Reason} -> - {stop,Reason} - end. - - -%% If the test is to be run at a remote target, this function sets up -%% a socket communication with the target. -contact_main_target(local) -> - %% When used by a general framework, global registration of - %% test_server should not be required. - case get_fw_mod(undefined) of - undefined -> - %% Local target! The global test_server process implemented by - %% test_server.erl will not be started, so we simulate it by - %% globally registering this process instead. - global:sync(), - case global:whereis_name(test_server) of - undefined -> - global:register_name(test_server, self()); - Pid -> - case node() of - N when N == node(Pid) -> - io:format(user, "Warning: test_server already running!\n", []), - global:re_register_name(test_server,self()); - _ -> - ok - end - end; - _ -> - ok - end, - TI = test_server:init_target_info(), + TI0 = test_server:init_target_info(), TargetHost = test_server_sup:hoststr(), - {ok,TI#target_info{where=local, - host=TargetHost, - naming=naming(), - master=TargetHost}}; - -contact_main_target(ParameterFile) -> - case read_parameters(ParameterFile) of - {ok,Par} -> - case test_server_node:start_remote_main_target(Par) of - {ok,TI} -> - {ok,TI}; - {error,Error} -> - {error,{could_not_start_main_target,Error}} - end; - {error,Error} -> - {error,{could_not_read_parameterfile,Error}} - end. - -read_parameters(File) -> - case file:consult(File) of - {ok,Data} -> - read_parameters(lists:flatten(Data), #par{naming=naming()}); - Error -> - Error - end. -read_parameters([{type,Type}|Data], Par) -> % mandatory - read_parameters(Data, Par#par{type=Type}); -read_parameters([{target,Target}|Data], Par) -> % mandatory - read_parameters(Data, Par#par{target=cast_to_list(Target)}); -read_parameters([{slavetargets,SlaveTargets}|Data], Par) -> - read_parameters(Data, Par#par{slave_targets=SlaveTargets}); -read_parameters([{longnames,Bool}|Data], Par) -> - Naming = if Bool->"-name"; true->"-sname" end, - read_parameters(Data, Par#par{naming=Naming}); -read_parameters([{master,{Node,Cookie}}|Data], Par) -> - read_parameters(Data, Par#par{master=cast_to_list(Node), - cookie=cast_to_list(Cookie)}); -read_parameters([Other|_Data], _Par) -> - {error,{illegal_parameter,Other}}; -read_parameters([], Par) when Par#par.type==undefined -> - {error, {missing_mandatory_parameter,type}}; -read_parameters([], Par) when Par#par.target==undefined -> - {error, {missing_mandatory_parameter,target}}; -read_parameters([], Par0) -> - Par = - case {Par0#par.type, Par0#par.master} of - {ose, undefined} -> - %% Use this node as master and bootserver for target - %% and slave nodes - Par0#par{master = atom_to_list(node()), - cookie = atom_to_list(erlang:get_cookie())}; - {ose, _Master} -> - %% Master for target and slave nodes was defined in parameterfile - Par0; - _ -> - %% Use target as master for slave nodes, - %% (No master is used for target) - Par0#par{master="test_server@" ++ Par0#par.target} - end, - {ok,Par}. + TI = TI0#target_info{host=TargetHost, + naming=naming(), + master=TargetHost}, + ets:new(slave_tab, [named_table,set,public,{keypos,2}]), + set_hosts([TI#target_info.host]), + {ok,State#state{target_info=TI}}. naming() -> case lists:member($., test_server_sup:hoststr()) of @@ -796,7 +578,7 @@ handle_call({add_job,Dir,Name,TopCase,Skip}, _From, State) -> ExtraTools = case State#state.cover of false -> []; - {App,Analyse} -> [{cover,App,Analyse}] + {App,Analyse,Stop} -> [{cover,App,Analyse,Stop}] end, ExtraTools1 = case State#state.random_seed of @@ -1052,13 +834,13 @@ handle_call(stop_trace, _From, State) -> {reply,R,State#state{trc=false}}; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({cover,App,Analyse}, _, State) -> ok | {error,Reason} +%% handle_call({cover,App,Analyse,Stop}, _, State) -> ok | {error,Reason} %% %% All modules inn application App are cover compiled %% Analyse indicates on which level the coverage should be analysed -handle_call({cover,App,Analyse}, _From, State) -> - {reply,ok,State#state{cover={App,Analyse}}}; +handle_call({cover,App,Analyse,Stop}, _From, State) -> + {reply,ok,State#state{cover={App,Analyse,Stop}}}; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% handle_call({create_priv_dir,Value}, _, State) -> ok | {error,Reason} @@ -1210,25 +992,17 @@ handle_cast({node_started,Node}, State) -> %% Pid = pid() %% Reason = term() %% -%% Handles exit messages from linked processes. Only test suites and -%% possibly a target client are expected to be linked. -%% When a test suite terminates, it is removed from the job queue. -%% If a target client terminates it means that we lost contact with -%% target. The test_server_ctrl process is terminated, and teminate/2 -%% will do the cleanup +%% Handles exit messages from linked processes. Only test suites are +%% expected to be linked. When a test suite terminates, it is removed +%% from the job queue. If a target client terminates it means that we +%% lost contact with target. The test_server_ctrl process is +%% terminated, and teminate/2 will do the cleanup handle_info({'EXIT',Pid,Reason}, State) -> case lists:keysearch(Pid,2,State#state.jobs) of false -> - TI = State#state.target_info, - case TI#target_info.target_client of - Pid -> - %% The target client died - lost contact with target - {stop,{lost_contact_with_target,Reason},State}; - _other -> - %% not our problem - {noreply,State} - end; + %% not our problem + {noreply,State}; {value,{Name,_}} -> NewJobs = lists:keydelete(Pid, 2, State#state.jobs), case Reason of @@ -1303,14 +1077,8 @@ handle_info({tcp_closed,Sock}, State=#state{trc=Sock}) -> %%! Maybe print something??? {noreply,State#state{trc=false}}; handle_info({tcp_closed,Sock}, State) -> - case test_server_node:nodedown(Sock,State#state.target_info) of - target_died -> - %% terminate/2 will do the cleanup - {stop,target_died,State}; - _ -> - {noreply,State} - end; - + test_server_node:nodedown(Sock, State#state.target_info), + {noreply,State}; handle_info(_, State) -> %% dummy; accept all, do nothing. {noreply, State}. @@ -1416,6 +1184,7 @@ init_tester(Mod, Func, Args, Dir, Name, {_,_,MinLev}=Levels, group_leader(test_server_io:get_gl(true), self()), {TimeMy,Result} = ts_tc(Mod, Func, Args), set_io_buffering(undefined), + test_server_io:set_job_name(undefined), catch stop_extra_tools(StartedExtraTools), case Result of {'EXIT',test_suites_done} -> @@ -1465,11 +1234,11 @@ elapsed_time(Before, After) -> start_extra_tools(ExtraTools) -> start_extra_tools(ExtraTools, []). -start_extra_tools([{cover,App,Analyse} | ExtraTools], Started) -> +start_extra_tools([{cover,App,Analyse,Stop} | ExtraTools], Started) -> case cover_compile(App) of {ok,AnalyseMods} -> start_extra_tools(ExtraTools, - [{cover,App,Analyse,AnalyseMods}|Started]); + [{cover,App,Analyse,AnalyseMods,Stop}|Started]); {error,_} -> start_extra_tools(ExtraTools, Started) end; @@ -1488,8 +1257,8 @@ stop_extra_tools(ExtraTools) -> end, stop_extra_tools(ExtraTools, TestDir). -stop_extra_tools([{cover,App,Analyse,AnalyseMods}|ExtraTools], TestDir) -> - cover_analyse(App, Analyse, AnalyseMods, TestDir), +stop_extra_tools([{cover,App,Analyse,AnalyseMods,Stop}|ExtraTools], TestDir) -> + cover_analyse(App, Analyse, AnalyseMods, Stop, TestDir), stop_extra_tools(ExtraTools, TestDir); %%stop_extra_tools([_ | ExtraTools], TestDir) -> %% stop_extra_tools(ExtraTools, TestDir); @@ -2027,7 +1796,7 @@ start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA) -> lists:member(no_src, get(test_server_logopts))} of {true,false} -> print(Lev, "<a href=\"~s#~s\">source code for ~p:~p/1</a>\n", - [SrcListing,Func,Mod,Func]); + [SrcListing,atom_to_list(Func)++"-1",Mod,Func]); _ -> ok end, @@ -2318,9 +2087,7 @@ do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) -> %% Runs the specified tests, then displays/logs the summary. run_test_cases(TestSpec, Config, TimetrapData) -> - - maybe_open_job_sock(), - + test_server:init_purify(), case lists:member(no_src, get(test_server_logopts)) of true -> ok; @@ -2330,8 +2097,6 @@ run_test_cases(TestSpec, Config, TimetrapData) -> run_test_cases_loop(TestSpec, [Config], TimetrapData, [], []), - maybe_get_privdir(), - {AllSkippedN,UserSkipN,AutoSkipN,SkipStr} = case get(test_server_skipped) of {0,0} -> {0,0,0,""}; @@ -2350,41 +2115,6 @@ run_test_cases(TestSpec, Config, TimetrapData) -> print(major, "=auto_skipped ~p", [AutoSkipN]), exit(test_suites_done). -%% If the test is run at a remote target, this function sets up a socket -%% communication with the target for handling this particular job. -maybe_open_job_sock() -> - TI = get_target_info(), - case TI#target_info.where of - local -> - %% local target - test_server:init_purify(); - MainSock -> - %% remote target - {ok,LSock} = gen_tcp:listen(0, [binary, - {reuseaddr,true}, - {packet,4}, - {active,false}]), - {ok,Port} = inet:port(LSock), - request(MainSock, {job,Port,get(test_server_name)}), - case gen_tcp:accept(LSock, ?ACCEPT_TIMEOUT) of - {ok,Sock} -> put(test_server_ctrl_job_sock, Sock); - {error,Reason} -> exit({no_contact,Reason}) - end - end. - -%% If the test is run at a remote target, this function waits for a -%% tar packet containing the privdir created by the test case. -maybe_get_privdir() -> - case get(test_server_ctrl_job_sock) of - undefined -> - %% local target - ok; - Sock -> - %% remote target - request(Sock, job_done), - gen_tcp:close(Sock) - end. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% run_test_cases_loop(TestCases, Config, TimetrapData, Mode, Status) -> ok @@ -2899,7 +2629,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, end, CurrMode = curr_mode(Ref, Mode0, Mode), - ConfCaseResult = run_test_case(Ref, 0, Mod, Func, [ActualCfg], skip_init, target, + ConfCaseResult = run_test_case(Ref, 0, Mod, Func, [ActualCfg], skip_init, TimetrapData, CurrMode), case ConfCaseResult of @@ -2933,6 +2663,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, exit(framework_error); {_,Fail,_} when element(1,Fail) == 'EXIT'; element(1,Fail) == timetrap_timeout; + element(1,Fail) == user_timetrap_error; element(1,Fail) == failed -> {Cases2,Config1,Status3} = if StartConf -> @@ -2952,14 +2683,6 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, set_io_buffering(IOHandler), stop_minor_log_file(), run_test_cases_loop(Cases2, Config1, TimetrapData, Mode, Status3); - {died,Why,_} when Func == init_per_suite -> - print(minor, "~n*** Unexpected exit during init_per_suite.~n", []), - Reason = {failed,{Mod,init_per_suite,Why}}, - Cases2 = skip_cases_upto(Ref, Cases, Reason, conf, CurrMode), - set_io_buffering(IOHandler), - stop_minor_log_file(), - run_test_cases_loop(Cases2, Config, TimetrapData, Mode, - delete_status(Ref, Status2)); {_,{Skip,Reason},_} when StartConf and ((Skip==skip) or (Skip==skipped)) -> ReportAbortRepeat(skipped), print(minor, "~n*** ~p skipped.~n" @@ -3030,7 +2753,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, end; run_test_cases_loop([{make,Ref,{Mod,Func,Args}}|Cases0], Config, TimetrapData, Mode, Status) -> - case run_test_case(Ref, 0, Mod, Func, Args, skip_init, host, TimetrapData) of + case run_test_case(Ref, 0, Mod, Func, Args, skip_init, TimetrapData) of {_,Why={'EXIT',_},_} -> print(minor, "~n*** ~p failed.~n" " Skipping all cases.", [Func]), @@ -3075,7 +2798,7 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) end, case run_test_case(undefined, Num+1, Mod, Func, Args, - run_init, target, TimetrapData, Mode) of + run_init, TimetrapData, Mode) of %% callback to framework module failed, exit immediately {_,{framework_error,{FwMod,FwFunc},Reason},_} -> print(minor, "~n*** ~p failed in ~p. Reason: ~p~n", [FwMod,FwFunc,Reason]), @@ -3711,6 +3434,11 @@ handle_io_and_exit_loop(_, [], Ok,Skip,Fail) -> handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) -> receive + {abort_current_testcase=Tag,_Reason,From} -> + %% If a parallel group is executing, there is no unique + %% current test case, so we must generate an error. + From ! {self(),Tag,{error,parallel_group}}, + handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases); %% end of io session from test case executed by main process {finished,_,Main,CaseNum,Mod,Func,Result,_RetVal} -> test_server_io:print_buffered(CurrPid), @@ -3764,23 +3492,23 @@ handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) -> %% RetVal is the result of executing the test case. It contains info %% about the execution time and the return value of the test case function. -run_test_case(Ref, Num, Mod, Func, Args, RunInit, Where, TimetrapData) -> +run_test_case(Ref, Num, Mod, Func, Args, RunInit, TimetrapData) -> file:set_cwd(filename:dirname(get(test_server_dir))), - run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, + run_test_case1(Ref, Num, Mod, Func, Args, RunInit, TimetrapData, [], self()). -run_test_case(Ref, Num, Mod, Func, Args, skip_init, Where, TimetrapData, Mode) -> +run_test_case(Ref, Num, Mod, Func, Args, skip_init, TimetrapData, Mode) -> %% a conf case is always executed by the main process - run_test_case1(Ref, Num, Mod, Func, Args, skip_init, Where, + run_test_case1(Ref, Num, Mod, Func, Args, skip_init, TimetrapData, Mode, self()); -run_test_case(Ref, Num, Mod, Func, Args, RunInit, Where, TimetrapData, Mode) -> +run_test_case(Ref, Num, Mod, Func, Args, RunInit, TimetrapData, Mode) -> file:set_cwd(filename:dirname(get(test_server_dir))), Main = self(), case check_prop(parallel, Mode) of false -> %% this is a sequential test case - run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, + run_test_case1(Ref, Num, Mod, Func, Args, RunInit, TimetrapData, Mode, Main); _Ref -> %% this a parallel test case, spawn the new process @@ -3792,11 +3520,11 @@ run_test_case(Ref, Num, Mod, Func, Args, RunInit, Where, TimetrapData, Mode) -> [put(Key, Val) || {Key,Val} <- Dictionary], set_io_buffering({tc,Main}), run_test_case1(Ref, Num, Mod, Func, Args, RunInit, - Where, TimetrapData, Mode, Main) + TimetrapData, Mode, Main) end) end. -run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, +run_test_case1(Ref, Num, Mod, Func, Args, RunInit, TimetrapData, Mode, Main) -> group_leader(test_server_io:get_gl(Main == self()), self()), @@ -3809,12 +3537,6 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, Main ! {started,Ref,self(),Num,Mod,Func} end, TSDir = get(test_server_dir), - case Where of - target -> - maybe_send_beam_and_datadir(Mod); - host -> - ok - end, print(major, "=case ~p:~p", [Mod, Func]), MinorName = start_minor_log_file(Mod, Func), @@ -3872,7 +3594,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, %% run the test case {Result,DetectedFail,ProcsBefore,ProcsAfter} = run_test_case_apply(Num, Mod, Func, [UpdatedArgs], get_name(Mode), - RunInit, Where, TimetrapData), + RunInit, TimetrapData), {Time,RetVal,Loc,Opts,Comment} = case Result of Normal={_Time,_RetVal,_Loc,_Opts,_Comment} -> Normal; @@ -3989,7 +3711,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, true -> ok end, - check_new_crash_dumps(Where), + test_server_sup:check_new_crash_dumps(), %% if io is being buffered, send finished message %% (no matter if case runs on parallel or main process) @@ -4017,109 +3739,6 @@ do_unless_parallel(Main, Action) when is_function(Action, 0) -> num2str(0) -> ""; num2str(N) -> integer_to_list(N). -%% If remote target, this function sends the test suite (if not already sent) -%% and the content of datadir til target. -maybe_send_beam_and_datadir(Mod) -> - case get(test_server_ctrl_job_sock) of - undefined -> - %% local target - ok; - JobSock -> - %% remote target - case get(test_server_downloaded_suites) of - undefined -> - send_beam_and_datadir(Mod, JobSock), - put(test_server_downloaded_suites, [Mod]); - Suites -> - case lists:member(Mod, Suites) of - false -> - send_beam_and_datadir(Mod, JobSock), - put(test_server_downloaded_suites, [Mod|Suites]); - true -> - ok - end - end - end. - -send_beam_and_datadir(Mod, JobSock) -> - case code:which(Mod) of - non_existing -> - io:format("** WARNING: Suite ~w could not be found on host\n", - [Mod]); - BeamFile -> - send_beam(JobSock, Mod, BeamFile) - end, - DataDir = get_data_dir(Mod), - case file:read_file_info(DataDir) of - {ok,_I} -> - {ok,All} = file:list_dir(DataDir), - AddTarFiles = - case controller_call(get_target_info) of - #target_info{os_family=ose} -> - ObjExt = code:objfile_extension(), - Wc = filename:join(DataDir, "*" ++ ObjExt), - ModsInDatadir = filelib:wildcard(Wc), - SendBeamFun = fun(X) -> send_beam(JobSock, X) end, - lists:foreach(SendBeamFun, ModsInDatadir), - %% No need to send C code or makefiles since - %% no compilation can be done on target anyway. - %% Compiled C code must exist on target. - %% Beam files are already sent as binaries. - %% Erlang source are sent in case the test case - %% is to compile it. - Filter = fun("Makefile") -> false; - ("Makefile.src") -> false; - (Y) -> - case filename:extension(Y) of - ".c" -> false; - ObjExt -> false; - _ -> true - end - end, - lists:filter(Filter, All); - _ -> - All - end, - Tarfile = "data_dir.tar.gz", - {ok,Tar} = erl_tar:open(Tarfile, [write,compressed]), - ShortDataDir = filename:basename(DataDir), - AddTarFun = - fun(File) -> - Long = filename:join(DataDir, File), - Short = filename:join(ShortDataDir, File), - ok = erl_tar:add(Tar, Long, Short, []) - end, - lists:foreach(AddTarFun, AddTarFiles), - ok = erl_tar:close(Tar), - {ok,TarBin} = file:read_file(Tarfile), - file:delete(Tarfile), - request(JobSock, {{datadir,Tarfile}, TarBin}); - {error,_R} -> - ok - end. - -send_beam(JobSock, BeamFile) -> - Mod=filename:rootname(filename:basename(BeamFile), code:objfile_extension()), - send_beam(JobSock, list_to_atom(Mod), BeamFile). -send_beam(JobSock, Mod, BeamFile) -> - {ok,BeamBin} = file:read_file(BeamFile), - request(JobSock, {{beam,Mod,BeamFile}, BeamBin}). - -check_new_crash_dumps(Where) -> - case Where of - target -> - case get(test_server_ctrl_job_sock) of - undefined -> - ok; - Socket -> - read_job_sock_loop(Socket) - end; - _ -> - ok - end, - test_server_sup:check_new_crash_dumps(). - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% progress(Result, CaseNum, Mod, Func, Location, Reason, Time, %% Comment, TimeFormat) -> Result @@ -4487,11 +4106,10 @@ do_format_exception(Reason={Error,Stack}) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, -%% Where, TimetrapData) -> +%% TimetrapData) -> %% {{Time,RetVal,Loc,Opts,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} | %% {{died,Reason,unknown,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} %% Name = atom() -%% Where = target | host %% Time = float() (seconds) %% RetVal = term() %% Loc = term() @@ -4506,23 +4124,10 @@ do_format_exception(Reason={Error,Stack}) -> %% sent over socket to target, and test_server runs the case and sends the %% result back over the socket. Else test_server runs the case directly on host. -run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, host, +run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, TimetrapData) -> test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit, - TimetrapData}); -run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, target, - TimetrapData) -> - case get(test_server_ctrl_job_sock) of - undefined -> - %% local target - test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit, - TimetrapData}); - JobSock -> - %% remote target - request(JobSock, {test_case,{CaseNum,Mod,Func,Args,Name,RunInit, - TimetrapData}}), - read_job_sock_loop(JobSock) - end. + TimetrapData}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% print(Detail, Format, Args) -> ok @@ -5119,7 +4724,7 @@ get_target_info() -> %% Called by test_server. See test_server:start_node/3 for details start_node(Name, Type, Options) -> - T = 10 * ?ACCEPT_TIMEOUT, % give some extra time + T = 10 * ?ACCEPT_TIMEOUT * test_server:timetrap_scale_factor(), format(minor, "Attempt to start ~w node ~p with options ~p", [Type, Name, Options]), case controller_call({start_node,Name,Type,Options}, T) of @@ -5164,7 +4769,8 @@ start_node(Name, Type, Options) -> %% when the new node has contacted test_server_ctrl again wait_for_node(Slave) -> - case catch controller_call({wait_for_node,Slave},10000) of + T = 10000 * test_server:timetrap_scale_factor(), + case catch controller_call({wait_for_node,Slave},T) of {'EXIT',{timeout,_}} -> {error,timeout}; ok -> ok end. @@ -5188,60 +4794,6 @@ stop_node(Slave) -> controller_call({stop_node,Slave}). -%%-------------------------------------------------------------------- -%% Functions handling target communication over socket - -%% Generic send function for communication with target -request(Sock,Request) -> - gen_tcp:send(Sock,<<1,(term_to_binary(Request))/binary>>). - -%% Receive and decode request on job specific socket -%% Used when test is running on a remote target -read_job_sock_loop(Sock) -> - case gen_tcp:recv(Sock,0) of - {error,Reason} -> - gen_tcp:close(Sock), - exit({controller,connection_lost,Reason}); - {ok,<<1,Request/binary>>} -> - case decode(binary_to_term(Request)) of - ok -> - read_job_sock_loop(Sock); - {stop,Result} -> - Result - end - end. - -decode({apply,{M,F,A}}) -> - apply(M,F,A), - ok; -decode({sync_apply,{M,F,A}}) -> - R = apply(M,F,A), - request(get(test_server_ctrl_job_sock),{sync_result,R}), - ok; -decode({sync_result,Result}) -> - {stop,Result}; -decode({test_case_result,Result}) -> - {stop,Result}; -decode({privdir,empty_priv_dir}) -> - {stop,ok}; -decode({{privdir,PrivDirTar},TarBin}) -> - Root = get(test_server_log_dir_base), - unpack_tar(Root,PrivDirTar,TarBin), - {stop,ok}; -decode({crash_dumps,no_crash_dumps}) -> - {stop,ok}; -decode({{crash_dumps,CrashDumpTar},TarBin}) -> - Dir = test_server_sup:crash_dump_dir(), - unpack_tar(Dir,CrashDumpTar,TarBin), - {stop,ok}. - -unpack_tar(Dir,TarFileName0,TarBin) -> - TarFileName = filename:join(Dir,TarFileName0), - ok = file:write_file(TarFileName,TarBin), - ok = erl_tar:extract(TarFileName,[compressed,{cwd,Dir}]), - ok = file:delete(TarFileName). - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% DEBUGGER INTERFACE %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -5386,16 +4938,7 @@ cover_compile({App,CoverFile}) -> cover_compile1({App,Exclude,Include,Cross}). cover_compile1(What) -> - case get(test_server_ctrl_job_sock) of - undefined -> - %% local target - test_server:cover_compile(What); - JobSock -> - %% remote target - request(JobSock, {sync_apply,{test_server,cover_compile,[What]}}), - read_job_sock_loop(JobSock) - end. - + test_server:cover_compile(What). %% Read the coverfile for an application and return a list of modules %% that are members of the application but shall not be compiled @@ -5447,7 +4990,7 @@ check_cover_file([], Exclude, Include) -> %% %% This per application analysis writes the file cover.html in the %% application's run.<timestamp> directory. -cover_analyse({App,CoverInfo}, Analyse, AnalyseMods, TestDir) -> +cover_analyse({App,CoverInfo}, Analyse, AnalyseMods, Stop, TestDir) -> write_default_cross_coverlog(TestDir), {ok,CoverLog} = file:open(filename:join(TestDir, ?coverlog_name), [write]), @@ -5478,7 +5021,7 @@ cover_analyse({App,CoverInfo}, Analyse, AnalyseMods, TestDir) -> io:fwrite(CoverLog, "<p>Excluded module(s): <code>~p</code>\n", [Excluded]), - Coverage = cover_analyse(Analyse, AnalyseMods), + Coverage = cover_analyse(Analyse, AnalyseMods, Stop), case lists:filter(fun({_M,{_,_,_}}) -> false; (_) -> true @@ -5495,32 +5038,27 @@ cover_analyse({App,CoverInfo}, Analyse, AnalyseMods, TestDir) -> file:write_file(filename:join(TestDir, ?cover_total), term_to_binary(TotPercent)). -cover_analyse(Analyse, AnalyseMods) -> +cover_analyse(Analyse, AnalyseMods, Stop) -> TestDir = get(test_server_log_dir_base), - case get(test_server_ctrl_job_sock) of - undefined -> - %% local target - test_server:cover_analyse({Analyse,TestDir}, AnalyseMods); - JobSock -> - %% remote target - request(JobSock, {sync_apply,{test_server, - cover_analyse, - [Analyse,AnalyseMods]}}), - read_job_sock_loop(JobSock) - end. + test_server:cover_analyse({Analyse,TestDir}, AnalyseMods, Stop). %% Cover analysis, cross application %% This can be executed on any node after all tests are finished. -%% The node's current directory must be the same as when the tests -%% were run. -cross_cover_analyse(Analyse) -> - cross_cover_analyse(Analyse, undefined). - -cross_cover_analyse(Analyse, CrossModules) -> - CoverdataFiles = get_coverdata_files(), +%% Apps = [{App,Dir}] +%% App = atom(), application name +%% Dir = string(), the log directory for App, normally where +%% run.<timestamp> is found. +%% Modules = [atom()], modules that have been cover compiled during tests +%% of other apps than the one they belong to. +cross_cover_analyse(Analyse, Apps) -> + cross_cover_analyse(Analyse, Apps, get_cross_modules()). +cross_cover_analyse(Analyse, Apps, Modules) -> + Apps1 = get_latest_run_dirs(Apps), + Apps2 = add_cross_modules(Modules,Apps1), + CoverdataFiles = get_coverdata_files(Apps2), lists:foreach(fun(CDF) -> cover:import(CDF) end, CoverdataFiles), - io:fwrite("Cover analysing... ", []), + io:fwrite("Cover analysing...\n", []), DetailsFun = case Analyse of details -> @@ -5534,25 +5072,15 @@ cross_cover_analyse(Analyse, CrossModules) -> _ -> fun(_,_) -> undefined end end, - SortedModules = - case CrossModules of - undefined -> - sort_modules([Mod || Mod <- get_all_cross_modules(), - lists:member(Mod, cover:imported_modules())], []); - _ -> - sort_modules(CrossModules, []) - end, - Coverage = analyse_apps(SortedModules, DetailsFun, []), + Coverage = analyse_apps(Apps2, DetailsFun, []), cover:stop(), - write_cross_cover_logs(Coverage). + write_cross_cover_logs(Coverage,Apps2). -%% For each application from which there are modules listed in the -%% cross.cover, write a cross cover log (cross_cover.html). -write_cross_cover_logs([{App,Coverage}|T]) -> - case last_test_for_app(App) of - false -> - ok; - Dir -> +%% For each application from which there are cross cover analysed +%% modules, write a cross cover log (cross_cover.html). +write_cross_cover_logs([{App,Coverage}|T],Apps) -> + case lists:keyfind(App,1,Apps) of + {_,Dir,Mods} when Mods=/=[] -> CoverLogName = filename:join(Dir,?cross_coverlog_name), {ok,CoverLog} = file:open(CoverLogName, [write]), write_coverlog_header(CoverLog), @@ -5560,54 +5088,51 @@ write_cross_cover_logs([{App,Coverage}|T]) -> "<h1>Coverage results for \'~w\' from all tests</h1>\n", [App]), write_cover_result_table(CoverLog, Coverage), - io:fwrite("Written file ~p\n", [CoverLogName]) + io:fwrite("Written file ~p\n", [CoverLogName]); + _ -> + ok end, - write_cross_cover_logs(T); -write_cross_cover_logs([]) -> + write_cross_cover_logs(T,Apps); +write_cross_cover_logs([],_) -> io:fwrite("done\n", []). -%% Find all exported coverdata files. First find all the latest -%% run.<timestamp> directories, and the check if there is a file named -%% all.coverdata. -get_coverdata_files() -> - PossibleFiles = [last_coverdata_file(Dir) || - Dir <- filelib:wildcard([$*|?logdir_ext]), - filelib:is_dir(Dir)], - [File || File <- PossibleFiles, filelib:is_file(File)]. - -last_coverdata_file(Dir) -> - LastDir = last_test(filelib:wildcard(filename:join(Dir,"run.[1-2]*")),false), - filename:join(LastDir,"all.coverdata"). - - -%% Find the latest run.<timestamp> directory for the given application. -last_test_for_app(App) -> - AppLogDir = atom_to_list(App)++?logdir_ext, - last_test(filelib:wildcard(filename:join(AppLogDir,"run.[1-2]*")),false). - -last_test([Run|Rest], false) -> - last_test(Rest, Run); -last_test([Run|Rest], Latest) when Run > Latest -> - last_test(Rest, Run); -last_test([_|Rest], Latest) -> - last_test(Rest, Latest); -last_test([], Latest) -> +%% Get the latest run.<timestamp> directories +get_latest_run_dirs([{App,Dir}|Apps]) -> + [{App,get_latest_run_dir(Dir)} | get_latest_run_dirs(Apps)]; +get_latest_run_dirs([]) -> + []. + +get_latest_run_dir(Dir) -> + case filelib:wildcard(filename:join(Dir,"run.[1-2]*")) of + [] -> + Dir; + [H|T] -> + get_latest_dir(T,H) + end. + +get_latest_dir([H|T],Latest) when H>Latest -> + get_latest_dir(T,H); +get_latest_dir([_|T],Latest) -> + get_latest_dir(T,Latest); +get_latest_dir([],Latest) -> Latest. -%% Sort modules according to the application they belong to. -%% Return [{App,LastTestDir,ModuleList}] -sort_modules([M|Modules], Acc) -> - App = get_app(M), - Acc1 = - case lists:keysearch(App, 1, Acc) of - {value,{App,LastTest,List}} -> - lists:keyreplace(App, 1, Acc, {App,LastTest,[M|List]}); +%% Associate the cross cover modules with their applications. +add_cross_modules(Mods,Apps)-> + do_add_cross_modules(Mods,[{App,Dir,[]} || {App,Dir} <- Apps]). +do_add_cross_modules([Mod|Mods],Apps)-> + App = get_app(Mod), + NewApps = + case lists:keytake(App,1,Apps) of + {value,{App,Dir,AppMods},Rest} -> + [{App,Dir,lists:umerge([Mod],AppMods)}|Rest]; false -> - [{App,last_test_for_app(App),[M]}|Acc] + Apps end, - sort_modules(Modules, Acc1); -sort_modules([], Acc) -> - Acc. + do_add_cross_modules(Mods,NewApps); +do_add_cross_modules([],Apps) -> + %% Just to get the modules in the same order as app-only cover log + [{App,Dir,lists:reverse(Mods)} || {App,Dir,Mods} <- Apps]. get_app(Module) -> Beam = code:which(Module), @@ -5615,6 +5140,14 @@ get_app(Module) -> [AppStr|_] = string:tokens(AppDir,"-"), list_to_atom(AppStr). +%% Find all exported coverdata files. +get_coverdata_files(Apps) -> + lists:flatmap( + fun({_,LatestAppDir,_}) -> + filelib:wildcard(filename:join(LatestAppDir,"all.coverdata")) + end, + Apps). + %% For each application, analyse all modules %% Used for cross cover analysis. @@ -5635,7 +5168,7 @@ analyse_modules(_Dir, [], _DetailsFun, Acc) -> %% Read the cross cover file (cross.cover) -get_all_cross_modules() -> +get_cross_modules() -> get_cross_modules(all). get_cross_modules(App) -> case file:consult(?cross_cover_file) of diff --git a/lib/test_server/src/test_server_h.erl b/lib/test_server/src/test_server_h.erl index fdeee59326..78daba855d 100644 --- a/lib/test_server/src/test_server_h.erl +++ b/lib/test_server/src/test_server_h.erl @@ -131,6 +131,11 @@ report_receiver(warning_msg, _) -> kernel; report_receiver(warning_report, _) -> kernel; report_receiver(info, _) -> kernel; report_receiver(info_msg, _) -> kernel; +report_receiver(info_report,Tuple) + when is_tuple(Tuple) andalso + (element(1,Tuple)==ct_connection orelse + element(1,Tuple)==conn_log) -> + none; report_receiver(info_report, _) -> kernel; report_receiver(_, _) -> none. diff --git a/lib/test_server/src/test_server_internal.hrl b/lib/test_server/src/test_server_internal.hrl index b58b42805e..d204c35293 100644 --- a/lib/test_server/src/test_server_internal.hrl +++ b/lib/test_server/src/test_server_internal.hrl @@ -24,8 +24,7 @@ %% Target information generated by test_server:init_target_info/0 and %% test_server_ctrl:contact_main_target/2 %% Once initiated, this information will never change!! --record(target_info, {where, % local | Socket - os_family, % atom(); win32 | unix +-record(target_info, {os_family, % atom(); win32 | unix os_type, % result of os:type() host, % string(); the name of the target machine version, % string() @@ -43,7 +42,6 @@ % itself is master for slave nodes %% The following are only used for remote targets - target_client, % reference to a client talking to target slave_targets=[]}).% list() of atom(); all available % targets for starting slavenodes diff --git a/lib/test_server/src/test_server_io.erl b/lib/test_server/src/test_server_io.erl index abdfb71241..e960b3087a 100644 --- a/lib/test_server/src/test_server_io.erl +++ b/lib/test_server/src/test_server_io.erl @@ -68,8 +68,8 @@ stop() -> %% Return a group leader (a process using the test_server_gl module). %% If Shared is true, the shared group leader is returned (suitable for %% running sequential test cases), otherwise a new group leader process -%% is spawned. Group leader processes will live until they are garbaged -%% collected by a call to gc/0. +%% is spawned. Group leader processes will live until the +%% 'test_server_io' process is stopped. get_gl(Shared) when is_boolean(Shared) -> req({get_gl,Shared}). @@ -95,7 +95,7 @@ start_transaction() -> %% end_transaction() %% %% End the transaction started by start_transaction/0. Subsequent calls to -%% print/3 will cause the message to be printed directory. +%% print/3 will cause the message to be printed directly. end_transaction() -> req({end_transaction,self()}). @@ -253,6 +253,8 @@ output(From, Tag, Str, #st{io_buffering=Buffered,buffered=Buf0}=St) -> St#st{buffered=Buf} end. +do_output(stdout, Str, #st{job_name=undefined}) -> + io:put_chars(Str); do_output(stdout, Str0, #st{job_name=Name}) -> Str = io_lib:format("Testing ~s: ~s\n", [Name,Str0]), io:put_chars(Str); diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl index 872f15f2be..b307d93c7d 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/test_server/src/test_server_node.erl @@ -26,7 +26,7 @@ %% Test Controller interface -export([is_release_available/1]). --export([start_remote_main_target/1,stop/1]). +-export([stop/1]). -export([start_tracer_node/2,trace_nodes/2,stop_tracer_node/1]). -export([start_node/5, stop_node/2]). -export([kill_nodes/1, nodedown/2]). @@ -57,79 +57,8 @@ is_release_available(Rel) -> false end. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% Start main target node on remote host -%%% The target node must not know the controller node via erlang distribution. -start_remote_main_target(Parameters) -> - #par{type=TargetType, - target=TargetHost, - naming=Naming, - master=MasterNode, - cookie=MasterCookie, - slave_targets=SlaveTargets} = Parameters, - - lists:foreach(fun(T) -> maybe_reboot_target({TargetType,T}) end, - [list_to_atom(TargetHost)|SlaveTargets]), - - Cmd0 = get_main_target_start_command(TargetType,TargetHost,Naming, - MasterNode,MasterCookie), - Cmd = - case os:getenv("TEST_SERVER_FRAMEWORK") of - FW when FW =:= false; FW =:= "undefined" -> Cmd0; - FW -> Cmd0 ++ " -env TEST_SERVER_FRAMEWORK " ++ FW - end, - - {ok,LSock} = gen_tcp:listen(?MAIN_PORT,[binary,{reuseaddr,true},{packet,2}]), - case start_target(TargetType,TargetHost,Cmd) of - {ok,TargetClient,AcceptTimeout} -> - case gen_tcp:accept(LSock,AcceptTimeout) of - {ok,Sock} -> - gen_tcp:close(LSock), - receive - {tcp,Sock,Bin} when is_binary(Bin) -> - case unpack(Bin) of - error -> - gen_tcp:close(Sock), - close_target_client(TargetClient), - {error,bad_message}; - {ok,{target_info,TI}} -> - put(test_server_free_targets,SlaveTargets), - {ok, TI#target_info{where=Sock, - host=TargetHost, - naming=Naming, - master=MasterNode, - target_client=TargetClient, - slave_targets=SlaveTargets}} - end; - {tcp_closed,Sock} -> - gen_tcp:close(Sock), - close_target_client(TargetClient), - {error,could_not_contact_target} - after AcceptTimeout -> - gen_tcp:close(Sock), - close_target_client(TargetClient), - {error,timeout} - end; - Error -> - %%! maybe something like kill_target(...)??? - gen_tcp:close(LSock), - close_target_client(TargetClient), - {error,{could_not_contact_target,Error}} - end; - Error -> - gen_tcp:close(LSock), - {error,{could_not_start_target,Error}} - end. - stop(TI) -> - kill_nodes(TI), - case TI#target_info.where of - local -> % there is no remote target to stop - ok; - Sock -> % stop remote target - gen_tcp:close(Sock), - close_target_client(TI#target_info.target_client) - end. + kill_nodes(TI). nodedown(Sock, TI) -> Match = #slave_info{name='$1',socket=Sock,client='$2',_='_'}, @@ -146,14 +75,8 @@ nodedown(Sock, TI) -> false -> ok end, slave_died; - [] -> - case TI#target_info.where of - Sock -> - %% test_server_ctrl will do the cleanup - target_died; - _ -> - ignore - end + [] -> + ok end. @@ -167,10 +90,7 @@ start_tracer_node(TraceFile,TI) -> Match = #slave_info{name='$1',_='_'}, SlaveNodes = lists:map(fun([N]) -> [" ",N] end, ets:match(slave_tab,Match)), - TargetNode = case TI#target_info.where of - local -> node(); - _ -> "test_server@" ++ TI#target_info.host - end, + TargetNode = node(), Cookie = TI#target_info.cookie, {ok,LSock} = gen_tcp:listen(0,[binary,{reuseaddr,true},{packet,2}]), {ok,TracePort} = inet:port(LSock), @@ -471,129 +391,29 @@ start_node_slave(SlaveName, OptList, From, TI) -> Ret = case start_which_node(OptList) of {error,Reason} -> {{error,Reason},undefined,undefined}; - Host0 -> do_start_node_slave(Host0,SlaveName,Args,Prog,Cleanup,TI) + Host0 -> do_start_node_slave(Host0,SlaveName,Args,Prog,Cleanup) end, gen_server:reply(From,Ret). -do_start_node_slave(Host0, SlaveName, Args, Prog, Cleanup, TI) -> - case TI#target_info.where of - local -> - Host = - case Host0 of - local -> test_server_sup:hoststr(); - _ -> cast_to_list(Host0) - end, - Cmd = Prog ++ " " ++ Args, - %% Can use slave.erl here because I'm both controller and target - %% so I will ping the new node anyway - case slave:start(Host, SlaveName, Args, no_link, Prog) of - {ok,Nodename} -> - case Cleanup of - true -> ets:insert(slave_tab,#slave_info{name=Nodename}); - false -> ok - end, - {{ok,Nodename}, Host, Cmd, [], []}; - Ret -> - {Ret, Host, Cmd} - end; - - _Sock -> - %% Cannot use slave.erl here because I'm only controller, and will - %% not ping the new node. Only target shall contact the new node!! - no_contact_start_slave(Host0,SlaveName,Args,Prog,Cleanup,TI) - end. - - - -no_contact_start_slave(Host, Name, Args0, Prog, Cleanup,TI) -> - Args1 = case string:str(Args0,"-setcookie") of - 0 -> "-setcookie " ++ TI#target_info.cookie ++ " " ++ Args0; - _ -> Args0 +do_start_node_slave(Host0, SlaveName, Args, Prog, Cleanup) -> + Host = + case Host0 of + local -> test_server_sup:hoststr(); + _ -> cast_to_list(Host0) + end, + Cmd = Prog ++ " " ++ Args, + %% Can use slave.erl here because I'm both controller and target + %% so I will ping the new node anyway + case slave:start(Host, SlaveName, Args, no_link, Prog) of + {ok,Nodename} -> + case Cleanup of + true -> ets:insert(slave_tab,#slave_info{name=Nodename}); + false -> ok end, - Args = TI#target_info.naming ++ " " ++ cast_to_list(Name) ++ " " ++ Args1, - case Host of - local -> - case get(test_server_free_targets) of - [] -> - io:format("Starting slave ~p on HOST~n", [Name]), - TargetType = test_server_sup:get_os_family(), - Cmd0 = get_slave_node_start_command(TargetType, - Prog, - TI#target_info.master), - Cmd = Cmd0 ++ " " ++ Args, - do_no_contact_start_slave(TargetType, - test_server_sup:hoststr(), - Cmd, Cleanup,TI, false); - [H|T] -> - TargetType = TI#target_info.os_family, - Cmd0 = get_slave_node_start_command(TargetType, - Prog, - TI#target_info.master), - Cmd = Cmd0 ++ " " ++ Args, - case do_no_contact_start_slave(TargetType,H,Cmd,Cleanup, - TI,true) of - {error,remove} -> - io:format("Cannot start node on ~p, " - "removing from slave " - "target list.", [H]), - put(test_server_free_targets,T), - no_contact_start_slave(Host,Name,Args,Prog, - Cleanup,TI); - {error,keep} -> - %% H is added to the END OF THE LIST - %% in order to avoid the same target to - %% be selected each time - put(test_server_free_targets,T++[H]), - no_contact_start_slave(Host,Name,Args,Prog, - Cleanup,TI); - R -> - put(test_server_free_targets,T), - R - end - end; - _ -> - TargetType = TI#target_info.os_family, - Cmd0 = get_slave_node_start_command(TargetType, - Prog, - TI#target_info.master), - Cmd = Cmd0 ++ " " ++ Args, - do_no_contact_start_slave(TargetType, Host, Cmd, Cleanup, TI, false) - end. - -do_no_contact_start_slave(TargetType,Host0,Cmd0,Cleanup,TI,Retry) -> - %% Must use TargetType instead of TI#target_info.os_familiy here - %% because if there were no free_targets we will be starting the - %% slave node on host which might have a different os_familiy - Host = cast_to_list(Host0), - {ok,LSock} = gen_tcp:listen(0,[binary, - {reuseaddr,true}, - {packet,2}]), - {ok,WaitPort} = inet:port(LSock), - Cmd = lists:concat([Cmd0, " -s ", ?MODULE, " node_started ", - test_server_sup:hoststr(), " ", WaitPort]), - - case start_target(TargetType,Host,Cmd) of - {ok,Client,AcceptTimeout} -> - case wait_for_node_started(LSock,AcceptTimeout, - Client,Cleanup,TI,self()) of - {error,_}=WaitError -> - if Retry -> - case maybe_reboot_target(Client) of - {error,_} -> {error,remove}; - ok -> {error,keep} - end; - true -> - {WaitError,Host,Cmd} - end; - {Ok,Warning} -> - {Ok,Host,Cmd,[],Warning} - end; - StartError -> - gen_tcp:close(LSock), - if Retry -> {error,remove}; - true -> {{error,{could_not_start_target,StartError}},Host,Cmd} - end + {{ok,Nodename}, Host, Cmd, [], []}; + Ret -> + {Ret, Host, Cmd} end. @@ -777,40 +597,10 @@ kill_node(SI,TI) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Platform specific code -start_target(unix,TargetHost,Cmd0) -> - Cmd = - case test_server_sup:hoststr() of - TargetHost -> Cmd0; - _ -> lists:concat(["rsh ",TargetHost, " ", Cmd0]) - end, - open_port({spawn, Cmd}, [stream]), - {ok,undefined,?ACCEPT_TIMEOUT}. - -maybe_reboot_target(_) -> - {error, cannot_reboot_target}. - close_target_client(undefined) -> ok. - -%% -%% Command for starting main target -%% -get_main_target_start_command(unix,_TargetHost,Naming, - _MasterNode,_MasterCookie) -> - Prog = pick_erl_program(default), - Prog ++ " " ++ Naming ++ " test_server" ++ - " -boot start_sasl -sasl errlog_type error" - " -s test_server start " ++ test_server_sup:hoststr(). - -%% -%% Command for starting slave nodes -%% -get_slave_node_start_command(unix, Prog, MasterNode) -> - cast_to_list(Prog) ++ " -detached -master " ++ MasterNode. - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% cast_to_list(X) -> string() %%% X = list() | atom() | void() diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 4a27c1ebae..c7553cccb5 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -64,13 +64,7 @@ timetrap(Timeout0, ReportTVal, Scale, Pid) -> true -> ReportTVal end, MFLs = test_server:get_loc(Pid), Mon = erlang:monitor(process, Pid), - Trap = - case get(test_server_init_or_end_conf) of - undefined -> - {timetrap_timeout,TimeToReport,MFLs}; - InitOrEnd -> - {timetrap_timeout,TimeToReport,MFLs,InitOrEnd} - end, + Trap = {timetrap_timeout,TimeToReport,MFLs}, exit(Pid, Trap), receive {'DOWN', Mon, process, Pid, _} -> @@ -518,8 +512,18 @@ framework_call(Callback,Func,Args,DefaultReturn) -> end, case erlang:function_exported(Mod,Func,length(Args)) of true -> - put(test_server_loc, {Mod,Func,framework}), EH = fun(Reason) -> exit({fw_error,{Mod,Func,Reason}}) end, + SetTcState = case Func of + end_tc -> true; + init_tc -> true; + _ -> false + end, + case SetTcState of + true -> + test_server:set_tc_state({framework,Mod,Func}); + false -> + ok + end, try apply(Mod,Func,Args) of Result -> Result @@ -550,18 +554,6 @@ format_loc([{Mod,LineOrFunc}]) -> format_loc({Mod,LineOrFunc}); format_loc({Mod,Func}) when is_atom(Func) -> io_lib:format("{~s,~w}",[package_str(Mod),Func]); -format_loc({Mod,Line}) when is_integer(Line) -> - %% ?line macro is used - ModStr = package_str(Mod), - case {lists:member(no_src, get(test_server_logopts)), - lists:reverse(ModStr)} of - {false,[$E,$T,$I,$U,$S,$_|_]} -> - io_lib:format("{~s,<a href=\"~s~s#~w\">~w</a>}", - [ModStr,downcase(ModStr),?src_listing_ext, - round_to_10(Line),Line]); - _ -> - io_lib:format("{~s,~w}",[ModStr,Line]) - end; format_loc(Loc) -> io_lib:format("~p",[Loc]). @@ -576,16 +568,11 @@ format_loc1({Mod,Func,Line}) -> {false,[$E,$T,$I,$U,$S,$_|_]} -> io_lib:format("{~s,~w,<a href=\"~s~s#~w\">~w</a>}", [ModStr,Func,downcase(ModStr),?src_listing_ext, - round_to_10(Line),Line]); + Line,Line]); _ -> io_lib:format("{~s,~w,~w}",[ModStr,Func,Line]) end. -round_to_10(N) when (N rem 10) == 0 -> - N; -round_to_10(N) -> - trunc(N/10)*10. - downcase(S) -> downcase(S, []). downcase([Uc|Rest], Result) when $A =< Uc, Uc =< $Z -> downcase(Rest, [Uc-$A+$a|Result]); diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index db16b6ecd2..115e783070 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/test_server/src/ts.erl @@ -259,14 +259,43 @@ run(List, Opts) when is_list(List), is_list(Opts) -> run(Testspec, Config) when is_atom(Testspec), is_list(Config) -> Options=check_test_get_opts(Testspec, Config), File=atom_to_list(Testspec), - Spec = case code:lib_dir(Testspec) of - {error, bad_name} when Testspec /= emulator, - Testspec /= system, - Testspec /= epmd -> - create_skip_spec(Testspec, tests(Testspec)); - _ -> - File++".spec" - end, + WhatToDo = + case Testspec of + %% Known to exist but fails generic tests below + emulator -> test; + system -> test; + erl_interface -> test; + epmd -> test; + _ -> + case code:lib_dir(Testspec) of + {error,bad_name} -> + %% Application does not exist + skip; + Path -> + case file:read_file_info(filename:join(Path,"ebin")) of + {ok,#file_info{type=directory}} -> + %% Erlang application is built + test; + _ -> + case filelib:wildcard( + filename:join([Path,"priv","*.jar"])) of + [] -> + %% The application is not built + skip; + [_|_] -> + %% Java application is built + test + end + end + end + end, + Spec = + case WhatToDo of + skip -> + create_skip_spec(Testspec, tests(Testspec)); + test -> + File++".spec" + end, run_test(File, [{spec,[Spec]}], Options); %% Runs one module in a spec (interactive) run(Testspec, Mod) when is_atom(Testspec), is_atom(Mod) -> @@ -498,8 +527,60 @@ estone(Opts) when is_list(Opts) -> run(emulator,estone_SUITE,Opts). cross_cover_analyse([Level]) -> cross_cover_analyse(Level); cross_cover_analyse(Level) -> - test_server_ctrl:cross_cover_analyse(Level). - + Apps = get_last_app_tests(), + Modules = get_cross_modules(Apps,[]), + test_server_ctrl:cross_cover_analyse(Level,Apps,Modules). + +get_last_app_tests() -> + AllTests = filelib:wildcard(filename:join(["*","*_test.logs"])), + {ok,RE} = re:compile("^[^/]*/[^\.]*\.(.*)_test\.logs$"), + get_last_app_tests(AllTests,RE,[]). + +get_last_app_tests([Dir|Dirs],RE,Acc) -> + NewAcc = + case re:run(Dir,RE,[{capture,all,list}]) of + {match,[Dir,AppStr]} -> + App = list_to_atom(AppStr), + case lists:keytake(App,1,Acc) of + {value,{App,LastDir},Rest} -> + if Dir > LastDir -> + [{App,Dir}|Rest]; + true -> + Acc + end; + false -> + [{App,Dir} | Acc] + end; + _ -> + Acc + end, + get_last_app_tests(Dirs,RE,NewAcc); +get_last_app_tests([],_,Acc) -> + Acc. + +get_cross_modules([{App,_}|Apps],Acc) -> + Mods = cross_modules(App), + get_cross_modules(Apps,lists:umerge(Mods,Acc)); +get_cross_modules([],Acc) -> + Acc. + +cross_modules(App) -> + case default_coverfile(App) of + none -> + []; + File -> + case catch file:consult(File) of + {ok,CoverSpec} -> + case lists:keyfind(cross_apps,1,CoverSpec) of + false -> + []; + {cross_apps,App,Modules} -> + lists:usort(Modules) + end; + _ -> + [] + end + end. %%% Implementation. diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl index 57d1b8806e..741dd483f5 100644 --- a/lib/test_server/src/ts_run.erl +++ b/lib/test_server/src/ts_run.erl @@ -368,7 +368,7 @@ make_common_test_args(Args0, Options0, _Vars) -> io:format("No cover file found for ~p~n",[App]), []; {value,{cover,_App,File,_Analyse}} -> - [{cover,to_list(File)}]; + [{cover,to_list(File)},{cover_stop,false}]; false -> [] end, |