diff options
Diffstat (limited to 'lib/test_server/src')
-rw-r--r-- | lib/test_server/src/Makefile | 2 | ||||
-rw-r--r-- | lib/test_server/src/test_server.erl | 559 | ||||
-rw-r--r-- | lib/test_server/src/test_server_ctrl.erl | 1281 | ||||
-rw-r--r-- | lib/test_server/src/test_server_internal.hrl | 12 | ||||
-rw-r--r-- | lib/test_server/src/test_server_node.erl | 16 | ||||
-rw-r--r-- | lib/test_server/src/test_server_sup.erl | 14 | ||||
-rw-r--r-- | lib/test_server/src/ts.erl | 14 | ||||
-rw-r--r-- | lib/test_server/src/ts_erl_config.erl | 52 | ||||
-rw-r--r-- | lib/test_server/src/ts_install.erl | 29 | ||||
-rw-r--r-- | lib/test_server/src/ts_lib.erl | 22 | ||||
-rw-r--r-- | lib/test_server/src/ts_reports.erl | 4 | ||||
-rw-r--r-- | lib/test_server/src/ts_run.erl | 140 |
12 files changed, 1263 insertions, 882 deletions
diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile index d55a3a597d..3dca55178d 100644 --- a/lib/test_server/src/Makefile +++ b/lib/test_server/src/Makefile @@ -139,7 +139,7 @@ release_tests_spec: opt $(TARGET_FILES) $(TS_TARGET_FILES) \ $(AUTOCONF_FILES) $(C_FILES) $(COVER_FILES) $(CONFIG) \ $(RELEASE_PATH)/test_server - $(INSTALL_PROGRAM) $(PROGRAMS) $(RELEASE_PATH)/test_server + $(INSTALL_SCRIPT) $(PROGRAMS) $(RELEASE_PATH)/test_server release_docs_spec: diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index f918f47415..ee121e5bb6 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -35,7 +35,7 @@ -export([fail/0,fail/1,format/1,format/2,format/3]). -export([capture_start/0,capture_stop/0,capture_get/0]). -export([messages_get/0]). --export([hours/1,minutes/1,seconds/1,sleep/1,timecall/3]). +-export([hours/1,minutes/1,seconds/1,sleep/1,adjusted_sleep/1,timecall/3]). -export([timetrap_scale_factor/0,timetrap/1,timetrap_cancel/1]). -export([m_out_of_n/3,do_times/4,do_times/2]). -export([call_crash/3,call_crash/4,call_crash/5]). @@ -89,14 +89,14 @@ 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}, + case gen_tcp:connect(Host,Port, [binary, + {reuseaddr,true}, {packet,2}]) of - {ok,MainSock} -> + {ok,MainSock} -> Starter ! {self(),started}, request(MainSock,{target_info,init_target_info()}), loop(#state{controller={Host,MainSock}}); - Error -> + Error -> Starter ! {self(),{error, {could_not_contact_controller,Error}}} end. @@ -127,7 +127,7 @@ loop(#state{controller={_,MainSock}} = State) -> halt(); {'EXIT',Pid,Reason} -> case lists:keysearch(Pid,1,State#state.jobs) of - {value,{Pid,Name}} -> + {value,{Pid,Name}} -> case Reason of normal -> ignore; _other -> request(MainSock,{job_proc_killed,Name,Reason}) @@ -157,14 +157,14 @@ init_purify() -> job(Host,Port,Starter) -> process_flag(trap_exit,true), init_purify(), - case gen_tcp:connect(Host,Port, [binary, - {reuseaddr,true}, + case gen_tcp:connect(Host,Port, [binary, + {reuseaddr,true}, {packet,4}, {active,false}]) of {ok,JobSock} -> Starter ! {self(),started}, job(JobSock); - Error -> + Error -> Starter ! {self(),{error, {could_not_contact_controller,Error}}} end. @@ -192,7 +192,7 @@ get_jobdir() -> true -> {ok,Cwd} = file:get_cwd(), Cwd ++ "/" ++ Basename; - false -> + false -> filename:absname(Basename) end. @@ -216,7 +216,7 @@ send_privdir(JobDir,JobSock) -> del_dir(Dir) -> case file:read_file_info(Dir) of - {ok,#file_info{type=directory}} -> + {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); @@ -227,7 +227,7 @@ del_dir(Dir) -> catch file:delete(Dir), ok end. - + %% %% Receive and decode request on job socket %% @@ -237,7 +237,7 @@ job_loop(JobSock) -> 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 @@ -254,7 +254,7 @@ decode_job({{datadir,Tarfile0},Archive}) -> ok = erl_tar:extract(Tarfile,[compressed,{cwd,JobDir}]), ok = file:delete(Tarfile), ok; -decode_job({test_case,Case}) -> +decode_job({test_case,Case}) -> Result = run_test_case_apply(Case), JobSock = get(test_server_job_sock), request(JobSock,{test_case_result,Result}), @@ -266,11 +266,11 @@ decode_job({test_case,Case}) -> request(JobSock,{{crash_dumps,filename:basename(TarFile)},TarBin}) end, ok; -decode_job({sync_apply,{M,F,A}}) -> +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) -> +decode_job(job_done) -> {stop,stopped}. %% @@ -282,9 +282,9 @@ decode_job(job_done) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% cover_compile({App,Include,Exclude,Cross}) -> +%% cover_compile({App,Include,Exclude,Cross}) -> %% {ok,AnalyseModules} | {error,Reason} -%% +%% %% App = atom() , name of application to be compiled %% Exclude = [atom()], list of modules to exclude %% Include = [atom()], list of modules outside of App that should be included @@ -293,7 +293,7 @@ decode_job(job_done) -> %% in the cover compilation, but that shall not be part of %% the cover analysis for this application. %% -%% Cover compile the given application. Return {ok,AnalyseMods} if application +%% Cover compile the given application. Return {ok,AnalyseMods} if application %% is found, else {error,application_not_found}. cover_compile({none,_Exclude,Include,Cross}) -> @@ -330,7 +330,7 @@ cover_compile({App,all,Include,Cross}) -> end; cover_compile({App,Exclude,Include,Cross}) -> case code:lib_dir(App) of - {error,bad_name} -> + {error,bad_name} -> case Include++Cross of [] -> io:format("\nWARNING: Can't find lib_dir for \'~w\'\n" @@ -366,7 +366,7 @@ cover_compile({App,Exclude,Include,Cross}) -> {ok,AnalyseMods} end end. - + module_names(Beams) -> [list_to_atom(filename:basename(filename:rootname(Beam))) || Beam <- Beams]. @@ -380,11 +380,11 @@ do_cover_compile1([Dont|Rest]) when Dont=:=cover; Dont=:=test_server_ctrl -> do_cover_compile1(Rest); do_cover_compile1([M|Rest]) -> - case {code:is_sticky(M),code:is_loaded(M)} of + case {code:is_sticky(M),code:is_loaded(M)} of {true,_} -> code:unstick_mod(M), case cover:compile_beam(M) of - {ok,_} -> + {ok,_} -> ok; Error -> io:fwrite("\nWARNING: Could not cover compile ~w: ~p\n", @@ -402,7 +402,7 @@ do_cover_compile1([M|Rest]) -> end; {false,_} -> case cover:compile_beam(M) of - {ok,_} -> + {ok,_} -> ok; Error -> io:fwrite("\nWARNING: Could not cover compile ~w: ~p\n", @@ -415,14 +415,14 @@ do_cover_compile1([]) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% cover_analyse(Analyse,Modules) -> [{M,{Cov,NotCov,Details}}] -%% +%% %% Analyse = {details,Dir} | details | {overview,void()} | overview %% Modules = [atom()], the modules to analyse %% %% Cover analysis. If this is a remote target, analyse_to_file can not be used. %% In that case the analyse level 'line' is used instead if Analyse==details. %% -%% If this is a local target, the test directory is given +%% If this is a local target, the test directory is given %% (Analyse=={details,Dir}) and analyse_to_file can be used directly. %% %% If Analyse==overview | {overview,Dir} analyse_to_file is not used, only @@ -432,12 +432,12 @@ do_cover_compile1([]) -> %% all.coverdata in that directory. cover_analyse(Analyse,Modules) -> io:fwrite("Cover analysing...\n",[]), - DetailsFun = + DetailsFun = case Analyse of {details,Dir} -> case cover:export(filename:join(Dir,"all.coverdata")) of ok -> - fun(M) -> + fun(M) -> OutFile = filename:join(Dir, atom_to_list(M) ++ ".COVER.html"), @@ -451,7 +451,7 @@ cover_analyse(Analyse,Modules) -> Error -> fun(_) -> Error end end; - details -> + details -> fun(M) -> case cover:analyse(M,line) of {ok,Lines} -> @@ -489,7 +489,7 @@ cover_analyse(Analyse,Modules) -> unstick_all_sticky(Node) -> lists:filter( - fun(M) -> + fun(M) -> case code:is_sticky(M) of true -> rpc:call(Node,code,unstick_mod,[M]), @@ -502,24 +502,24 @@ unstick_all_sticky(Node) -> stick_all_sticky(Node,Sticky) -> lists:foreach( - fun(M) -> + fun(M) -> rpc:call(Node,code,stick_mod,[M]) end, Sticky). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% run_test_case_apply(Mod,Func,Args,Name,RunInit,MultiplyTimetrap) -> +%% run_test_case_apply(Mod,Func,Args,Name,RunInit,TimetrapData) -> %% {Time,Value,Loc,Opts,Comment} | {died,Reason,unknown,Comment} -%% +%% %% Time = float() (seconds) %% Value = term() %% Loc = term() %% Comment = string() %% Reason = term() %% -%% Spawns off a process (case process) that actually runs the test suite. -%% The case process will have the job process as group leader, which makes +%% Spawns off a process (case process) that actually runs the test suite. +%% The case process will have the job process as group leader, which makes %% it possible to capture all it's output from io:format/2, etc. %% %% The job process then sits down and waits for news from the case process. @@ -535,40 +535,43 @@ stick_all_sticky(Node,Sticky) -> %% called or the comment given by the return value {comment,Comment} from %% a test case. %% -%% {died,Reason,unknown,Comment} is returned if the test case was killed +%% {died,Reason,unknown,Comment} is returned if the test case was killed %% by some other process. Reason is the kill reason provided. %% -%% MultiplyTimetrap indicates a possible extension of all timetraps -%% Timetraps will be multiplied by this integer. If it is infinity, no -%% timetraps will be started at all. +%% TimetrapData = {MultiplyTimetrap,ScaleTimetrap}, which indicates a +%% possible extension of all timetraps. Timetraps will be multiplied by +%% MultiplyTimetrap. If it is infinity, no timetraps will be started at all. +%% ScaleTimetrap indicates if test_server should attemp to automatically +%% compensate timetraps for runtime delays introduced by e.g. tools like +%% cover. -run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,MultiplyTimetrap}) -> +run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,TimetrapData}) -> purify_format("Test case #~w ~w:~w/1", [CaseNum, Mod, Func]), case os:getenv("TS_RUN_VALGRIND") of - false -> + false -> ok; _ -> os:putenv("VALGRIND_LOGFILE_INFIX",atom_to_list(Mod)++"."++ atom_to_list(Func)++"-") end, test_server_h:testcase({Mod,Func,1}), - ProcBef = erlang:system_info(process_count), - Result = run_test_case_apply(Mod, Func, Args, Name, RunInit, MultiplyTimetrap), + ProcBef = erlang:system_info(process_count), + Result = run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData), ProcAft = erlang:system_info(process_count), purify_new_leaks(), DetFail = get(test_server_detected_fail), {Result,DetFail,ProcBef,ProcAft}. - -run_test_case_apply(Mod, Func, Args, Name, RunInit, MultiplyTimetrap) -> + +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, MultiplyTimetrap); + 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}} = + {value,{data_dir,HostDataDir}} = lists:keysearch(data_dir, 1, Config), DataBase = filename:basename(HostDataDir), TargetDataDir = filename:join(JobDir, DataBase), @@ -578,18 +581,18 @@ run_test_case_apply(Mod, Func, Args, Name, RunInit, MultiplyTimetrap) -> Config2 = lists:keyreplace(priv_dir, 1, Config1, {priv_dir,TargetPrivDir}), do_run_test_case_apply(Mod, Func, [Config2], Name, RunInit, - MultiplyTimetrap); + TimetrapData); _other -> do_run_test_case_apply(Mod, Func, Args, Name, RunInit, - MultiplyTimetrap) + TimetrapData) end end. -do_run_test_case_apply(Mod, Func, Args, Name, RunInit, MultiplyTimetrap) -> +do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> {ok,Cwd} = file:get_cwd(), Args2Print = case Args of - [Args1] when is_list(Args1) -> + [Args1] when is_list(Args1) -> lists:keydelete(tc_group_result, 1, Args1); - _ -> + _ -> Args end, print(minor, "Test case started with:\n~s:~s(~p)\n", [Mod,Func,Args2Print]), @@ -600,16 +603,16 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, MultiplyTimetrap) -> OldGLeader = group_leader(), %% Set ourself to group leader for the spawned process group_leader(self(),self()), - Pid = + Pid = spawn_link( - fun() -> - run_test_case_eval(Mod, Func, Args, Name, Ref, - RunInit, MultiplyTimetrap, + fun() -> + run_test_case_eval(Mod, Func, Args, Name, Ref, + RunInit, TimetrapData, TCCallback) end), group_leader(OldGLeader, self()), put(test_server_detected_fail, []), - run_test_case_msgloop(Ref, Pid, false, false, ""). + run_test_case_msgloop(Ref, Pid, false, false, "", undefined). %% Ugly bug (pre R5A): %% If this process (group leader of the test case) terminates before @@ -620,7 +623,7 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, MultiplyTimetrap) -> %% A test case is known to have failed if it returns {'EXIT', _} tuple, %% or sends a message {failed, File, Line} to it's group_leader %% -run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment) -> +run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> %% NOTE: Keep job_proxy_msgloop/0 up to date when changes %% are made in this function! {Timeout,ReturnValue} = @@ -641,13 +644,13 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment) -> receive {'DOWN', Mon, process, Pid, _} -> Comment - after 10000 -> + 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) || + Error1 = lists:flatten([string:strip(S,left) || S <- string:tokens(Error,[$\n])]), if length(Error1) > 63 -> string:substr(Error1,1,60) ++ "..."; @@ -655,149 +658,224 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment) -> Error1 end end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,NewComment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,NewComment,CurrConf); {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}} when is_list(Format) -> Msg = (catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}} when is_atom(Format) -> Msg = (catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); {io_request,From,ReplyAs,{put_chars,Bytes}} -> run_test_case_msgloop_io( ReplyAs,CaptureStdout,Bytes,From,put_chars), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); {io_request,From,ReplyAs,{put_chars,unicode,io_lib,Func,[Format,Args]}} when is_list(Format) -> Msg = unicode_to_latin1(catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); {io_request,From,ReplyAs,{put_chars,latin1,io_lib,Func,[Format,Args]}} when is_list(Format) -> Msg = (catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); {io_request,From,ReplyAs,{put_chars,unicode,io_lib,Func,[Format,Args]}} when is_atom(Format) -> Msg = unicode_to_latin1(catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); {io_request,From,ReplyAs,{put_chars,latin1,io_lib,Func,[Format,Args]}} when is_atom(Format) -> Msg = (catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); {io_request,From,ReplyAs,{put_chars,unicode,Bytes}} -> run_test_case_msgloop_io( ReplyAs,CaptureStdout,unicode_to_latin1(Bytes),From,put_chars), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); {io_request,From,ReplyAs,{put_chars,latin1,Bytes}} -> run_test_case_msgloop_io( ReplyAs,CaptureStdout,Bytes,From,put_chars), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); IoReq when element(1, IoReq) == io_request -> %% something else, just pass it on group_leader() ! IoReq, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); {structured_io,ClientPid,Msg} -> output(Msg, ClientPid), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); {capture,NewCapture} -> - run_test_case_msgloop(Ref,Pid,NewCapture,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,NewCapture,Terminate,Comment,CurrConf); {sync_apply,From,MFA} -> sync_local_or_remote_apply(false,From,MFA), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); {sync_apply_proxy,Proxy,From,MFA} -> sync_local_or_remote_apply(Proxy,From,MFA), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); {printout,Detail,Format,Args} -> print(Detail,Format,Args), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); {comment,NewComment} -> Terminate1 = case Terminate of - {true,{Time,Value,Loc,Opts,_OldComment}} -> + {true,{Time,Value,Loc,Opts,_OldComment}} -> {true,{Time,Value,mod_loc(Loc),Opts,NewComment}}; Other -> Other end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate1,NewComment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate1,NewComment,CurrConf); + {set_curr_conf,NewCurrConf} -> + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,NewCurrConf); {'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} -> RetVal = {Time/1000000,Value,mod_loc(Loc),Opts,Comment}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment,undefined); {'EXIT',Pid,Reason} -> case Reason of {timetrap_timeout,TVal,Loc} -> %% convert Loc to form that can be formatted - Loc1 = mod_loc(Loc), - {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,Pid,{timetrap_timeout,TVal}, - Loc1,self(),Comment), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + case mod_loc(Loc) of + {FwMod,FwFunc,framework} -> + %% timout during framework call + spawn_fw_call(FwMod,FwFunc,Pid, + {framework_error,{timetrap,TVal}}, + unknown,self(),Comment), + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,undefined); + Loc1 -> + {Mod,Func} = get_mf(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}; + _ -> + %% 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,Pid,{timetrap_timeout,TVal}, + Loc1,self(),Comment), + undefined + end, + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,NewCurrConf) + end; {timetrap_timeout,TVal,Loc,InitOrEnd} -> - Loc1 = mod_loc(Loc), - {Mod,_Func} = get_mf(Loc1), - spawn_fw_call(Mod,InitOrEnd,Pid,{timetrap_timeout,TVal}, - Loc1,self(),Comment), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); - {testcase_aborted,Reason,Loc} -> - Loc1 = mod_loc(Loc), - {Mod,Func} = get_mf(Loc1), - spawn_fw_call(Mod,Func,Pid,{testcase_aborted,Reason}, - Loc1,self(),Comment), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); - killed -> + case mod_loc(Loc) of + {FwMod,FwFunc,framework} -> + %% timout during framework call + spawn_fw_call(FwMod,FwFunc,Pid, + {framework_error,{timetrap,TVal}}, + unknown,self(),Comment); + Loc1 -> + {Mod,_Func} = get_mf(Loc1), + spawn_fw_call(Mod,InitOrEnd,Pid,{timetrap_timeout,TVal}, + Loc1,self(),Comment) + end, + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + {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,Pid, + {framework_error,ErrorMsg}, + unknown,self(),Comment), + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,undefined); + Loc1 -> + {Mod,Func} = get_mf(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}; + _ -> + spawn_fw_call(Mod,Func,Pid,ErrorMsg, + Loc1,self(),Comment), + undefined + end, + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,NewCurrConf) + end; + killed -> %% result of an exit(TestCase,kill) call, which is the - %% only way to abort a testcase process that traps exits + %% only way to abort a testcase process that traps exits %% (see abort_current_testcase) spawn_fw_call(undefined,undefined,Pid,testcase_aborted_or_killed, unknown,self(),Comment), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); {fw_error,{FwMod,FwFunc,FwError}} -> spawn_fw_call(FwMod,FwFunc,Pid,{framework_error,FwError}, unknown,self(),Comment), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); - _ -> + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + _Other -> %% the testcase has terminated because of Reason (e.g. an exit %% because a linked process failed) spawn_fw_call(undefined,undefined,Pid,Reason, unknown,self(),Comment), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment) + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf) + end; + {EndConfPid,{call_end_conf,Data,_Result}} -> + case CurrConf of + {EndConfPid,{Mod,Func},_Conf} -> + {_Mod,_Func,TCPid,TCExitReason,Loc} = Data, + spawn_fw_call(Mod,Func,TCPid,TCExitReason,Loc,self(),Comment), + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,undefined); + _ -> + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf) end; {_FwCallPid,fw_notify_done,RetVal} -> %% the framework has been notified, we're finished - run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment,undefined); {'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} -> %% a framework function failed CB = os:getenv("TEST_SERVER_FRAMEWORK"), Loc = case CB of - false -> + false -> {test_server,Func}; - _ -> + _ -> {list_to_atom(CB),Func} end, RetVal = {died,{framework_error,Loc,Error},Loc,"Framework error"}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment,undefined); {failed,File,Line} -> - put(test_server_detected_fail, + put(test_server_detected_fail, [{File, Line}| get(test_server_detected_fail)]), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); _Other when not is_tuple(_Other) -> %% ignore anything not generated by test server - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); _Other when element(1, _Other) /= 'EXIT', element(1, _Other) /= started, element(1, _Other) /= finished, element(1, _Other) /= print -> %% ignore anything not generated by test server - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment) + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf) after Timeout -> ReturnValue end. @@ -819,12 +897,43 @@ run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func) -> output(Msg,Sender) -> local_or_remote_apply({test_server_ctrl,output,[Msg,Sender]}). +call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) -> + Starter = self(), + Data = {Mod,Func,TCPid,TCExitReason,Loc}, + EndConfProc = + fun() -> + Supervisor = self(), + EndConfApply = + fun() -> + case catch apply(Mod,end_per_testcase,[Func,Conf]) of + {'EXIT',Why} -> + group_leader() ! {printout,12, + "ERROR! ~p:end_per_testcase(~p, ~p)" + " crashed!\n\tReason: ~p\n", + [Mod,Func,Conf,Why]}; + _ -> + ok + end, + Supervisor ! {self(),end_conf} + end, + Pid = spawn_link(EndConfApply), + receive + {Pid,end_conf} -> + Starter ! {self(),{call_end_conf,Data,ok}}; + {'EXIT',Pid,Reason} -> + Starter ! {self(),{call_end_conf,Data,{error,Reason}}} + after TVal -> + Starter ! {self(),{call_end_conf,Data,{error,timeout}}} + end + end, + spawn_link(EndConfProc). + spawn_fw_call(Mod,{init_per_testcase,Func},Pid,{timetrap_timeout,TVal}=Why, Loc,SendTo,Comment) -> FwCall = fun() -> Skip = {skip,{failed,{Mod,init_per_testcase,Why}}}, - %% if init_per_testcase fails, the test case + %% if init_per_testcase fails, the test case %% should be skipped case catch test_server_sup:framework_call( end_tc,[?pl2a(Mod),Func,{Pid,Skip,[[]]}]) of @@ -838,6 +947,7 @@ spawn_fw_call(Mod,{init_per_testcase,Func},Pid,{timetrap_timeout,TVal}=Why, {TVal/1000,Skip,Loc,[],Comment}} end, spawn_link(FwCall); + spawn_fw_call(Mod,{end_per_testcase,Func},Pid,{timetrap_timeout,TVal}=Why, Loc,SendTo,_Comment) -> FwCall = @@ -869,7 +979,7 @@ spawn_fw_call(FwMod,FwFunc,_Pid,{framework_error,FwError},_,SendTo,_Comment) -> fun() -> test_server_sup:framework_call(report, [framework_error, {{FwMod,FwFunc},FwError}]), - Comment = + Comment = lists:flatten( io_lib:format("<font color=\"red\">" "WARNING! ~w:~w failed!</font>", [FwMod,FwFunc])), @@ -953,9 +1063,10 @@ job_proxy_msgloop() -> %% A test case is known to have failed if it returns {'EXIT', _} tuple, %% or sends a message {failed, File, Line} to it's group_leader -run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, - MultiplyTimetrap, TCCallback) -> - put(test_server_multiply_timetraps,MultiplyTimetrap), +run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, + TimetrapData, TCCallback) -> + put(test_server_multiply_timetraps,TimetrapData), + {{Time,Value},Loc,Opts} = case test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0], {ok,Args0}) of @@ -1004,6 +1115,8 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> 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 + group_leader() ! {set_curr_conf,{{Mod,Func},NewConf1}}, put(test_server_loc, {Mod,Func}), %% execute the test case {{T,Return},Loc} = {ts_tc(Mod, Func, [NewConf1]),get_loc()}, @@ -1025,6 +1138,8 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> _ -> {[{tc_status,ok}|NewConf1],Return,ok} end, + %% clear current state in controller loop + group_leader() ! {set_curr_conf,undefined}, %% call user callback function if defined EndConf1 = user_callback(TCCallback, Mod, Func, 'end', EndConf), {FWReturn1,TSReturn1,EndConf2} = @@ -1036,9 +1151,10 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> {{error,ReasonToFail},{failed,ReasonToFail},EndConf1}; {failed,{_,end_per_testcase,_}} = Failure -> % unexpected termination {Failure,TSReturn,EndConf1}; - _ -> + _ -> {FWReturn,TSReturn,EndConf1} end, + put(test_server_init_or_end_conf,undefined), case test_server_sup:framework_call(end_tc, [?pl2a(Mod), Func, {FWReturn1,[EndConf2]}]) of {fail,Reason} -> @@ -1067,7 +1183,7 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> {{T,Return2},Loc,Opts} end. -%% the return value is a list and we have to check if it contains +%% the return value is a list and we have to check if it contains %% the result of an end conf case or if it's a Config list process_return_val([Return], M,F,A, Loc, Final) when is_list(Return) -> ReturnTags = [skip,skip_and_save,save_config,comment,return_group_result], @@ -1082,24 +1198,33 @@ 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 - test_server_sup:framework_call(end_tc, [?pl2a(M),F,{ok,A}]), - {Return,[]} + case test_server_sup:framework_call(end_tc, [?pl2a(M),F,{ok,A}]) of + {fail,FWReason} -> + fw_error_notify(M,F,A, FWReason), + {{failed,FWReason},[]}; + _ -> + {Return,[]} + end end; %% the return value is not a list, so it's the return value from an %% end conf case or it's a dummy value that can be ignored process_return_val(Return, M,F,A, Loc, Final) -> process_return_val1(Return, M,F,A, Loc, Final, []). -process_return_val1([Failed={E,TCError}|_], M,F,A=[Args], Loc, _, SaveOpts) when E=='EXIT'; +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)), - test_server_sup:framework_call(end_tc, - [?pl2a(M),F,{{error,TCError}, - [[{tc_status,{failed,TCError}}|Args]]}]), - {Failed,SaveOpts}; -process_return_val1([SaveCfg={save_config,_}|Opts], M,F,[Args], Loc, Final, SaveOpts) -> + case test_server_sup:framework_call(end_tc, + [?pl2a(M),F,{{error,TCError}, + [[{tc_status,{failed,TCError}}|Args]]}]) of + {fail,FWReason} -> + {{failed,FWReason},SaveOpts}; + _ -> + {Failed,SaveOpts} + end; +process_return_val1([SaveCfg={save_config,_}|Opts], M,F,[Args], Loc, Final, SaveOpts) -> process_return_val1(Opts, M,F,[[SaveCfg|Args]], Loc, Final, SaveOpts); -process_return_val1([{skip_and_save,Why,SaveCfg}|Opts], M,F,[Args], Loc, _, SaveOpts) -> +process_return_val1([{skip_and_save,Why,SaveCfg}|Opts], M,F,[Args], Loc, _, SaveOpts) -> process_return_val1(Opts, M,F,[[{save_config,SaveCfg}|Args]], Loc, {skip,Why}, SaveOpts); process_return_val1([GR={return_group_result,_}|Opts], M,F,A, Loc, Final, SaveOpts) -> process_return_val1(Opts, M,F,A, Loc, Final, [GR|SaveOpts]); @@ -1109,8 +1234,12 @@ process_return_val1([RetVal={Tag,_}|Opts], M,F,A, Loc, _, SaveOpts) when Tag==sk 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) -> - test_server_sup:framework_call(end_tc, [?pl2a(M),F,{Final,A}]), - {Final,lists:reverse(SaveOpts)}. + case test_server_sup:framework_call(end_tc, [?pl2a(M),F,{Final,A}]) of + {fail,FWReason} -> + {{failed,FWReason},SaveOpts}; + _ -> + {Final,lists:reverse(SaveOpts)} + end. user_callback(undefined, _, _, _, Args) -> Args; @@ -1138,7 +1267,7 @@ init_per_testcase(Mod, Func, Args) -> case erlang:function_exported(Mod,init_per_testcase,2) of true -> case catch my_apply(Mod, init_per_testcase, [Func|Args]) of - {'$test_server_ok',{Skip,Reason}} when Skip==skip; + {'$test_server_ok',{Skip,Reason}} when Skip==skip; Skip==skipped -> {skip,Reason}; {'$test_server_ok',Res={skip_and_save,_,_}} -> @@ -1149,31 +1278,31 @@ init_per_testcase(Mod, Func, Args) -> [] -> {ok,NewConf}; Bad -> - group_leader() ! {printout,12, + group_leader() ! {printout,12, "ERROR! init_per_testcase has returned " - "bad elements in Config: ~p\n",[Bad]}, + "bad elements in Config: ~p\n",[Bad]}, {skip,{failed,{Mod,init_per_testcase,bad_return}}} end; {'$test_server_ok',_Other} -> - group_leader() ! {printout,12, + group_leader() ! {printout,12, "ERROR! init_per_testcase did not return " - "a Config list.\n",[]}, + "a Config list.\n",[]}, {skip,{failed,{Mod,init_per_testcase,bad_return}}}; {'EXIT',Reason} -> Line = get_loc(), FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), - group_leader() ! {printout,12, + group_leader() ! {printout,12, "ERROR! init_per_testcase crashed!\n" "\tLocation: ~s\n\tReason: ~p\n", - [FormattedLoc,Reason]}, + [FormattedLoc,Reason]}, {skip,{failed,{Mod,init_per_testcase,Reason}}}; Other -> Line = get_loc(), FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), - group_leader() ! {printout,12, + group_leader() ! {printout,12, "ERROR! init_per_testcase thrown!\n" "\tLocation: ~s\n\tReason: ~p\n", - [FormattedLoc, Other]}, + [FormattedLoc, Other]}, {skip,{failed,{Mod,init_per_testcase,Other}}} end; false -> @@ -1182,7 +1311,7 @@ init_per_testcase(Mod, Func, Args) -> [Config] = Args, {ok, Config} end. - + end_per_testcase(Mod, Func, Conf) -> case erlang:function_exported(Mod,end_per_testcase,2) of true -> @@ -1211,11 +1340,11 @@ do_end_per_testcase(Mod,EndFunc,Func,Conf) -> comment(io_lib:format("<font color=\"red\">" "WARNING: ~w crashed!" "</font>\n",[EndFunc])), - group_leader() ! {printout,12, + group_leader() ! {printout,12, "WARNING: ~w crashed!\n" "Reason: ~p\n" "Line: ~s\n", - [EndFunc, Reason, + [EndFunc, Reason, test_server_sup:format_loc( mod_loc(get_loc()))]}, {failed,{Mod,end_per_testcase,Why}}; @@ -1223,13 +1352,13 @@ do_end_per_testcase(Mod,EndFunc,Func,Conf) -> comment(io_lib:format("<font color=\"red\">" "WARNING: ~w thrown!" "</font>\n",[EndFunc])), - group_leader() ! {printout,12, + group_leader() ! {printout,12, "WARNING: ~w thrown!\n" "Reason: ~p\n" "Line: ~s\n", - [EndFunc, Other, + [EndFunc, Other, test_server_sup:format_loc( - mod_loc(get_loc()))]}, + mod_loc(get_loc()))]}, {failed,{Mod,end_per_testcase,Other}} end. @@ -1254,7 +1383,7 @@ get_mf(_) -> {undefined,undefined}. mod_loc(Loc) -> %% handle diff line num versions - case Loc of + case Loc of [{{_M,_F},_L}|_] -> [{?pl2a(M),F,L} || {{M,F},L} <- Loc]; [{_M,_F}|_] -> @@ -1286,7 +1415,7 @@ fw_error_notify(Mod, Func, Args, Error, Loc) -> %% Args = [term()] %% %% Just like io:format, except that depending on the Detail value, the output -%% is directed to console, major and/or minor log files. +%% 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]}). @@ -1296,11 +1425,11 @@ print(Detail,Format,Args) -> %% %% Prints Leader followed by a time stamp (date and time). Depending on %% the Detail value, the output is directed to console, major and/or minor -%% log files. +%% log files. print_timestamp(Detail,Leader) -> local_or_remote_apply({test_server_ctrl,print_timestamp,[Detail,Leader]}). - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% lookup_config(Key,Config) -> {value,{Key,Value}} | undefined @@ -1326,11 +1455,11 @@ ts_tc(M, F, A) -> Val = (catch my_apply(M, F, A)), After = erlang:now(), Result = case Val of - {'$test_server_ok', R} -> + {'$test_server_ok', R} -> R; % test case ok - {'EXIT',_Reason} = R -> + {'EXIT',_Reason} = R -> R; % test case crashed - Other -> + Other -> {failed, {thrown,Other}} % test case was thrown end, Elapsed = @@ -1352,7 +1481,7 @@ my_apply(M, F, A) -> %% in an attempt to keep this modules small (yeah, right!) %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% unicode_to_latin1(Chars) when is_list(Chars); is_binary(Chars) -> - lists:flatten( + lists:flatten( [ case X of High when High > 255 -> io_lib:format("\\{~.8B}",[X]); @@ -1460,6 +1589,44 @@ sleep(MSecs) -> ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% adjusted_sleep(Time) -> ok +%% Time = integer() | float() | infinity +%% +%% Sleeps the specified number of milliseconds, multiplied by the +%% 'multiply_timetraps' value (if set) and possibly also automatically scaled +%% up if 'scale_timetraps' is set to true (which is default). +%% This function also accepts floating point numbers (which are truncated) and +%% the atom 'infinity'. +adjusted_sleep(infinity) -> + receive + after infinity -> + ok + end; +adjusted_sleep(MSecs) -> + {Multiplier,ScaleFactor} = + case test_server_ctrl:get_timetrap_parameters() of + {undefined,undefined} -> + {1,1}; + {undefined,false} -> + {1,1}; + {undefined,true} -> + {1,timetrap_scale_factor()}; + {infinity,_} -> + {infinity,1}; + {Mult,undefined} -> + {Mult,1}; + {Mult,false} -> + {Mult,1}; + {Mult,true} -> + {Mult,timetrap_scale_factor()} + end, + receive + after trunc(MSecs*Multiplier*ScaleFactor) -> + ok + end, + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% fail(Reason) -> exit({suite_failed,Reason}) %% %% Immediately calls exit. Included because test suites are easier @@ -1509,9 +1676,9 @@ break(Comment) -> receive continue -> ok end. spawn_break_process(Pid) -> - spawn(fun() -> + spawn(fun() -> register(test_server_break_process,self()), - receive + receive continue -> continue(Pid); cancel -> ok end @@ -1561,20 +1728,21 @@ timetrap_scale_factor() -> %% timetrap(Timeout) -> Handle %% Handle = term() %% -%% Creates a time trap, that will kill the calling process if the +%% Creates a time trap, that will kill the calling process if the %% trap is not cancelled with timetrap_cancel/1, within Timeout milliseconds. - timetrap(Timeout0) -> Timeout = time_ms(Timeout0), cancel_default_timetrap(), case get(test_server_multiply_timetraps) of - undefined -> timetrap1(Timeout); - infinity -> infinity; - Int -> timetrap1(Timeout*Int) + undefined -> timetrap1(Timeout, true); + {undefined,false} -> timetrap1(Timeout, false); + {undefined,_} -> timetrap1(Timeout, true); + {infinity,_} -> infinity; + {Int,Scale} -> timetrap1(Timeout*Int, Scale) end. -timetrap1(Timeout) -> - Ref = spawn_link(test_server_sup,timetrap,[Timeout,self()]), +timetrap1(Timeout, Scale) -> + Ref = spawn_link(test_server_sup,timetrap,[Timeout,Scale,self()]), case get(test_server_timetraps) of undefined -> put(test_server_timetraps,[Ref]); List -> put(test_server_timetraps,[Ref|List]) @@ -1582,7 +1750,6 @@ timetrap1(Timeout) -> Ref. ensure_timetrap(Config) -> - %format("ensure_timetrap:~p~n",[Config]), case get(test_server_timetraps) of [_|_] -> ok; @@ -1623,7 +1790,7 @@ cancel_default_timetrap() -> time_ms({hours,N}) -> hours(N); time_ms({minutes,N}) -> minutes(N); time_ms({seconds,N}) -> seconds(N); -time_ms({Other,_N}) -> +time_ms({Other,_N}) -> format("=== ERROR: Invalid time specification: ~p. " "Should be seconds, minutes, or hours.~n", [Other]), exit({invalid_time_spec,Other}); @@ -1763,21 +1930,21 @@ call_crash(Time,Crash,M,F,A) -> %% Slave and Peer: %% {remote, true} - Start the node on a remote host. If not specified, %% the node will be started on the local host (with -%% some exceptions, as for the case of VxWorks and OSE, +%% some exceptions, for instance VxWorks, %% where all nodes are started on a remote host). %% {args, Arguments} - Arguments passed directly to the node. %% {cleanup, false} - Nodes started with this option will not be killed %% by the test server after completion of the test case %% Therefore it is IMPORTANT that the USER terminates %% the node!! -%% {erl, ReleaseList} - Use an Erlang emulator determined by ReleaseList -%% when starting nodes, instead of the same emulator +%% {erl, ReleaseList} - Use an Erlang emulator determined by ReleaseList +%% when starting nodes, instead of the same emulator %% as the test server is running. ReleaseList is a list -%% of specifiers, where a specifier is either -%% {release, Rel}, {prog, Prog}, or 'this'. Rel is -%% either the name of a release, e.g., "r7a" or -%% 'latest'. 'this' means using the same emulator as -%% the test server. Prog is the name of an emulator +%% of specifiers, where a specifier is either +%% {release, Rel}, {prog, Prog}, or 'this'. Rel is +%% either the name of a release, e.g., "r7a" or +%% 'latest'. 'this' means using the same emulator as +%% the test server. Prog is the name of an emulator %% executable. If the list has more than one element, %% one of them is picked randomly. (Only %% works on Solaris and Linux, and the test @@ -1792,13 +1959,13 @@ call_crash(Time,Crash,M,F,A) -> %% peer nodes. %% Note that slave nodes always act as if they had %% fail_on_error==false. -%% +%% start_node(Name, Type, Options) -> lists:foreach( - fun(N) -> + fun(N) -> case firstname(N) of - Name -> + Name -> format("=== WARNING: Trying to start node \'~w\' when node" " with same first name exists: ~w", [Name, N]); _other -> ok @@ -1817,19 +1984,19 @@ start_node(Name, Type, Options) -> %% Cannot run cover on shielded node or on a node started %% by a shielded node. Cover = case is_cover() of - true -> + true -> not is_shielded(Name) andalso same_version(Node); - false -> + false -> false end, net_adm:ping(Node), case Cover of - true -> + true -> Sticky = unstick_all_sticky(Node), cover:start(Node), stick_all_sticky(Node,Sticky); - _ -> + _ -> ok end, {ok,Node}; @@ -1857,7 +2024,7 @@ wait_for_node(Slave) -> self(), {test_server_ctrl,wait_for_node,[Slave]}}, receive {sync_result,R} -> R end. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% stop_node(Name) -> true|false @@ -1867,7 +2034,7 @@ wait_for_node(Slave) -> stop_node(Slave) -> Nocover = is_shielded(Slave) orelse not same_version(Slave), case is_cover() of - true when not Nocover -> + true when not Nocover -> Sticky = unstick_all_sticky(Slave), cover:stop(Slave), stick_all_sticky(Slave,Sticky); @@ -1895,10 +2062,10 @@ stop_node(Slave) -> %% with the {cleanup,false} option, or it was started %% in some other way than test_server:start_node/3 format("=== WARNING: Attempt to stop a nonexisting slavenode (~p)~n" - "=== Trying to kill it anyway!!!", + "=== Trying to kill it anyway!!!", [Slave]), case net_adm:ping(Slave)of - pong -> + pong -> slave:stop(Slave), true; pang -> @@ -1918,7 +2085,7 @@ is_release_available(Release) -> self(), {test_server_ctrl,is_release_available,[Release]}}, receive {sync_result,R} -> R end. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% run_on_shielded_node(Fun, CArgs) -> term() @@ -1937,7 +2104,7 @@ is_release_available(Release) -> %% %% Fun - Function to execute %% CArg - Extra command line arguments to use when starting -%% the shielded node. +%% the shielded node. %% %% If Fun is successfully executed, the result is returned. %% @@ -2014,14 +2181,8 @@ temp_name(Stem) -> app_test(App) -> app_test(App, pedantic). app_test(App, Mode) -> - case os:type() of - {ose,_} -> - Comment = "Skipping app_test on OSE", - comment(Comment), % in case user ignores the return value - {skip,Comment}; - _other -> - test_server_sup:app_test(App, Mode) - end. + test_server_sup:app_test(App, Mode). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2043,8 +2204,8 @@ is_native(Mod) -> %% The given String will occur in the comment field %% of the table on the test suite result page. If %% called several times, only the last comment is -%% printed. -%% comment/1 is also overwritten by the return value +%% printed. +%% comment/1 is also overwritten by the return value %% {comment,Comment} or fail/1 (which prints Reason %% as a comment). comment(String) -> @@ -2160,7 +2321,7 @@ purify_new_fds_inuse() -> {'EXIT', _} -> false; Inuse when is_integer(Inuse) -> Inuse end. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% purify_format(Format, Args) -> ok %% Format = string() @@ -2208,9 +2369,9 @@ local_or_remote_apply({M,F,A} = MFA) -> 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} -> diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index 4cb5863955..1dc5646184 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -27,7 +27,7 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% MODULE DEPENDENCIES: -%% HARD TO REMOVE: erlang, lists, io_lib, gen_server, file, io, string, +%% HARD TO REMOVE: erlang, lists, io_lib, gen_server, file, io, string, %% code, ets, rpc, gen_tcp, inet, erl_tar, sets, %% test_server, test_server_sup, test_server_node %% EASIER TO REMOVE: filename, filelib, lib, re @@ -36,7 +36,7 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% 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) @@ -44,11 +44,11 @@ %% 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) @@ -62,33 +62,33 @@ %% ----- %% | | 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' +%% +%% 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. +%% +%% 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) @@ -102,36 +102,36 @@ %% ----- %% | | 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) +%% (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 @@ -141,7 +141,7 @@ %% <- {crash_dumps,Tarfile} When a test case is finished %% -> job_done When a job is finished %% <- {privdir,Privdir} When a job is finished -%% +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -151,17 +151,19 @@ %%% OPERATOR INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -export([add_spec/1, add_dir/2, add_dir/3]). --export([add_module/1, add_module/2, add_case/2, add_case/3, add_cases/2, - add_cases/3]). +-export([add_module/1, add_module/2, + add_conf/3, + add_case/2, add_case/3, add_cases/2, add_cases/3]). -export([add_dir_with_skip/3, add_dir_with_skip/4, add_tests_with_skip/3]). -export([add_module_with_skip/2, add_module_with_skip/3, + add_conf_with_skip/4, add_case_with_skip/3, add_case_with_skip/4, add_cases_with_skip/3, add_cases_with_skip/4]). -export([jobs/0, run_test/1, wait_finish/0, idle_notify/1, abort_current_testcase/1, abort/0]). -export([start_get_totals/1, stop_get_totals/0]). -export([get_levels/0, set_levels/3]). --export([multiply_timetraps/1]). +-export([multiply_timetraps/1, scale_timetraps/1, get_timetrap_parameters/0]). -export([cover/2, cover/3, cover/7, cross_cover_analyse/1, cross_cover_analyse/2, trc/1, stop_trace/0]). -export([testcase_callback/1]). @@ -207,13 +209,15 @@ -define(pl2a(M), test_server_sup:package_atom(M)). -define(void_fun, fun() -> ok end). --define(mod_result(X), if X == skip -> skipped; - X == auto_skip -> skipped; +-define(mod_result(X), if X == skip -> skipped; + X == auto_skip -> skipped; true -> X end). --record(state,{jobs=[],levels={1,19,10},multiply_timetraps=1,finish=false, +-record(state,{jobs=[],levels={1,19,10}, + multiply_timetraps=1,scale_timetraps=true, + finish=false, target_info, trc=false, cover=false, wait_for_node=[], - testcase_callback=undefined, idle_notify=[], + testcase_callback=undefined, idle_notify=[], get_totals=false, random_seed=undefined}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -222,21 +226,28 @@ add_dir(Name, Job=[Dir|_Dirs]) when is_list(Dir) -> add_job(cast_to_list(Name), lists:map(fun(D)-> {dir,cast_to_list(D)} end, Job)); -add_dir(Name, Dir) -> +add_dir(Name, Dir) -> add_job(cast_to_list(Name), {dir,cast_to_list(Dir)}). add_dir(Name, Job=[Dir|_Dirs], Pattern) when is_list(Dir) -> add_job(cast_to_list(Name), lists:map(fun(D)-> {dir,cast_to_list(D), cast_to_list(Pattern)} end, Job)); -add_dir(Name, Dir, Pattern) -> +add_dir(Name, Dir, Pattern) -> add_job(cast_to_list(Name), {dir,cast_to_list(Dir),cast_to_list(Pattern)}). add_module(Mod) when is_atom(Mod) -> add_job(atom_to_list(Mod), {Mod,all}). + add_module(Name, Mods) when is_list(Mods) -> add_job(cast_to_list(Name), lists:map(fun(Mod) -> {Mod,all} end, Mods)). +add_conf(Name, Mod, Conf) when is_tuple(Conf) -> + add_job(cast_to_list(Name), {Mod,[Conf]}); + +add_conf(Name, Mod, Confs) when is_list(Confs) -> + add_job(cast_to_list(Name), {Mod,Confs}). + add_case(Mod, Case) when is_atom(Mod), is_atom(Case) -> add_job(atom_to_list(Mod), {Mod,Case}). @@ -256,14 +267,14 @@ add_spec(Spec) -> false -> {error,nofile} end. -%% This version of the interface is to be used if there are +%% This version of the interface is to be used if there are %% suites or cases that should be skipped. add_dir_with_skip(Name, Job=[Dir|_Dirs], Skip) when is_list(Dir) -> add_job(cast_to_list(Name), lists:map(fun(D)-> {dir,cast_to_list(D)} end, Job), Skip); -add_dir_with_skip(Name, Dir, Skip) -> +add_dir_with_skip(Name, Dir, Skip) -> add_job(cast_to_list(Name), {dir,cast_to_list(Dir)}, Skip). add_dir_with_skip(Name, Job=[Dir|_Dirs], Pattern, Skip) when is_list(Dir) -> @@ -271,7 +282,7 @@ add_dir_with_skip(Name, Job=[Dir|_Dirs], Pattern, Skip) when is_list(Dir) -> lists:map(fun(D)-> {dir,cast_to_list(D), cast_to_list(Pattern)} end, Job), Skip); -add_dir_with_skip(Name, Dir, Pattern, Skip) -> +add_dir_with_skip(Name, Dir, Pattern, Skip) -> add_job(cast_to_list(Name), {dir,cast_to_list(Dir),cast_to_list(Pattern)}, Skip). @@ -281,6 +292,12 @@ add_module_with_skip(Mod, Skip) when is_atom(Mod) -> add_module_with_skip(Name, Mods, Skip) when is_list(Mods) -> add_job(cast_to_list(Name), lists:map(fun(Mod) -> {Mod,all} end, Mods), Skip). +add_conf_with_skip(Name, Mod, Conf, Skip) when is_tuple(Conf) -> + add_job(cast_to_list(Name), {Mod,[Conf]}, Skip); + +add_conf_with_skip(Name, Mod, Confs, Skip) when is_list(Confs) -> + add_job(cast_to_list(Name), {Mod,Confs}, Skip). + add_case_with_skip(Mod, Case, Skip) when is_atom(Mod), is_atom(Case) -> add_job(atom_to_list(Mod), {Mod,Case}, Skip). @@ -295,15 +312,14 @@ add_cases_with_skip(Name, Mod, Cases, Skip) when is_atom(Mod), is_list(Cases) -> add_tests_with_skip(LogDir, Tests, Skip) -> add_job(LogDir, - lists:map(fun({Dir,all,all}) -> + lists:map(fun({Dir,all,all}) -> {Dir,{dir,Dir}}; - ({Dir,Mods,all}) -> + ({Dir,Mods,all}) -> {Dir,lists:map(fun(M) -> {M,all} end, Mods)}; ({Dir,Mod,Cases}) -> {Dir,{Mod,Cases}} end, Tests), Skip). - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% COMMAND LINE INTERFACE @@ -315,7 +331,7 @@ parse_cmd_line(['SPEC',Spec|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) -> case file:consult(Spec) of {ok, TermList} -> Name = filename:rootname(Spec), - parse_cmd_line(Cmds, TermList++SpecList, [Name|Names], Param, + parse_cmd_line(Cmds, TermList++SpecList, [Name|Names], Param, Trc, Cov, TCCB); {error,Reason} -> io:format("Can't open ~s: ~p\n", @@ -406,7 +422,7 @@ run_test(CommandLine) -> end, testcase_callback(TCCB), add_job(Name, {command_line,SpecList}), - + %% adding of jobs involves file i/o which may take long time %% when running a nfs mounted file system (VxWorks). case controller_call(get_target_info) of @@ -479,6 +495,12 @@ set_levels(Show, Major, Minor) -> multiply_timetraps(N) -> controller_call({multiply_timetraps,N}). +scale_timetraps(Bool) -> + controller_call({scale_timetraps,Bool}). + +get_timetrap_parameters() -> + controller_call(get_timetrap_parameters). + trc(TraceFile) -> controller_call({trace,TraceFile}, 2*?ACCEPT_TIMEOUT). @@ -551,7 +573,7 @@ controller_call(Arg, Timeout) -> Other -> Other end. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -617,7 +639,7 @@ contact_main_target(local) -> case os:getenv("TEST_SERVER_FRAMEWORK") of false -> %% Local target! The global test_server process implemented by - %% test_server.erl will not be started, so we simulate it by + %% 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 @@ -681,9 +703,9 @@ read_parameters([], Par) when Par#par.type==undefined -> read_parameters([], Par) when Par#par.target==undefined -> {error, {missing_mandatory_parameter,target}}; read_parameters([], Par0) -> - Par = + Par = case {Par0#par.type, Par0#par.master} of - {ose, undefined} -> + {ose, undefined} -> %% Use this node as master and bootserver for target %% and slave nodes Par0#par{master = atom_to_list(node()), @@ -691,10 +713,10 @@ read_parameters([], Par0) -> {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} + Par0#par{master="test_server@" ++ Par0#par.target} end, {ok,Par}. @@ -708,7 +730,7 @@ naming() -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% handle_call(kill_slavenodes, From, State) -> ok %% -%% Kill all slave nodes that remain after a test case +%% Kill all slave nodes that remain after a test case %% is completed. %% handle_call(kill_slavenodes, _From, State) -> @@ -736,7 +758,7 @@ handle_call(get_hosts, _From, State) -> {reply, Hosts, State}; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({add_job,Dir,Name,TopCase,Skip}, _, State) -> +%% handle_call({add_job,Dir,Name,TopCase,Skip}, _, State) -> %% ok | {error,Reason} %% %% Dir = string() @@ -760,7 +782,7 @@ handle_call(get_hosts, _From, State) -> handle_call({add_job,Dir,Name,TopCase,Skip}, _From, State) -> LogDir = Dir ++ ?logdir_ext, - ExtraTools = + ExtraTools = case State#state.cover of false -> []; {App,Analyse} -> [{cover,App,Analyse}] @@ -776,19 +798,21 @@ handle_call({add_job,Dir,Name,TopCase,Skip}, _From, State) -> {spec,SpecName} -> Pid = spawn_tester( ?MODULE, do_spec, - [SpecName,State#state.multiply_timetraps], - LogDir, Name, State#state.levels, + [SpecName,{State#state.multiply_timetraps, + State#state.scale_timetraps}], + LogDir, Name, State#state.levels, State#state.testcase_callback, ExtraTools1), NewJobs = [{Name,Pid}|State#state.jobs], - {reply, ok, State#state{jobs=NewJobs}}; + {reply, ok, State#state{jobs=NewJobs}}; {command_line,SpecList} -> Pid = spawn_tester( ?MODULE, do_spec_list, - [SpecList,State#state.multiply_timetraps], - LogDir, Name, State#state.levels, + [SpecList,{State#state.multiply_timetraps, + State#state.scale_timetraps}], + LogDir, Name, State#state.levels, State#state.testcase_callback, ExtraTools1), NewJobs = [{Name,Pid}|State#state.jobs], - {reply, ok, State#state{jobs=NewJobs}}; + {reply, ok, State#state{jobs=NewJobs}}; TopCase -> case State#state.get_totals of {CliPid,Fun} -> @@ -798,10 +822,11 @@ handle_call({add_job,Dir,Name,TopCase,Skip}, _From, State) -> _ -> Cfg = make_config([]), Pid = spawn_tester( - ?MODULE, do_test_cases, + ?MODULE, do_test_cases, [TopCase,Skip,Cfg, - State#state.multiply_timetraps], - LogDir, Name, State#state.levels, + {State#state.multiply_timetraps, + State#state.scale_timetraps}], + LogDir, Name, State#state.levels, State#state.testcase_callback, ExtraTools1), NewJobs = [{Name,Pid}|State#state.jobs], {reply, ok, State#state{jobs=NewJobs}} @@ -827,7 +852,7 @@ handle_call(jobs, _From, State) -> %% handle_call({abort_current_testcase,Reason}, _, State) -> Result %% Reason = term() %% Result = ok | {error,no_testcase_running} -%% +%% %% Attempts to abort the test case that's currently running. handle_call({abort_current_testcase,Reason}, _From, State) -> @@ -855,7 +880,7 @@ handle_call({abort_current_testcase,Reason}, _From, State) -> handle_call({finish,Fini}, _From, State) -> case State#state.jobs of [] -> - lists:foreach(fun({Cli,Fun}) -> Fun(Cli) end, + lists:foreach(fun({Cli,Fun}) -> Fun(Cli) end, State#state.idle_notify), State2 = State#state{finish=false}, {stop,shutdown,{ok,self()}, State2}; @@ -878,7 +903,7 @@ handle_call({idle_notify,Fun}, {Cli,_Ref}, State) -> {reply, {ok,self()}, State}; _ -> Subscribed = State#state.idle_notify, - {reply, {ok,self()}, + {reply, {ok,self()}, State#state{idle_notify=[{Cli,Fun}|Subscribed]}} end; @@ -891,7 +916,7 @@ handle_call({idle_notify,Fun}, {Cli,_Ref}, State) -> handle_call({start_get_totals,Fun}, {Cli,_Ref}, State) -> {reply, {ok,self()}, State#state{get_totals={Cli,Fun}}}; - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% handle_call(stop_get_totals, From, State) -> ok %% @@ -942,11 +967,31 @@ handle_call({multiply_timetraps,N}, _From, State) -> {reply,ok,State#state{multiply_timetraps=N}}; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({scale_timetraps,Bool}, _, State) -> ok +%% Bool = true | false +%% +%% Specifies if test_server should scale the timetrap value +%% automatically if e.g. cover is running. + +handle_call({scale_timetraps,Bool}, _From, State) -> + {reply,ok,State#state{scale_timetraps=Bool}}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call(get_timetrap_parameters, _, State) -> {Multiplier,Scale} +%% Multiplier = integer() | infinity +%% Scale = true | false +%% +%% Returns the parameter values that affect timetraps. + +handle_call(get_timetrap_parameters, _From, State) -> + {reply,{State#state.multiply_timetraps,State#state.scale_timetraps},State}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% handle_call({trace,TraceFile}, _, State) -> ok | {error,Reason} %% -%% Starts a separate node (trace control node) which +%% Starts a separate node (trace control node) which %% starts tracing on target and all slave nodes -%% +%% %% TraceFile is a text file with elements of type %% {Trace,Mod,TracePattern}. %% {Trace,Mod,Func,TracePattern}. @@ -955,10 +1000,10 @@ handle_call({multiply_timetraps,N}, _From, State) -> %% Trace = tp | tpl; local or global call trace %% Mod,Func = atom(), Arity=integer(); defines what to trace %% TracePattern = [] | match_spec() -%% +%% %% The 'call' trace flag is set on all processes, and then %% the given trace patterns are set. - + handle_call({trace,TraceFile}, _From, State=#state{trc=false}) -> TI = State#state.target_info, case test_server_node:start_tracer_node(TraceFile, TI) of @@ -993,7 +1038,7 @@ handle_call({cover,App,Analyse}, _From, State) -> %% handle_call({testcase_callback,{Mod,Func}}, _, State) -> ok | {error,Reason} %% %% Add a callback function that will be called before and after every -%% test case (on the test case process): +%% test case (on the test case process): %% %% Mod:Func(Suite,TestCase,InitOrEnd,Config) %% @@ -1001,9 +1046,9 @@ handle_call({cover,App,Analyse}, _From, State) -> handle_call({testcase_callback,ModFunc}, _From, State) -> case ModFunc of - {Mod,Func} -> + {Mod,Func} -> case code:is_loaded(Mod) of - {file,_} -> + {file,_} -> ok; false -> code:load_file(Mod) @@ -1065,15 +1110,15 @@ handle_call({start_node, Name, Type, Options}, From, State) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% handle_call({wait_for_node,Node}, _, State) -> ok %% -%% Waits for a new node to take contact. Used if +%% Waits for a new node to take contact. Used if %% node is started with option {wait,false} handle_call({wait_for_node, Node}, From, State) -> - NewWaitList = + NewWaitList = case ets:lookup(slave_tab,Node) of - [] -> + [] -> [{Node,From}|State#state.wait_for_node]; - _ -> + _ -> gen_server:reply(From,ok), State#state.wait_for_node end, @@ -1086,7 +1131,7 @@ handle_call({wait_for_node, Node}, From, State) -> %% - the node is really stopped by test_server when this returns. handle_call({stop_node, Name}, _From, State) -> - R = test_server_node:stop_node(Name, State#state.target_info), + R = test_server_node:stop_node(Name, State#state.target_info), {reply, R, State}; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1112,7 +1157,7 @@ handle_cast({node_started,Node}, State) -> false -> ok; Trc -> test_server_node:trace_nodes(Trc, [Node]) end, - NewWaitList = + NewWaitList = case lists:keysearch(Node,1,State#state.wait_for_node) of {value,{Node,From}} -> gen_server:reply(From, ok), @@ -1128,10 +1173,10 @@ handle_cast({node_started,Node}, State) -> %% Reason = term() %% %% Handles exit messages from linked processes. Only test suites and -%% possibly a target client are expected to be linked. +%% 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 +%% target. The test_server_ctrl process is terminated, and teminate/2 %% will do the cleanup handle_info({'EXIT',Pid,Reason}, State) -> @@ -1139,7 +1184,7 @@ handle_info({'EXIT',Pid,Reason}, State) -> false -> TI = State#state.target_info, case TI#target_info.target_client of - Pid -> + Pid -> %% The target client died - lost contact with target {stop,{lost_contact_with_target,Reason},State}; _other -> @@ -1160,13 +1205,13 @@ handle_info({'EXIT',Pid,Reason}, State) -> State2 = State#state{jobs=NewJobs}, case NewJobs of [] -> - lists:foreach(fun({Cli,Fun}) -> Fun(Cli) end, + lists:foreach(fun({Cli,Fun}) -> Fun(Cli) end, State2#state.idle_notify), case State2#state.finish of false -> {noreply,State2#state{idle_notify=[]}}; _ -> % true | abort - %% test_server:finish() has been called and + %% test_server:finish() has been called and %% there are no jobs in the job queue => %% stop the test_server_ctrl {stop,shutdown,State2#state{finish=false}} @@ -1174,7 +1219,7 @@ handle_info({'EXIT',Pid,Reason}, State) -> _ -> % pending jobs case State2#state.finish of abort -> % abort test now! - lists:foreach(fun({Cli,Fun}) -> Fun(Cli) end, + lists:foreach(fun({Cli,Fun}) -> Fun(Cli) end, State2#state.idle_notify), {stop,shutdown,State2#state{finish=false}}; _ -> % true | false @@ -1194,9 +1239,9 @@ handle_info({tcp,_MainSock,<<1,Request/binary>>}, State) -> case binary_to_term(Request) of {job_proc_killed,Name,Reason} -> %% The only purpose of this is to inform the user about what - %% happened on target. + %% happened on target. %% The local job proc will soon be killed by the closed socket or - %% because the job is finished. Then the above clause ('EXIT') will + %% because the job is finished. Then the above clause ('EXIT') will %% handle the problem. io:format("Suite ~s was killed on remote target with reason" " ~p\n", [Name,Reason]); @@ -1204,13 +1249,13 @@ handle_info({tcp,_MainSock,<<1,Request/binary>>}, State) -> ignore end, {noreply,State}; - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% handle_info({tcp_closed,Sock}, State) %% %% A Socket was closed. This indicates that a node died. -%% This can be +%% This can be %% *Target node (if remote) %% *Slave or peer node started by a test suite %% *Trace controll node @@ -1221,10 +1266,10 @@ handle_info({tcp_closed,Sock}, State=#state{trc=Sock}) -> {noreply,State#state{trc=false}}; handle_info({tcp_closed,Sock}, State) -> case test_server_node:nodedown(Sock,State#state.target_info) of - target_died -> + target_died -> %% terminate/2 will do the cleanup {stop,target_died,State}; - _ -> + _ -> {noreply,State} end; @@ -1260,7 +1305,7 @@ kill_all_jobs([]) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% spawn_tester(Mod, Func, Args, Dir, Name, Levels, +%% spawn_tester(Mod, Func, Args, Dir, Name, Levels, %% TestCaseCallback, ExtraTools) -> Pid %% Mod = atom() %% Func = atom() @@ -1268,23 +1313,23 @@ kill_all_jobs([]) -> %% Dir = string() %% Name = string() %% Levels = {integer(),integer(),integer()} -%% TestCaseCallback = {CBMod,CBFunc} | undefined +%% TestCaseCallback = {CBMod,CBFunc} | undefined %% ExtraTools = [ExtraTool,...] %% ExtraTool = CoverInfo | TraceInfo | RandomSeed %% %% Spawns a test suite execute-process, just an ordinary spawn, except %% that it will set a lot of dictionary information before starting the %% named function. Also, the execution is timed and protected by a catch. -%% When the named function is done executing, a summary of the results +%% When the named function is done executing, a summary of the results %% is printed to the log files. spawn_tester(Mod, Func, Args, Dir, Name, Levels, TCCallback, ExtraTools) -> spawn_link( - fun() -> init_tester(Mod, Func, Args, Dir, Name, Levels, - TCCallback, ExtraTools) + fun() -> init_tester(Mod, Func, Args, Dir, Name, Levels, + TCCallback, ExtraTools) end). -init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, +init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, TCCallback, ExtraTools) -> process_flag(trap_exit, true), put(test_server_name, Name), @@ -1324,7 +1369,7 @@ init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, {Skipped,_} -> {Skipped,io_lib:format(", ~p Skipped", [Skipped])} end, OkN = get(test_server_ok), - FailedN = get(test_server_failed), + FailedN = get(test_server_failed), print(html,"<tr><td></td><td><b>TOTAL</b></td><td></td><td></td>" "<td>~.3fs</td><td><b>~s</b></td><td>~p Ok, ~p Failed~s of ~p</td></tr>\n", [Time,SuccessStr,OkN,FailedN,SkipStr,OkN+FailedN+SkippedN]). @@ -1338,9 +1383,9 @@ ts_tc(M, F, A) -> {Elapsed,Val}. elapsed_time(Before, After) -> - (element(1,After)*1000000000000 + + (element(1,After)*1000000000000 + element(2,After)*1000000 + element(3,After)) - - (element(1,Before)*1000000000000 + + (element(1,Before)*1000000000000 + element(2,Before)*1000000 + element(3,Before)). start_extra_tools(ExtraTools) -> @@ -1378,28 +1423,32 @@ stop_extra_tools([], _) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% do_spec(SpecName, MultiplyTimetrap) -> {error,Reason} | exit(Result) +%% do_spec(SpecName, TimetrapSpec) -> {error,Reason} | exit(Result) %% SpecName = string() +%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap} %% MultiplyTimetrap = integer() | infinity +%% ScaleTimetrap = bool() %% %% Reads the named test suite specification file, and executes it. %% -%% This function is meant to be called by a process created by +%% This function is meant to be called by a process created by %% spawn_tester/7, which sets up some necessary dictionary values. -do_spec(SpecName, MultiplyTimetrap) when is_list(SpecName) -> +do_spec(SpecName, TimetrapSpec) when is_list(SpecName) -> case file:consult(SpecName) of {ok,TermList} -> - do_spec_list(TermList,MultiplyTimetrap); + do_spec_list(TermList,TimetrapSpec); {error,Reason} -> io:format("Can't open ~s: ~p\n", [SpecName,Reason]), {error,{cant_open_spec,Reason}} end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% do_spec_list(TermList) -> exit(Result) +%% do_spec_list(TermList, TimetrapSpec) -> exit(Result) %% TermList = [term()|...] +%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap} %% MultiplyTimetrap = integer() | infinity +%% ScaleTimetrap = bool() %% %% Executes a list of test suite specification commands. The following %% commands are available, and may occur zero or more times (if several, @@ -1422,21 +1471,21 @@ do_spec(SpecName, MultiplyTimetrap) when is_list(SpecName) -> %% nodenames will be generated from the local host. %% %% {hosts, Hosts} Specifies a list of available hosts on which to start -%% slave nodes. It is used when the {remote, true} option is given to the +%% slave nodes. It is used when the {remote, true} option is given to the %% test_server:start_node/3 function. Also, if {require_nodenames, Num} is -%% contained in the TermList, the generated nodenames will be spread over +%% contained in the TermList, the generated nodenames will be spread over %% all hosts given in this Hosts list. The hostnames are given as atoms or %% strings. -%% +%% %% {diskless, true}</c></tag> is kept for backwards compatiblilty and %% should not be used. Use a configuration test case instead. -%% -%% This function is meant to be called by a process created by +%% +%% This function is meant to be called by a process created by %% spawn_tester/7, which sets up some necessary dictionary values. -do_spec_list(TermList0, MultiplyTimetrap) -> +do_spec_list(TermList0, TimetrapSpec) -> Nodes = [], - TermList = + TermList = case lists:keysearch(hosts, 1, TermList0) of {value, {hosts, Hosts0}} -> Hosts = lists:map(fun(H) -> cast_to_list(H) end, Hosts0), @@ -1447,7 +1496,7 @@ do_spec_list(TermList0, MultiplyTimetrap) -> end, DefaultConfig = make_config([{nodes,Nodes}]), {TopCases,SkipList,Config} = do_spec_terms(TermList, [], [], DefaultConfig), - do_test_cases(TopCases, SkipList, Config, MultiplyTimetrap). + do_test_cases(TopCases, SkipList, Config, TimetrapSpec). do_spec_terms([], TopCases, SkipList, Config) -> {TopCases,SkipList,Config}; @@ -1470,21 +1519,21 @@ do_spec_terms([{default_timeout,Tmo}|Terms], TopCases, SkipList, Config) -> do_spec_terms([{require_nodenames,NumNames}|Terms], TopCases, SkipList, Config) -> NodeNames0=generate_nodenames(NumNames), NodeNames=lists:delete([], NodeNames0), - do_spec_terms(Terms, TopCases, SkipList, + do_spec_terms(Terms, TopCases, SkipList, update_config(Config, {nodenames,NodeNames})); do_spec_terms([Other|Terms], TopCases, SkipList, Config) -> io:format("** WARNING: Spec file contains unknown directive ~p\n", [Other]), do_spec_terms(Terms, TopCases, SkipList, Config). - + generate_nodenames(Num) -> Hosts = case controller_call(get_hosts) of - [] -> + [] -> TI = controller_call(get_target_info), [TI#target_info.host]; - List -> + List -> List end, generate_nodenames2(Num, Hosts, []). @@ -1511,25 +1560,25 @@ temp_nodename([Chr|Base], Acc) -> %% NoOfCases = integer() | unknown %% %% Counts the test cases that are about to run and returns that number. -%% If there's a conf group in TestSpec with a repeat property, the total number +%% If there's a conf group in TestSpec with a repeat property, the total number %% of cases can not be calculated and NoOfCases = unknown. count_test_cases(TopCases, SkipCases) when is_list(TopCases) -> case collect_all_cases(TopCases, SkipCases) of - {error,_} -> - error; + {error,_Why} = Error -> + Error; TestSpec -> {get_suites(TestSpec, []), case remove_conf(TestSpec) of {repeats,_} -> unknown; - TestSpec1 -> + TestSpec1 -> length(TestSpec1) end} end; count_test_cases(TopCase, SkipCases) -> count_test_cases([TopCase], SkipCases). - + remove_conf(Cases) -> remove_conf(Cases, [], false). @@ -1538,13 +1587,15 @@ remove_conf([{conf, _Ref, Props, _MF}|Cases], NoConf, Repeats) -> case get_repeat(Props) of undefined -> remove_conf(Cases, NoConf, Repeats); + {_RepType,1} -> + remove_conf(Cases, NoConf, Repeats); _ -> remove_conf(Cases, NoConf, true) end; remove_conf([{make,_Ref,_MF}|Cases], NoConf, Repeats) -> remove_conf(Cases, NoConf, Repeats); -remove_conf([{skip_case,{Type,_Ref,_MF,_Cmt}}|Cases], - NoConf, Repeats) when Type==conf; +remove_conf([{skip_case,{Type,_Ref,_MF,_Cmt}}|Cases], + NoConf, Repeats) when Type==conf; Type==make -> remove_conf(Cases, NoConf, Repeats); remove_conf([C|Cases], NoConf, Repeats) -> @@ -1582,22 +1633,30 @@ add_mod(Mod, Mods) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% do_test_cases(TopCases, SkipCases, Config, MultiplyTimetrap) -> +%% do_test_cases(TopCases, SkipCases, Config, TimetrapSpec) -> %% exit(Result) %% %% TopCases = term() (See collect_cases/3) %% SkipCases = term() (See collect_cases/3) %% Config = term() (See collect_cases/3) +%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap} %% MultiplyTimetrap = integer() | infinity +%% ScaleTimetrap = bool() %% %% Initializes and starts the test run, for "ordinary" test suites. %% Creates log directories and log files, inserts initial timestamps and %% configuration information into the log files. %% -%% This function is meant to be called by a process created by +%% This function is meant to be called by a process created by %% spawn_tester/7, which sets up some necessary dictionary values. - -do_test_cases(TopCases, SkipCases, Config, MultiplyTimetrap) when is_list(TopCases) -> +do_test_cases(TopCases, SkipCases, + Config, MultiplyTimetrap) when is_integer(MultiplyTimetrap); + MultiplyTimetrap == infinity -> + do_test_cases(TopCases, SkipCases, Config, {MultiplyTimetrap,true}); + +do_test_cases(TopCases, SkipCases, + Config, TimetrapData) when is_list(TopCases), + is_tuple(TimetrapData) -> start_log_file(), case collect_all_cases(TopCases, SkipCases) of {error,Why} -> @@ -1607,27 +1666,36 @@ do_test_cases(TopCases, SkipCases, Config, MultiplyTimetrap) when is_list(TopCas N = case remove_conf(TestSpec0) of {repeats,_} -> unknown; TS -> length(TS) - end, + end, put(test_server_cases, N), put(test_server_case_num, 0), - TestSpec = + TestSpec = add_init_and_end_per_suite(TestSpec0, undefined, undefined), + TI = get_target_info(), print(1, "Starting test~s", [print_if_known(N, {", ~w test cases",[N]}, {" (with repeated test cases)",[]})]), - test_server_sup:framework_call(report, [tests_start, - {get(test_server_name),N}]), - print(html, - "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" - "<!-- autogenerated by '"++atom_to_list(?MODULE)++"'. -->\n" - "<html>\n" - "<head><title>Test ~p results</title>\n" - "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n" - "</head>\n" - "<body bgcolor=\"white\" text=\"black\" " - "link=\"blue\" vlink=\"purple\" alink=\"red\">" - "<h2>Results from test ~p</h2>\n", - [get(test_server_name),get(test_server_name)]), + Test = get(test_server_name), + test_server_sup:framework_call(report, [tests_start,{Test,N}]), + + Header = + case test_server_sup:framework_call(overview_html_header, [Test], "") of + "" -> + TestName = lists:flatten(io_lib:format("~p", [Test])), + ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n", + "<!-- autogenerated by '", atom_to_list(?MODULE), "'. -->\n", + "<html>\n", + "<head><title>Test ", TestName, " results</title>\n", + "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n", + "</head>\n", + "<body bgcolor=\"white\" text=\"black\" ", + "link=\"blue\" vlink=\"purple\" alink=\"red\">", + "<h2>Results from test ", TestName, "</h2>\n"]; + Html -> + ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n", + "<!-- autogenerated by '", atom_to_list(?MODULE), "'. -->\n" | Html] + end, + print(html, Header, []), print_timestamp(html, "Test started at "), print(html, "<p>Host:<br>\n"), @@ -1643,7 +1711,7 @@ do_test_cases(TopCases, SkipCases, Config, MultiplyTimetrap) when is_list(TopCas [TI#target_info.version, TI#target_info.root_dir]); _ -> case test_server_sup:framework_call(target_info, []) of - TargetInfo when is_list(TargetInfo), + TargetInfo when is_list(TargetInfo), length(TargetInfo) > 0 -> print(html, "<p>Target:<br>\n"), print(html, "~s\n", [TargetInfo]); @@ -1658,7 +1726,7 @@ do_test_cases(TopCases, SkipCases, Config, MultiplyTimetrap) when is_list(TopCas [?suitelog_name,?coverlog_name]), print(html,"<p>~s" "<p>\n" - "<table border=3 cellpadding=5>" + "<table bgcolor=\"white\" border=\"3\" cellpadding=\"5\">" "<tr><th>Num</th><th>Module</th><th>Case</th><th>Log</th>" "<th>Time</th><th>Result</th><th>Comment</th></tr>\n", [print_if_known(N, {"Suite contains ~p test cases.\n",[N]}, @@ -1681,12 +1749,12 @@ do_test_cases(TopCases, SkipCases, Config, MultiplyTimetrap) when is_list(TopCas print(major, "=otp_release ~s", [TI#target_info.otp_release]), print(major, "=started ~s", [lists:flatten(timestamp_get(""))]), - run_test_cases(TestSpec, Config, MultiplyTimetrap) + run_test_cases(TestSpec, Config, TimetrapData) end; -do_test_cases(TopCase, SkipCases, Config, MultiplyTimetrap) -> +do_test_cases(TopCase, SkipCases, Config, TimetrapSpec) -> %% when not list(TopCase) - do_test_cases([TopCase], SkipCases, Config, MultiplyTimetrap). + do_test_cases([TopCase], SkipCases, Config, TimetrapSpec). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1741,8 +1809,8 @@ start_log_file() -> ok. make_html_link(LinkName, Target, Explanation) -> - %% if possible use a relative reference�to�Target. - TargetL = filename:split(Target), + %% if possible use a relative reference to Target. + TargetL = filename:split(Target), PwdL = filename:split(filename:dirname(LinkName)), Href = case lists:prefix(PwdL, TargetL) of true -> @@ -1782,7 +1850,7 @@ start_minor_log_file(Mod, Func) -> start_minor_log_file1(Mod, Func, LogDir, AbsName); {ok,_} -> %% special case, duplicate names {_,S,Us} = now(), - Name1_0 = + Name1_0 = lists:flatten(io_lib:format("~s.~s.~w.~w~s", [Mod,Func,S, trunc(Us/1000), ?html_ext])), @@ -1853,7 +1921,7 @@ html_convert_modules(TestSpec, _Config) -> %% Retrieve a list of modules out of the test spec. html_isolate_modules(List) -> html_isolate_modules(List, sets:new()). - + html_isolate_modules([], Set) -> sets:to_list(Set); html_isolate_modules([{skip_case,_}|Cases], Set) -> html_isolate_modules(Cases, Set); @@ -1919,36 +1987,36 @@ add_init_and_end_per_suite([{make,_,_}=Case|Cases], LastMod, LastRef) -> [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef)]; add_init_and_end_per_suite([{skip_case,{{Mod,all},_}}=Case|Cases], LastMod, LastRef) when Mod =/= LastMod -> - {PreCases, NextMod, NextRef} = + {PreCases, NextMod, NextRef} = do_add_end_per_suite_and_skip(LastMod, LastRef, Mod), PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)]; add_init_and_end_per_suite([{skip_case,{{Mod,_},_}}=Case|Cases], LastMod, LastRef) when Mod =/= LastMod -> - {PreCases, NextMod, NextRef} = + {PreCases, NextMod, NextRef} = do_add_init_and_end_per_suite(LastMod, LastRef, Mod), PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)]; add_init_and_end_per_suite([{skip_case,{conf,_,{Mod,_},_}}=Case|Cases], LastMod, LastRef) when Mod =/= LastMod -> - {PreCases, NextMod, NextRef} = + {PreCases, NextMod, NextRef} = do_add_init_and_end_per_suite(LastMod, LastRef, Mod), PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)]; add_init_and_end_per_suite([{skip_case,_}=Case|Cases], LastMod, LastRef) -> [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef)]; -add_init_and_end_per_suite([{conf,_,_,{Mod,_}}=Case|Cases], LastMod, LastRef) +add_init_and_end_per_suite([{conf,_,_,{Mod,_}}=Case|Cases], LastMod, LastRef) when Mod =/= LastMod -> - {PreCases, NextMod, NextRef} = + {PreCases, NextMod, NextRef} = do_add_init_and_end_per_suite(LastMod, LastRef, Mod), PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)]; add_init_and_end_per_suite([{conf,_,_,_}=Case|Cases], LastMod, LastRef) -> [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef)]; -add_init_and_end_per_suite([{Mod,_}=Case|Cases], LastMod, LastRef) +add_init_and_end_per_suite([{Mod,_}=Case|Cases], LastMod, LastRef) when Mod =/= LastMod -> - {PreCases, NextMod, NextRef} = + {PreCases, NextMod, NextRef} = do_add_init_and_end_per_suite(LastMod, LastRef, Mod), PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)]; add_init_and_end_per_suite([{Mod,_,_}=Case|Cases], LastMod, LastRef) when Mod =/= LastMod -> - {PreCases, NextMod, NextRef} = + {PreCases, NextMod, NextRef} = do_add_init_and_end_per_suite(LastMod, LastRef, Mod), PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)]; add_init_and_end_per_suite([Case|Cases], LastMod, LastRef)-> @@ -1965,7 +2033,7 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod) -> false -> code:load_file(Mod); _ -> ok end, - {Init,NextMod,NextRef} = + {Init,NextMod,NextRef} = case erlang:function_exported(Mod, init_per_suite, 1) of true -> Ref = make_ref(), @@ -1973,15 +2041,15 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod) -> false -> {[],Mod,undefined} end, - Cases = + Cases = if LastRef==undefined -> Init; LastRef==skipped_suite -> Init; true -> - %% Adding end_per_suite here without checking if the + %% Adding end_per_suite here without checking if the %% function is actually exported. This is because a - %% conf case must have an end case - so if it doesn't + %% conf case must have an end case - so if it doesn't %% exist, it will only fail... [{conf,LastRef,[],{LastMod,end_per_suite}}|Init] end, @@ -1997,23 +2065,19 @@ do_add_end_per_suite_and_skip(LastMod, LastRef, Mod) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% run_test_cases(TestSpec, Config, MultiplyTimetrap) -> exit(Result) +%% run_test_cases(TestSpec, Config, TimetrapData) -> exit(Result) %% %% If remote target, a socket connection is established. %% Runs the specified tests, then displays/logs the summary. -run_test_cases(TestSpec, Config, MultiplyTimetrap) -> +run_test_cases(TestSpec, Config, TimetrapData) -> maybe_open_job_sock(), html_convert_modules(TestSpec, Config), - %%! For readable tracing... - %%! Config1 = [{data_dir,""},{priv_dir,""},{nodes,[]}], - %%! run_test_cases_loop(TestSpec, [[]], MultiplyTimetrap, [], []), + run_test_cases_loop(TestSpec, [Config], TimetrapData, [], []), - run_test_cases_loop(TestSpec, [Config], MultiplyTimetrap, [], []), - maybe_get_privdir(), {AllSkippedN,UserSkipN,AutoSkipN,SkipStr} = @@ -2060,10 +2124,10 @@ maybe_open_job_sock() -> %% tar packet containing the privdir created by the test case. maybe_get_privdir() -> case get(test_server_ctrl_job_sock) of - undefined -> + undefined -> %% local target ok; - Sock -> + Sock -> %% remote target request(Sock, job_done), gen_tcp:close(Sock) @@ -2071,37 +2135,39 @@ maybe_get_privdir() -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% run_test_cases_loop(TestCases, Config, MultiplyTimetrap, Mode, Status) -> ok +%% run_test_cases_loop(TestCases, Config, TimetrapData, Mode, Status) -> ok %% TestCases = [Test,...] %% Config = [[{Key,Val},...],...] +%% TimetrapData = {MultiplyTimetrap,ScaleTimetrap} %% MultiplyTimetrap = integer() | infinity +%% ScaleTimetrap = bool() %% Mode = [{Ref,[Prop,..],StartTime}] %% Ref = reference() -%% Prop = {name,Name} | sequence | parallel | +%% Prop = {name,Name} | sequence | parallel | %% shuffle | {shuffle,Seed} | -%% repeat | {repeat,N} | +%% repeat | {repeat,N} | %% repeat_until_all_ok | {repeat_until_all_ok,N} | -%% repeat_until_any_ok | {repeat_until_any_ok,N} | -%% repeat_until_any_fail | {repeat_until_any_fail,N} | -%% repeat_until_all_fail | {repeat_until_all_fail,N} +%% repeat_until_any_ok | {repeat_until_any_ok,N} | +%% repeat_until_any_fail | {repeat_until_any_fail,N} | +%% repeat_until_all_fail | {repeat_until_all_fail,N} %% Status = [{Ref,{{Ok,Skipped,Failed},CopiedCases}}] %% Ok = Skipped = Failed = [Case,...] %% %% Execute the TestCases under configuration Config. Config is a list %% of lists, where hd(Config) holds the config tuples for the current -%% conf case and tl(Config) is the data for the higher level conf cases. -%% Config data is "inherited" from top to nested conf cases, but +%% conf case and tl(Config) is the data for the higher level conf cases. +%% Config data is "inherited" from top to nested conf cases, but %% never the other way around. if length(Config) == 1, Config contains %% only the initial config data for the suite. %% %% Test may be one of the following: %% -%% {conf,Ref,Props,{Mod,Func}} Mod:Func is a configuration modification +%% {conf,Ref,Props,{Mod,Func}} Mod:Func is a configuration modification %% function, call it with the current configuration as argument. It will %% return a new configuration. %% -%% {make,Ref,{Mod,Func,Args}} Mod:Func is a make function, and it is called -%% with the given arguments. This function will *always* be called on the host +%% {make,Ref,{Mod,Func,Args}} Mod:Func is a make function, and it is called +%% with the given arguments. This function will *always* be called on the host %% - not on target. %% %% {Mod,Case} This is a normal test case. Determine the correct @@ -2114,16 +2180,16 @@ maybe_get_privdir() -> %% {skip_case,{conf,Ref,Case,Comment}} An init conf case gets skipped %% by the user. This will also cause the end conf case to be skipped. %% Note that it is not possible to skip an end conf case directly (it -%% can only be skipped indirectly by a skipped init conf case). The -%% comment (which gets printed in the log files) describes why the case +%% can only be skipped indirectly by a skipped init conf case). The +%% comment (which gets printed in the log files) describes why the case %% was skipped. %% -%% {skip_case,{Case,Comment}} A normal test case skipped by the user. -%% The comment (which gets printed in the log files) describes why the +%% {skip_case,{Case,Comment}} A normal test case skipped by the user. +%% The comment (which gets printed in the log files) describes why the %% case was skipped. %% %% {auto_skip_case,{conf,Ref,Case,Comment},Mode} This is the result of -%% an end conf case being automatically skipped due to a failing init +%% an end conf case being automatically skipped due to a failing init %% conf case. It could also be a nested conf case that gets skipped %% because of a failed or skipped top level conf. %% @@ -2151,25 +2217,25 @@ maybe_get_privdir() -> %% messages to the main process instead of writing the data to file %% (only true for printouts to common log files). %% -%% If a conf group nested under a parallel group in the test +%% If a conf group nested under a parallel group in the test %% specification should be started, the 'test_server_common_io_handler' %% value gets set also on the main process. This causes all printouts -%% to common files - both from parallel test cases and from cases +%% to common files - both from parallel test cases and from cases %% executed by the main process - to all end up as messages in the -%% inbox of the main process. +%% inbox of the main process. %% %% During execution of a parallel group (or of a group nested under a -%% parallel group), *any* new test case being started gets registered +%% parallel group), *any* new test case being started gets registered %% in a list saved in the dictionary with 'test_server_queued_io' as key. %% When the top level parallel group is finished (only then can we be %% sure all parallel test cases have finished and "reported in"), the -%% list of test cases is traversed in order and printout messages from -%% each process - including the main process - are handled in turn. See +%% list of test cases is traversed in order and printout messages from +%% each process - including the main process - are handled in turn. See %% handle_test_case_io_and_status/0 for details. %% %% To be able to handle nested conf groups with different properties, %% the Mode argument specifies a list of {Ref,Properties} tuples. -%% The head of the Mode list at any given time identifies the group +%% The head of the Mode list at any given time identifies the group %% currently being processed. The tail of the list identifies groups %% on higher level. %% @@ -2179,13 +2245,13 @@ maybe_get_privdir() -> %% %% A group nested under a parallel group will start executing in %% parallel with previous (parallel) test cases (no matter what -%% properties the nested group has). Test cases are however never +%% properties the nested group has). Test cases are however never %% executed in parallel with the start or end conf case of the same %% group! Because of this, the test_server_ctrl loop waits at %% the end conf of a group for all parallel cases to finish %% before the end conf case actually executes. This has the effect %% that it's only after a nested group has finished that any -%% remaining parallel cases in the previous group get spawned (*). +%% remaining parallel cases in the previous group get spawned (*). %% Example (all parallel cases): %% %% group1_init |----> @@ -2201,15 +2267,16 @@ maybe_get_privdir() -> %% run_test_cases_loop([{auto_skip_case,{Type,Ref,Case,Comment},SkipMode}|Cases], - Config, MultiplyTimetrap, Mode, Status) when Type==conf; - Type==make -> - + Config, TimetrapData, Mode, Status) when Type==conf; + Type==make -> file:set_cwd(filename:dirname(get(test_server_dir))), CurrIOHandler = get(test_server_common_io_handler), + ParentMode = tl(Mode), + %% check and update the mode for test case execution and io msg handling case {curr_ref(Mode),check_props(parallel, Mode)} of {Ref,Ref} -> - case check_props(parallel, tl(Mode)) of + case check_props(parallel, ParentMode) of false -> %% this is a skipped end conf for a top level parallel group, %% buffered io can be flushed @@ -2217,24 +2284,24 @@ run_test_cases_loop([{auto_skip_case,{Type,Ref,Case,Comment},SkipMode}|Cases], set_io_buffering(undefined), {Mod,Func} = skip_case(auto, Ref, 0, Case, Comment, false, SkipMode), test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]), - run_test_cases_loop(Cases, Config, MultiplyTimetrap, tl(Mode), + run_test_cases_loop(Cases, Config, TimetrapData, ParentMode, delete_status(Ref, Status)); _ -> - %% this is a skipped end conf for a parallel group nested under a + %% this is a skipped end conf for a parallel group nested under a %% parallel group (io buffering is active) wait_for_cases(Ref), {Mod,Func} = skip_case(auto, Ref, 0, Case, Comment, true, SkipMode), test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]), case CurrIOHandler of - {Ref,_} -> + {Ref,_} -> %% current_io_handler was set by start conf of this - %% group, so we can unset it now (no more io from main + %% group, so we can unset it now (no more io from main %% process needs to be buffered) set_io_buffering(undefined); - _ -> + _ -> ok end, - run_test_cases_loop(Cases, Config, MultiplyTimetrap, tl(Mode), + run_test_cases_loop(Cases, Config, TimetrapData, ParentMode, delete_status(Ref, Status)) end; {Ref,false} -> @@ -2242,7 +2309,31 @@ run_test_cases_loop([{auto_skip_case,{Type,Ref,Case,Comment},SkipMode}|Cases], %% nested under a parallel group {Mod,Func} = skip_case(auto, Ref, 0, Case, Comment, false, SkipMode), test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]), - run_test_cases_loop(Cases, Config, MultiplyTimetrap, tl(Mode), + + %% Check if this group is auto skipped because of error in the init conf. + %% If so, check if the parent group is a sequence, and if it is, skip + %% all proceeding tests in that group. + GrName = get_name(Mode), + Cases1 = + case get_tc_results(Status) of + {_,_,Fails} when length(Fails) > 0 -> + case lists:member({group_result,GrName}, Fails) of + true -> + case check_prop(sequence, ParentMode) of + false -> + Cases; + ParentRef -> + Reason = {group_result,GrName,failed}, + skip_cases_upto(ParentRef, Cases, + Reason, tc, Mode) + end; + false -> + Cases + end; + _ -> + Cases + end, + run_test_cases_loop(Cases1, Config, TimetrapData, ParentMode, delete_status(Ref, Status)); {Ref,_} -> %% this is a skipped end conf for a non-parallel group nested under @@ -2250,22 +2341,22 @@ run_test_cases_loop([{auto_skip_case,{Type,Ref,Case,Comment},SkipMode}|Cases], {Mod,Func} = skip_case(auto, Ref, 0, Case, Comment, true, SkipMode), test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]), case CurrIOHandler of - {Ref,_} -> + {Ref,_} -> %% current_io_handler was set by start conf of this - %% group, so we can unset it now (no more io from main + %% group, so we can unset it now (no more io from main %% process needs to be buffered) set_io_buffering(undefined); - _ -> + _ -> ok end, - run_test_cases_loop(Cases, Config, MultiplyTimetrap, tl(Mode), + run_test_cases_loop(Cases, Config, TimetrapData, tl(Mode), delete_status(Ref, Status)); {_,false} -> %% this is a skipped start conf for a group which is not nested %% under a parallel group {Mod,Func} = skip_case(auto, Ref, 0, Case, Comment, false, SkipMode), test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]), - run_test_cases_loop(Cases, Config, MultiplyTimetrap, [conf(Ref,[])|Mode], Status); + run_test_cases_loop(Cases, Config, TimetrapData, [conf(Ref,[])|Mode], Status); {_,Ref0} when is_reference(Ref0) -> %% this is a skipped start conf for a group nested under a parallel group %% and if this is the first nested group, io buffering must be activated @@ -2276,19 +2367,19 @@ run_test_cases_loop([{auto_skip_case,{Type,Ref,Case,Comment},SkipMode}|Cases], end, {Mod,Func} = skip_case(auto, Ref, 0, Case, Comment, true, SkipMode), test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]), - run_test_cases_loop(Cases, Config, MultiplyTimetrap, [conf(Ref,[])|Mode], Status) - end; + run_test_cases_loop(Cases, Config, TimetrapData, [conf(Ref,[])|Mode], Status) + end; run_test_cases_loop([{auto_skip_case,{Case,Comment},SkipMode}|Cases], - Config, MultiplyTimetrap, Mode, Status) -> + Config, TimetrapData, Mode, Status) -> {Mod,Func} = skip_case(auto, undefined, get(test_server_case_num)+1, Case, Comment, (undefined /= get(test_server_common_io_handler)), SkipMode), test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]), - run_test_cases_loop(Cases, Config, MultiplyTimetrap, Mode, + run_test_cases_loop(Cases, Config, TimetrapData, Mode, update_status(skipped, Mod, Func, Status)); run_test_cases_loop([{skip_case,{conf,Ref,Case,Comment}}|Cases0], - Config, MultiplyTimetrap, Mode, Status) -> + Config, TimetrapData, Mode, Status) -> {Mod,Func} = skip_case(user, Ref, 0, Case, Comment, (undefined /= get(test_server_common_io_handler))), {Cases,Config1} = @@ -2301,24 +2392,23 @@ run_test_cases_loop([{skip_case,{conf,Ref,Case,Comment}}|Cases0], {skip_cases_upto(Ref, Cases0, Comment, conf, Mode),Config} end, test_server_sup:framework_call(report, [tc_user_skip,{?pl2a(Mod),Func,Comment}]), - run_test_cases_loop(Cases, Config1, MultiplyTimetrap, Mode, + run_test_cases_loop(Cases, Config1, TimetrapData, Mode, update_status(skipped, Mod, Func, Status)); run_test_cases_loop([{skip_case,{Case,Comment}}|Cases], - Config, MultiplyTimetrap, Mode, Status) -> + Config, TimetrapData, Mode, Status) -> {Mod,Func} = skip_case(user, undefined, get(test_server_case_num)+1, Case, Comment, (undefined /= get(test_server_common_io_handler))), test_server_sup:framework_call(report, [tc_user_skip,{?pl2a(Mod),Func,Comment}]), - run_test_cases_loop(Cases, Config, MultiplyTimetrap, Mode, + run_test_cases_loop(Cases, Config, TimetrapData, Mode, update_status(skipped, Mod, Func, Status)); %% a start *or* end conf case, wrapping test cases or other conf cases -run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, - Config, MultiplyTimetrap, Mode0, Status) -> - +run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, + Config, TimetrapData, Mode0, Status) -> CurrIOHandler = get(test_server_common_io_handler), %% check and update the mode for test case execution and io msg handling - {StartConf,Mode,IOHandler,ConfTime,Status1} = + {StartConf,Mode,IOHandler,ConfTime,Status1} = case {curr_ref(Mode0),check_props(parallel, Mode0)} of {Ref,Ref} -> case check_props(parallel, tl(Mode0)) of @@ -2334,19 +2424,19 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, {false,tl(Mode0),undefined,Elapsed, update_status(Ref, OkSkipFail, Status)}; _ -> - %% this is an end conf for a parallel group nested under a + %% this is an end conf for a parallel group nested under a %% parallel group (io buffering is active) OkSkipFail = wait_for_cases(Ref), queue_test_case_io(Ref, self(), 0, Mod, Func), Elapsed = elapsed_time(conf_start(Ref, Mode0),?now)/1000000, case CurrIOHandler of - {Ref,_} -> + {Ref,_} -> %% current_io_handler was set by start conf of this %% group, so we can unset it after this case (no %% more io from main process needs to be buffered) {false,tl(Mode0),undefined,Elapsed, update_status(Ref, OkSkipFail, Status)}; - _ -> + _ -> {false,tl(Mode0),CurrIOHandler,Elapsed, update_status(Ref, OkSkipFail, Status)} end @@ -2362,16 +2452,16 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, queue_test_case_io(Ref, self(), 0, Mod, Func), Elapsed = elapsed_time(conf_start(Ref, Mode0),?now)/1000000, case CurrIOHandler of - {Ref,_} -> + {Ref,_} -> %% current_io_handler was set by start conf of this %% group, so we can unset it after this case (no %% more io from main process needs to be buffered) {false,tl(Mode0),undefined,Elapsed,Status}; - _ -> + _ -> {false,tl(Mode0),CurrIOHandler,Elapsed,Status} end; {_,false} -> - %% this is a start conf for a group which is not nested under a + %% this is a start conf for a group which is not nested under a %% parallel group, check if this case starts a new parallel group case lists:member(parallel, Props) of true -> @@ -2424,9 +2514,9 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, end; NumStr -> %% Ex: "123 456 789" or "123,456,789" -> {123,456,789} - list_to_tuple([list_to_integer(NS) || + list_to_tuple([list_to_integer(NS) || NS <- string:tokens(NumStr, [$ ,$:,$,])]) - end, + end, {shuffle_cases(Ref, Cs0, UseSeed),{shuffle,UseSeed}} end; not StartConf -> @@ -2440,17 +2530,19 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, if StartConf -> case get_repeat(Props) of undefined -> - %% we *must* have a status entry for every conf since we + %% we *must* have a status entry for every conf since we %% will continously update status with test case results %% without knowing the Ref (but update hd(Status)) {false,new_status(Ref, Status1),Cases1,?void_fun}; - _ -> + {_RepType,N} when N =< 1 -> + {false,new_status(Ref, Status1),Cases1,?void_fun}; + _ -> {Copied,_} = copy_cases(Ref, make_ref(), Cs1), {true,new_status(Ref, Copied, Status1),Cases1,?void_fun} end; not StartConf -> RepVal = get_repeat(get_props(Mode0)), - ReportStop = + ReportStop = fun() -> print(minor, "~n*** Stopping repeat operation ~w", [RepVal]), print(1, "Stopping repeat operation ~w", [RepVal]) @@ -2461,21 +2553,23 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, case RepVal of undefined -> {false,EndStatus,Cases1,?void_fun}; + {_RepType,N} when N =< 1 -> + {false,EndStatus,Cases1,?void_fun}; {repeat,_} -> {true,EndStatus,CopiedCases++Cases1,?void_fun}; {repeat_until_all_ok,_} -> {RestCs,Fun} = case get_tc_results(Status1) of - {_,_,[]} -> + {_,_,[]} -> {Cases1,ReportStop}; - _ -> + _ -> {CopiedCases++Cases1,?void_fun} end, {true,EndStatus,RestCs,Fun}; {repeat_until_any_ok,_} -> {RestCs,Fun} = case get_tc_results(Status1) of - {Ok,_,_} when length(Ok) > 0 -> + {Ok,_,_Fails} when length(Ok) > 0 -> {Cases1,ReportStop}; - _ -> + _ -> {CopiedCases++Cases1,?void_fun} end, {true,EndStatus,RestCs,Fun}; @@ -2483,15 +2577,15 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, {RestCs,Fun} = case get_tc_results(Status1) of {_,_,Fails} when length(Fails) > 0 -> {Cases1,ReportStop}; - _ -> + _ -> {CopiedCases++Cases1,?void_fun} end, {true,EndStatus,RestCs,Fun}; {repeat_until_all_fail,_} -> {RestCs,Fun} = case get_tc_results(Status1) of - {[],_,_} -> + {[],_,_} -> {Cases1,ReportStop}; - _ -> + _ -> {CopiedCases++Cases1,?void_fun} end, {true,EndStatus,RestCs,Fun} @@ -2517,13 +2611,13 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, [{tc_group_properties,get_props(Mode0)}, {tc_group_result,[{ok,TcOk},{skipped,TcSkip},{failed,TcFail}]}] end, - ActualCfg = + ActualCfg = update_config(hd(Config), [{priv_dir,get(test_server_priv_dir)}, {data_dir,get_data_dir(Mod)}] ++ CfgProps), CurrMode = curr_mode(Ref, Mode0, Mode), - ConfCaseResult = run_test_case(Ref, 0, Mod, Func, [ActualCfg], skip_init, target, - MultiplyTimetrap, CurrMode), + ConfCaseResult = run_test_case(Ref, 0, Mod, Func, [ActualCfg], skip_init, target, + TimetrapData, CurrMode), case ConfCaseResult of {_,NewCfg,_} when Func == init_per_suite, is_list(NewCfg) -> @@ -2533,8 +2627,8 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, [] -> set_io_buffering(IOHandler), stop_minor_log_file(), - run_test_cases_loop(Cases, [NewCfg|Config], - MultiplyTimetrap, Mode, Status2); + run_test_cases_loop(Cases, [NewCfg|Config], + TimetrapData, Mode, Status2); Bad -> print(minor, "~n*** ~p returned bad elements in Config: ~p.~n", [Func,Bad]), @@ -2542,53 +2636,55 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, Cases2 = skip_cases_upto(Ref, Cases, Reason, conf, CurrMode), set_io_buffering(IOHandler), stop_minor_log_file(), - run_test_cases_loop(Cases2, Config, MultiplyTimetrap, Mode, + run_test_cases_loop(Cases2, Config, TimetrapData, Mode, delete_status(Ref, Status2)) - end; + end; {_,NewCfg,_} when StartConf, is_list(NewCfg) -> print_conf_time(ConfTime), set_io_buffering(IOHandler), stop_minor_log_file(), - run_test_cases_loop(Cases, [NewCfg|Config], MultiplyTimetrap, Mode, Status2); + run_test_cases_loop(Cases, [NewCfg|Config], TimetrapData, Mode, Status2); {_,{framework_error,{FwMod,FwFunc},Reason},_} -> print(minor, "~n*** ~p failed in ~p. Reason: ~p~n", [FwMod,FwFunc,Reason]), print(1, "~p failed in ~p. Reason: ~p~n", [FwMod,FwFunc,Reason]), exit(framework_error); - {_,Fail,_} when element(1,Fail) == 'EXIT'; + {_,Fail,_} when element(1,Fail) == 'EXIT'; element(1,Fail) == timetrap_timeout; element(1,Fail) == failed -> - {Cases2,Config1} = + {Cases2,Config1,Status3} = if StartConf -> ReportAbortRepeat(failed), print(minor, "~n*** ~p failed.~n" " Skipping all cases.", [Func]), Reason = {failed,{Mod,Func,Fail}}, - {skip_cases_upto(Ref, Cases, Reason, conf, CurrMode),Config}; + {skip_cases_upto(Ref, Cases, Reason, conf, CurrMode), + Config, + update_status(failed, group_result, get_name(Mode), + delete_status(Ref, Status2))}; not StartConf -> ReportRepeatStop(), print_conf_time(ConfTime), - {Cases,tl(Config)} + {Cases,tl(Config),delete_status(Ref, Status2)} end, set_io_buffering(IOHandler), stop_minor_log_file(), - run_test_cases_loop(Cases2, Config1, MultiplyTimetrap, Mode, - delete_status(Ref, Status2)); + 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, MultiplyTimetrap, Mode, - delete_status(Ref, Status2)); + 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" " Skipping all cases.", [Func]), set_io_buffering(IOHandler), stop_minor_log_file(), - run_test_cases_loop(skip_cases_upto(Ref, Cases, Reason, conf, CurrMode), - Config, MultiplyTimetrap, Mode, + run_test_cases_loop(skip_cases_upto(Ref, Cases, Reason, conf, CurrMode), + Config, TimetrapData, Mode, delete_status(Ref, Status2)); {_,{skip_and_save,Reason,_SavedConfig},_} when StartConf -> ReportAbortRepeat(skipped), @@ -2596,8 +2692,8 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, " Skipping all cases.", [Func]), set_io_buffering(IOHandler), stop_minor_log_file(), - run_test_cases_loop(skip_cases_upto(Ref, Cases, Reason, conf, CurrMode), - Config, MultiplyTimetrap, Mode, + run_test_cases_loop(skip_cases_upto(Ref, Cases, Reason, conf, CurrMode), + Config, TimetrapData, Mode, delete_status(Ref, Status2)); {_,_Other,_} when Func == init_per_suite -> print(minor, "~n*** init_per_suite failed to return a Config list.~n", []), @@ -2605,61 +2701,77 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, Cases2 = skip_cases_upto(Ref, Cases, Reason, conf, CurrMode), set_io_buffering(IOHandler), stop_minor_log_file(), - run_test_cases_loop(Cases2, Config, MultiplyTimetrap, Mode, + run_test_cases_loop(Cases2, Config, TimetrapData, Mode, delete_status(Ref, Status2)); {_,_Other,_} when StartConf -> print_conf_time(ConfTime), set_io_buffering(IOHandler), ReportRepeatStop(), stop_minor_log_file(), - run_test_cases_loop(Cases, [hd(Config)|Config], MultiplyTimetrap, + run_test_cases_loop(Cases, [hd(Config)|Config], TimetrapData, Mode, Status2); - + {_,_EndConfRetVal,Opts} -> - %% check if return_group_result is set (ok, skipped or failed) and - %% if so return the value to the group "above" so that result may be - %% used for evaluating repeat_until_* - Status3 = + %% Check if return_group_result is set (ok, skipped or failed) and + %% if so: + %% 1) *If* the parent group is a sequence, skip all proceeding tests + %% in that group. + %% 2) Return the value to the group "above" so that result may be + %% used for evaluating a 'repeat_until_*' property. + GrName = get_name(Mode0, Func), + {Cases2,Status3} = case lists:keysearch(return_group_result, 1, Opts) of + {value,{_,failed}} -> + case {curr_ref(Mode),check_prop(sequence, Mode)} of + {ParentRef,ParentRef} -> + Reason = {group_result,GrName,failed}, + {skip_cases_upto(ParentRef, Cases, Reason, tc, Mode), + update_status(failed, group_result, GrName, + delete_status(Ref, Status2))}; + _ -> + {Cases,update_status(failed, group_result, GrName, + delete_status(Ref, Status2))} + end; {value,{_,GroupResult}} -> - update_status(GroupResult, group_result, Func, - delete_status(Ref, Status2)); + {Cases,update_status(GroupResult, group_result, GrName, + delete_status(Ref, Status2))}; false -> - delete_status(Ref, Status2) + {Cases,update_status(ok, group_result, GrName, + delete_status(Ref, Status2))} end, print_conf_time(ConfTime), ReportRepeatStop(), set_io_buffering(IOHandler), stop_minor_log_file(), - run_test_cases_loop(Cases, tl(Config), MultiplyTimetrap, Mode, Status3) + run_test_cases_loop(Cases2, tl(Config), TimetrapData, Mode, Status3) end; -run_test_cases_loop([{make,Ref,{Mod,Func,Args}}|Cases0], Config, MultiplyTimetrap, Mode, Status) -> - case run_test_case(Ref, 0, Mod, Func, Args, skip_init, host, MultiplyTimetrap) of +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 {_,Why={'EXIT',_},_} -> print(minor, "~n*** ~p failed.~n" " Skipping all cases.", [Func]), Reason = {failed,{Mod,Func,Why}}, Cases = skip_cases_upto(Ref, Cases0, Reason, conf, Mode), stop_minor_log_file(), - run_test_cases_loop(Cases, Config, MultiplyTimetrap, Mode, Status); + run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status); {_,_Whatever,_} -> stop_minor_log_file(), - run_test_cases_loop(Cases0, Config, MultiplyTimetrap, Mode, Status) + run_test_cases_loop(Cases0, Config, TimetrapData, Mode, Status) end; -run_test_cases_loop([{conf,_Ref,_Props,_X}=Conf|_Cases0], - Config, _MultiplyTimetrap, _Mode, _Status) -> +run_test_cases_loop([{conf,_Ref,_Props,_X}=Conf|_Cases0], + Config, _TimetrapData, _Mode, _Status) -> erlang:error(badarg, [Conf,Config]); -run_test_cases_loop([{Mod,Case}|Cases], Config, MultiplyTimetrap, Mode, Status) -> - ActualCfg = +run_test_cases_loop([{Mod,Case}|Cases], Config, TimetrapData, Mode, Status) -> + ActualCfg = update_config(hd(Config), [{priv_dir,get(test_server_priv_dir)}, {data_dir,get_data_dir(Mod)}]), run_test_cases_loop([{Mod,Case,[ActualCfg]}|Cases], Config, - MultiplyTimetrap, Mode, Status); + TimetrapData, Mode, Status); -run_test_cases_loop([{Mod,Func,Args}|Cases], Config, MultiplyTimetrap, Mode, Status) -> +run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) -> Num = put(test_server_case_num, get(test_server_case_num)+1), %% check the current execution mode and save info about the case if %% detected that printouts to common log files is handled later @@ -2669,15 +2781,15 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, MultiplyTimetrap, Mode, Sta undefined -> %% io printouts are written to straight to file ok; - _ -> + _ -> %% io messages are buffered, put test case in queue queue_test_case_io(undefined, self(), Num+1, Mod, Func) end; _ -> ok end, - case run_test_case(undefined, Num+1, Mod, Func, Args, - run_init, target, MultiplyTimetrap, Mode) of + case run_test_case(undefined, Num+1, Mod, Func, Args, + run_init, target, 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]), @@ -2688,50 +2800,50 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, MultiplyTimetrap, Mode, Sta {Time,RetVal,_} -> {Failed,Status1} = case Time of - died -> + died -> {true,update_status(failed, Mod, Func, Status)}; _ when is_tuple(RetVal) -> case element(1, RetVal) of - R when R=='EXIT'; R==failed -> + R when R=='EXIT'; R==failed -> {true,update_status(failed, Mod, Func, Status)}; - R when R==skip; R==skipped -> + R when R==skip; R==skipped -> {false,update_status(skipped, Mod, Func, Status)}; - _ -> + _ -> {false,update_status(ok, Mod, Func, Status)} end; - _ -> + _ -> {false,update_status(ok, Mod, Func, Status)} - end, + end, case check_prop(sequence, Mode) of false -> stop_minor_log_file(), - run_test_cases_loop(Cases, Config, MultiplyTimetrap, Mode, Status1); - Ref -> - %% the case is in a sequence; we must check the result and + run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status1); + Ref -> + %% the case is in a sequence; we must check the result and %% determine if the following cases should run or be skipped if not Failed -> % proceed with next case stop_minor_log_file(), - run_test_cases_loop(Cases, Config, MultiplyTimetrap, Mode, Status1); + run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status1); true -> % skip rest of cases in sequence print(minor, "~n*** ~p failed.~n" " Skipping all other cases in sequence.", [Func]), Reason = {failed,{Mod,Func}}, Cases2 = skip_cases_upto(Ref, Cases, Reason, tc, Mode), stop_minor_log_file(), - run_test_cases_loop(Cases2, Config, MultiplyTimetrap, Mode, Status1) + run_test_cases_loop(Cases2, Config, TimetrapData, Mode, Status1) end end; %% the test case is being executed in parallel with the main process (and %% other test cases) and Pid is the dedicated process executing the case Pid -> - %% io from Pid will be buffered in the main process inbox and handled + %% io from Pid will be buffered in the main process inbox and handled %% later, so we have to save info about the case queue_test_case_io(undefined, Pid, Num+1, Mod, Func), - run_test_cases_loop(Cases, Config, MultiplyTimetrap, Mode, Status) + run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status) end; %% TestSpec processing finished -run_test_cases_loop([], _Config, _MultiplyTimetrap, _, _) -> +run_test_cases_loop([], _Config, _TimetrapData, _, _) -> ok. %%-------------------------------------------------------------------- @@ -2765,7 +2877,10 @@ get_copied_cases([{_,{_,Cases}} | _Status]) -> Cases. get_tc_results([{_,{OkSkipFail,_}} | _Status]) -> - OkSkipFail. + OkSkipFail; +get_tc_results([]) -> % in case init_per_suite crashed + {[],[],[]}. + conf(Ref, Props) -> {Ref,Props,?now}. @@ -2798,12 +2913,18 @@ check_props(Attrib, Mode) -> case [R || {R,Ps,_} <- Mode, lists:member(Attrib, Ps)] of [] -> false; [Ref|_] -> Ref - end. + end. + +get_name(Mode, Def) -> + case get_name(Mode) of + undefined -> Def; + Name -> Name + end. get_name([{_Ref,Props,_}|_]) -> proplists:get_value(name, Props); get_name([]) -> - undefined. + undefined. conf_start(Ref, Mode) -> case lists:keysearch(Ref, 1, Mode) of @@ -2826,10 +2947,10 @@ print_conf_time(0) -> print_conf_time(ConfTime) -> print(major, "=group_time ~.3fs", [ConfTime]), print(minor, "~n=== Total execution time of group: ~.3fs~n", [ConfTime]). - -print_props(_, []) -> + +print_props(_, []) -> ok; -print_props(true, Props) -> +print_props(true, Props) -> print(major, "=group_props ~p", [Props]), print(minor, "Group properties: ~p~n", [Props]); print_props(_, _) -> @@ -2853,12 +2974,12 @@ update_repeat(Props) -> Props1 = if N == forever -> [{RepType,N}|lists:keydelete(RepType, 1, Props)]; - N < 2 -> + N < 3 -> lists:keydelete(RepType, 1, Props); - N >= 2 -> + N >= 3 -> [{RepType,N-1}|lists:keydelete(RepType, 1, Props)] end, - %% if shuffle is used in combination with repeat, a new + %% if shuffle is used in combination with repeat, a new %% seed shouldn't be set every new turn case get_shuffle(Props1) of undefined -> @@ -2874,13 +2995,13 @@ get_shuffle(Props) -> delete_shuffle(Props) -> delete_prop([shuffle], Props). -%% Return {Item,Value} if found, else if Item alone +%% Return {Item,Value} if found, else if Item alone %% is found, return {Item,Default} get_prop([Item|Items], Default, Props) -> case lists:keysearch(Item, 1, Props) of - {value,R} -> + {value,R} -> R; - false -> + false -> case lists:member(Item, Props) of true -> {Item,Default}; @@ -2940,8 +3061,8 @@ random_order(1, {_Pos,Seed}, [{_Ix,CaseOrGroup}], Shuffled) -> put(test_server_curr_random_seed, Seed), Shuffled++CaseOrGroup; random_order(N, {Pos,NewSeed}, IxCases, Shuffled) -> - {First,[{_Ix,CaseOrGroup}|Rest]} = lists:split(Pos-1, IxCases), - random_order(N-1, random:uniform_s(N-1, NewSeed), + {First,[{_Ix,CaseOrGroup}|Rest]} = lists:split(Pos-1, IxCases), + random_order(N-1, random:uniform_s(N-1, NewSeed), First++Rest, Shuffled++CaseOrGroup). @@ -2949,7 +3070,7 @@ random_order(N, {Pos,NewSeed}, IxCases, Shuffled) -> %% skip_case(Type, Ref, CaseNum, Case, Comment, SendSync) -> {Mod,Func} %% %% Prints info about a skipped case in the major and html log files. -%% SendSync determines if start and finished messages must be sent so +%% SendSync determines if start and finished messages must be sent so %% that the printouts can be buffered and handled in order with io from %% parallel processes. @@ -2969,13 +3090,13 @@ skip_case(Type, Ref, CaseNum, Case, Comment, SendSync, Mode) -> not SendSync -> skip_case1(Type, CaseNum, Mod, Func, Comment, Mode) end, - MF. + MF. skip_case1(Type, CaseNum, Mod, Func, Comment, Mode) -> {{Col0,Col1},_} = get_font_style((CaseNum > 0), Mode), ResultCol = if Type == auto -> "#ffcc99"; Type == user -> "#ff9933" - end, + end, Comment1 = reason_to_string(Comment), @@ -3084,7 +3205,7 @@ modify_cases_upto1(Ref, ModOp, [{skip_case,{_F,_Cmt}}=MF|T], Orig, Alt) -> %% next is a normal case (possibly in a sequence), mark as skipped, or copy, and proceed modify_cases_upto1(Ref, {skip,Reason,_,Mode}=Op, [{_M,_F}=MF|T], Orig, Alt) -> - modify_cases_upto1(Ref, Op, T, Orig, [{auto_skip_case,{MF,Reason},Mode}|Alt]); + modify_cases_upto1(Ref, Op, T, Orig, [{auto_skip_case,{MF,Reason},Mode}|Alt]); modify_cases_upto1(Ref, CopyOp, [{_M,_F}=MF|T], Orig, Alt) -> modify_cases_upto1(Ref, CopyOp, T, [MF|Orig], [MF|Alt]); @@ -3110,7 +3231,7 @@ set_io_buffering(IOHandler) -> %% queue_test_case_io(Pid, Num, Mod, Func) -> ok %% %% Save info about test case that gets its io buffered. This can -%% be a parallel test case or it can be a test case (conf or normal) +%% be a parallel test case or it can be a test case (conf or normal) %% that belongs to a group nested under a parallel group. The queue %% is processed after io buffering is disabled. See run_test_cases_loop/4 %% and handle_test_case_io_and_status/0 for more info. @@ -3124,10 +3245,10 @@ queue_test_case_io(Ref, Pid, Num, Mod, Func) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% wait_for_cases(Ref) -> {Ok,Skipped,Failed} %% -%% At the end of a nested parallel group, we have to wait for the test +%% At the end of a nested parallel group, we have to wait for the test %% cases to terminate before we can go on (since test cases never execute -%% in parallel with the end conf case of the group). When a top level -%% parallel group is finished, buffered io messages must be handled and +%% in parallel with the end conf case of the group). When a top level +%% parallel group is finished, buffered io messages must be handled and %% this is taken care of by handle_test_case_io_and_status/0. wait_for_cases(Ref) -> @@ -3135,15 +3256,15 @@ wait_for_cases(Ref) -> [] -> {[],[],[]}; Cases -> - [_Start|TCs] = + [_Start|TCs] = lists:dropwhile(fun({R,_,_,_,_}) when R == Ref -> false; (_) -> true end, Cases), wait_and_resend(Ref, TCs, [],[],[]) end. -wait_and_resend(Ref, [{OtherRef,_,0,_,_}|Ps], - Ok,Skip,Fail) when is_reference(OtherRef), +wait_and_resend(Ref, [{OtherRef,_,0,_,_}|Ps], + Ok,Skip,Fail) when is_reference(OtherRef), OtherRef /= Ref -> %% ignore cases that belong to nested group Ps1 = rm_cases_upto(OtherRef, Ps), @@ -3152,7 +3273,7 @@ wait_and_resend(Ref, [{OtherRef,_,0,_,_}|Ps], wait_and_resend(Ref, [{_,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) -> receive {finished,_Ref,CurrPid,CaseNum,Mod,Func,Result,_RetVal} = Msg -> - %% resend message to main process so that it can be used + %% resend message to main process so that it can be used %% to handle buffered io messages later self() ! Msg, MF = {Mod,Func}, @@ -3163,7 +3284,7 @@ wait_and_resend(Ref, [{_,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) -> failed -> {Ok,Skip,[MF|Fail]} end, wait_and_resend(Ref, Ps, Ok1,Skip1,Fail1); - {'EXIT',CurrPid,Reason} when Reason /= normal -> + {'EXIT',CurrPid,Reason} when Reason /= normal -> %% unexpected termination of test case process {value,{_,_,CaseNum,Mod,Func}} = lists:keysearch(CurrPid, 2, Cases), print(1, "Error! Process for test case #~p (~p:~p) died! Reason: ~p", @@ -3186,17 +3307,17 @@ rm_cases_upto(Ref, [_|Ps]) -> %% execution. The common log files (major, html etc) must however be %% written to sequentially. The test case processes send print requests %% to the main (starting) process (the same process executing -%% run_test_cases_loop/4), which handles these requests in the same +%% run_test_cases_loop/4), which handles these requests in the same %% order that the test case processes were started. %% %% An io session is always started with a {started,Ref,Pid,Num,Mod,Func} %% message and terminated with {finished,Ref,Pid,Num,Mod,Func,Result,RetVal}. %% The result shipped with the finished message from a parallel process -%% is used to update status data of the current test run. An 'EXIT' -%% message from each parallel test case process (after finishing and +%% is used to update status data of the current test run. An 'EXIT' +%% message from each parallel test case process (after finishing and %% terminating) is also received and handled here. %% -%% During execution of a parallel group, any cases (conf or normal) +%% During execution of a parallel group, any cases (conf or normal) %% belonging to a nested group will also get its io printouts buffered. %% This is necessary to get the major and html log files written in %% correct sequence. This function handles also the print messages @@ -3207,7 +3328,7 @@ rm_cases_upto(Ref, [_|Ps]) -> %% See the header comment for run_test_cases_loop/4 for more %% info about IO handling. %% -%% Note: It is important that the type of messages handled here +%% Note: It is important that the type of messages handled here %% do not get consumated by test_server:run_test_case_msgloop/5 %% during the test case execution (e.g. in the catch clause of %% the receive)! @@ -3231,7 +3352,7 @@ handle_test_case_io_and_status() -> ok end, Cases), Result - end. + end. %% Handle cases (without Ref) that belong to the top parallel group (i.e. when Refs = []) handle_io_and_exit_loop([], [{undefined,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) -> @@ -3249,7 +3370,7 @@ handle_io_and_exit_loop([], [{undefined,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, O 1000 -> exit({testcase_failed_to_start,Mod,Func}) end; - + %% Handle cases that belong to groups nested under top parallel group handle_io_and_exit_loop(Refs, [{Ref,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) -> receive @@ -3269,7 +3390,7 @@ handle_io_and_exit_loop(Refs, [{Ref,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Sk 1000 -> exit({testcase_failed_to_start,Mod,Func}) end; - + handle_io_and_exit_loop(_, [], Ok,Skip,Fail) -> {lists:reverse(Ok),lists:reverse(Skip),lists:reverse(Fail)}. @@ -3286,7 +3407,7 @@ handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) -> failed -> put(test_server_failed, get(test_server_failed)+1); skipped -> - SkipCounters = + SkipCounters = update_skip_counters(RetVal, get(test_server_skipped)), put(test_server_skipped, SkipCounters) end, @@ -3298,7 +3419,7 @@ handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) -> handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases); %% unexpected termination of test case process - {'EXIT',TCPid,Reason} when Reason /= normal -> + {'EXIT',TCPid,Reason} when Reason /= normal -> {value,{_,_,Num,M,F}} = lists:keysearch(TCPid, 2, Cases), print(1, "Error! Process for test case #~p (~p:~p) died! Reason: ~p", [Num, M, F, Reason]), @@ -3307,65 +3428,65 @@ handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% run_test_case(Ref, Num, Mod, Func, Args, RunInit, -%% Where, MultiplyTimetrap, Mode) -> RetVal +%% run_test_case(Ref, Num, Mod, Func, Args, RunInit, +%% Where, TimetrapData, Mode) -> RetVal %% %% Creates the minor log file and inserts some test case specific headers -%% and footers into the log files. If a remote target is used, the test +%% and footers into the log files. If a remote target is used, the test %% suite (binary) and the content of data_dir is sent. Then the test case -%% is executed and the result is printed to the log files (also info +%% is executed and the result is printed to the log files (also info %% about lingering processes & slave nodes in the system is presented). -%% +%% %% RunInit decides if the per test case init is to be run (true for all %% but conf cases). %% -%% Where specifies if the test case should run on target or on the host. +%% Where specifies if the test case should run on target or on the host. %% (Note that 'make' test cases always run on host). -%% +%% %% Mode specifies if the test case should be executed by a dedicated, %% parallel, process rather than sequentially by the main process. If %% the former, the new process is spawned and the dictionary of the main %% process is copied to the test case process. -%% -%% RetVal is the result of executing the test case. It contains info +%% +%% RetVal is the result of executing the test case. It contains info %% about the execution time and the return value of the test case function. -run_test_case(Ref, Num, Mod, Func, Args, RunInit, Where, MultiplyTimetrap) -> +run_test_case(Ref, Num, Mod, Func, Args, RunInit, Where, TimetrapData) -> file:set_cwd(filename:dirname(get(test_server_dir))), - run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, - MultiplyTimetrap, [], [], self()). + run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, + TimetrapData, [], [], self()). -run_test_case(Ref, Num, Mod, Func, Args, skip_init, Where, MultiplyTimetrap, Mode) -> +run_test_case(Ref, Num, Mod, Func, Args, skip_init, Where, TimetrapData, Mode) -> %% a conf case is always executed by the main process - run_test_case1(Ref, Num, Mod, Func, Args, skip_init, Where, - MultiplyTimetrap, [], Mode, self()); + run_test_case1(Ref, Num, Mod, Func, Args, skip_init, Where, + TimetrapData, [], Mode, self()); -run_test_case(Ref, Num, Mod, Func, Args, RunInit, Where, MultiplyTimetrap, Mode) -> +run_test_case(Ref, Num, Mod, Func, Args, RunInit, Where, TimetrapData, Mode) -> file:set_cwd(filename:dirname(get(test_server_dir))), case check_prop(parallel, Mode) of false -> %% this is a sequential test case - run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, - MultiplyTimetrap, [], Mode, self()); + run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, + TimetrapData, [], Mode, self()); _Ref -> %% this a parallel test case, spawn the new process Main = self(), - {dictionary,State} = process_info(self(), dictionary), + {dictionary,State} = process_info(self(), dictionary), spawn_link(fun() -> - run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, - MultiplyTimetrap, State, Mode, Main) - end) + run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, + TimetrapData, State, Mode, Main) + end) end. -run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, - MultiplyTimetrap, State, Mode, Main) -> - %% if this runs on a parallel test case process, +run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, + TimetrapData, State, Mode, Main) -> + %% if this runs on a parallel test case process, %% copy the dictionary from the main process do_if_parallel(Main, fun() -> process_flag(trap_exit, true) end, ok), CopyDict = fun() -> lists:foreach(fun({Key,Val}) -> put(Key, Val) end, State) end, do_if_parallel(Main, CopyDict, ok), do_if_parallel(Main, fun() -> put(test_server_common_io_handler, {tc,Main}) end, ok), - %% if io is being buffered, send start io session message + %% if io is being buffered, send start io session message %% (no matter if case runs on parallel or main process) case get(test_server_common_io_handler) of undefined -> ok; @@ -3373,7 +3494,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, end, TSDir = get(test_server_dir), case Where of - target -> + target -> maybe_send_beam_and_datadir(Mod); host -> ok @@ -3396,8 +3517,8 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, do_if_parallel(Main, ok, fun erlang:yield/0), %% run the test case {Result,DetectedFail,ProcsBefore,ProcsAfter} = - run_test_case_apply(Num, Mod, Func, Args, get_name(Mode), - RunInit, Where, MultiplyTimetrap), + run_test_case_apply(Num, Mod, Func, Args, get_name(Mode), + RunInit, Where, TimetrapData), {Time,RetVal,Loc,Opts,Comment} = case Result of Normal={_Time,_RetVal,_Loc,_Opts,_Comment} -> Normal; @@ -3409,7 +3530,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, print(major, "=ended ~s", [lists:flatten(timestamp_get(""))]), do_if_parallel(Main, ok, fun() -> file:set_cwd(filename:dirname(TSDir)) end), - + %% call the appropriate progress function clause to print the results to log Status = case {Time,RetVal} of @@ -3423,16 +3544,16 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, progress(skip, Num, Mod, Func, Loc, Reason, Time, Comment, Style); {_,{'EXIT',_Pid,{Skip,Reason}}} when Skip==skip; Skip==skipped -> - progress(skip, Num, Mod, Func, Loc, Reason, + progress(skip, Num, Mod, Func, Loc, Reason, Time, Comment, Style); {_,{'EXIT',_Pid,Reason}} -> - progress(failed, Num, Mod, Func, Loc, Reason, + progress(failed, Num, Mod, Func, Loc, Reason, Time, Comment, Style); {_,{'EXIT',Reason}} -> - progress(failed, Num, Mod, Func, Loc, Reason, + progress(failed, Num, Mod, Func, Loc, Reason, Time, Comment, Style); {_, {failed, Reason}} -> - progress(failed, Num, Mod, Func, Loc, Reason, + progress(failed, Num, Mod, Func, Loc, Reason, Time, Comment, Style); {_, {Skip, Reason}} when Skip==skip; Skip==skipped -> progress(skip, Num, Mod, Func, Loc, Reason, @@ -3442,7 +3563,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, [] -> progress(ok, Num, Mod, Func, Loc, RetVal, Time, Comment, Style); - + Reason -> progress(failed, Num, Mod, Func, Loc, Reason, Time, Comment, Style) @@ -3465,18 +3586,18 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, {US,AS} = get(test_server_skipped), put(test_server_skipped, {US,AS+1}) end, - %% only if test case execution is sequential do we care about the + %% only if test case execution is sequential do we care about the %% remaining processes and slave nodes count case self() of Main -> case test_server_sup:framework_call(warn, [processes], true) of true -> if ProcsBefore < ProcsAfter -> - print(minor, + print(minor, "WARNING: ~w more processes in system after test case", [ProcsAfter-ProcsBefore]); ProcsBefore > ProcsAfter -> - print(minor, + print(minor, "WARNING: ~w less processes in system after test case", [ProcsBefore-ProcsAfter]); true -> ok @@ -3487,13 +3608,13 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, case test_server_sup:framework_call(warn, [nodes], true) of true -> case catch controller_call(kill_slavenodes) of - {'EXIT',_}=Exit -> + {'EXIT',_} = Exit -> print(minor, "WARNING: There might be slavenodes left in the" " system. I tried to kill them, but I failed: ~p\n", [Exit]); [] -> ok; - List -> + List -> print(minor, "WARNING: ~w slave nodes in system after test"++ "case. Tried to killed them.~n"++ " Names:~p", @@ -3505,8 +3626,8 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, _ -> ok end, - %% if the test case was executed sequentially, this updates the execution - %% time count on the main process (adding execution time of parallel test + %% if the test case was executed sequentially, this updates the execution + %% time count on the main process (adding execution time of parallel test %% case groups is done in run_test_cases_loop/4) if is_number(Time) -> put(test_server_total_time, get(test_server_total_time)+Time); @@ -3515,7 +3636,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, end, check_new_crash_dumps(Where), - %% if io is being buffered, send finished message + %% if io is being buffered, send finished message %% (no matter if case runs on parallel or main process) case get(test_server_common_io_handler) of undefined -> ok; @@ -3528,7 +3649,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, %%-------------------------------------------------------------------- %% various help functions -%% Call If() if we're on parallel process, or +%% Call If() if we're on parallel process, or %% call Else() if we're on main process do_if_parallel(Pid, If, Else) -> case self() of @@ -3536,7 +3657,7 @@ do_if_parallel(Pid, If, Else) -> if is_function(Else) -> Else(); true -> Else end; - _ -> + _ -> if is_function(If) -> If(); true -> If end @@ -3549,13 +3670,13 @@ num2str(N) -> integer_to_list(N). %% and the content of datadir til target. maybe_send_beam_and_datadir(Mod) -> case get(test_server_ctrl_job_sock) of - undefined -> + undefined -> %% local target ok; JobSock -> %% remote target case get(test_server_downloaded_suites) of - undefined -> + undefined -> send_beam_and_datadir(Mod, JobSock), put(test_server_downloaded_suites, [Mod]); Suites -> @@ -3571,10 +3692,10 @@ maybe_send_beam_and_datadir(Mod) -> send_beam_and_datadir(Mod, JobSock) -> case code:which(Mod) of - non_existing -> + non_existing -> io:format("** WARNING: Suite ~w could not be found on host\n", [Mod]); - BeamFile -> + BeamFile -> send_beam(JobSock, Mod, BeamFile) end, DataDir = get_data_dir(Mod), @@ -3589,7 +3710,7 @@ send_beam_and_datadir(Mod, JobSock) -> 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 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. @@ -3597,7 +3718,7 @@ send_beam_and_datadir(Mod, JobSock) -> %% is to compile it. Filter = fun("Makefile") -> false; ("Makefile.src") -> false; - (Y) -> + (Y) -> case filename:extension(Y) of ".c" -> false; ObjExt -> false; @@ -3611,7 +3732,7 @@ send_beam_and_datadir(Mod, JobSock) -> Tarfile = "data_dir.tar.gz", {ok,Tar} = erl_tar:open(Tarfile, [write,compressed]), ShortDataDir = filename:basename(DataDir), - AddTarFun = + AddTarFun = fun(File) -> Long = filename:join(DataDir, File), Short = filename:join(ShortDataDir, File), @@ -3628,11 +3749,11 @@ send_beam_and_datadir(Mod, JobSock) -> send_beam(JobSock, BeamFile) -> Mod=filename:rootname(filename:basename(BeamFile), code:objfile_extension()), - send_beam(JobSock, list_to_atom(Mod), BeamFile). + 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 -> @@ -3649,25 +3770,25 @@ check_new_crash_dumps(Where) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% progress(Result, CaseNum, Mod, Func, Location, Reason, Time, +%% progress(Result, CaseNum, Mod, Func, Location, Reason, Time, %% Comment, TimeFormat) -> Result %% %% Prints the result of the test case to log file. %% Note: Strings that are to be written to the minor log must %% be prefixed with "=== " here, or the indentation will be wrong. -progress(skip, CaseNum, Mod, Func, Loc, Reason, Time, +progress(skip, CaseNum, Mod, Func, Loc, Reason, Time, Comment, {St0,St1}) -> - {Reason1,{Color,Ret}} = if_auto_skip(Reason, + {Reason1,{Color,Ret}} = if_auto_skip(Reason, fun() -> {"#ffcc99",auto_skip} end, fun() -> {"#ff9933",skip} end), print(major, "=result skipped", []), - print(1, "*** SKIPPED *** ~s", + print(1, "*** SKIPPED *** ~s", [get_info_str(Func, CaseNum, get(test_server_cases))]), test_server_sup:framework_call(report, [tc_done,{?pl2a(Mod),Func, {skipped,Reason1}}]), ReasonStr = reason_to_string(Reason1), - ReasonStr1 = lists:flatten([string:strip(S,left) || + ReasonStr1 = lists:flatten([string:strip(S,left) || S <- string:tokens(ReasonStr,[$\n])]), ReasonStr2 = if length(ReasonStr1) > 80 -> @@ -3686,10 +3807,10 @@ progress(skip, CaseNum, Mod, Func, Loc, Reason, Time, [Time,Color,ReasonStr2,Comment1]), FormatLoc = test_server_sup:format_loc(Loc), print(minor, "=== location ~s", [FormatLoc]), - print(minor, "=== reason = ~s", [ReasonStr1]), + print(minor, "=== reason = ~s", [ReasonStr1]), Ret; - -progress(failed, CaseNum, Mod, Func, Loc, timetrap_timeout, T, + +progress(failed, CaseNum, Mod, Func, Loc, timetrap_timeout, T, Comment0, {St0,St1}) -> print(major, "=result failed: timeout, ~p", [Loc]), print(1, "*** FAILED *** ~s", @@ -3699,23 +3820,23 @@ progress(failed, CaseNum, Mod, Func, Loc, timetrap_timeout, T, {failed,timetrap_timeout}}]), FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)), ErrorReason = io_lib:format("{timetrap_timeout,~s}", [FormatLastLoc]), - Comment = + Comment = case Comment0 of "" -> "<font color=\"red\">" ++ ErrorReason ++ "</font>"; - _ -> "<font color=\"red\">" ++ ErrorReason ++ "</font><br>" ++ + _ -> "<font color=\"red\">" ++ ErrorReason ++ "</font><br>" ++ to_string(Comment0) end, - print(html, + print(html, "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>" "<td><font color=\"red\">FAILED</font></td>" - "<td>~s</td></tr>\n", + "<td>~s</td></tr>\n", [T/1000,Comment]), FormatLoc = test_server_sup:format_loc(Loc), print(minor, "=== location ~s", [FormatLoc]), print(minor, "=== reason = timetrap timeout", []), failed; -progress(failed, CaseNum, Mod, Func, Loc, {testcase_aborted,Reason}, _T, +progress(failed, CaseNum, Mod, Func, Loc, {testcase_aborted,Reason}, _T, Comment0, {St0,St1}) -> print(major, "=result failed: testcase_aborted, ~p", [Loc]), print(1, "*** FAILED *** ~s", @@ -3725,23 +3846,23 @@ progress(failed, CaseNum, Mod, Func, Loc, {testcase_aborted,Reason}, _T, {failed,testcase_aborted}}]), FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)), ErrorReason = io_lib:format("{testcase_aborted,~s}", [FormatLastLoc]), - Comment = + Comment = case Comment0 of "" -> "<font color=\"red\">" ++ ErrorReason ++ "</font>"; - _ -> "<font color=\"red\">" ++ ErrorReason ++ "</font><br>" ++ + _ -> "<font color=\"red\">" ++ ErrorReason ++ "</font><br>" ++ to_string(Comment0) end, - print(html, + print(html, "<td>" ++ St0 ++ "died" ++ St1 ++ "</td>" "<td><font color=\"red\">FAILED</font></td>" - "<td>~s</td></tr>\n", + "<td>~s</td></tr>\n", [Comment]), FormatLoc = test_server_sup:format_loc(Loc), print(minor, "=== location ~s", [FormatLoc]), print(minor, "=== reason = {testcase_aborted,~p}", [Reason]), failed; -progress(failed, CaseNum, Mod, Func, unknown, Reason, Time, +progress(failed, CaseNum, Mod, Func, unknown, Reason, Time, Comment0, {St0,St1}) -> print(major, "=result failed: ~p, ~p", [Reason,unknown]), print(1, "*** FAILED *** ~s", @@ -3749,10 +3870,10 @@ progress(failed, CaseNum, Mod, Func, unknown, Reason, Time, test_server_sup:framework_call(report, [tc_done,{?pl2a(Mod),Func, {failed,Reason}}]), TimeStr = io_lib:format(if is_float(Time) -> "~.3fs"; - true -> "~w" + true -> "~w" end, [Time]), ErrorReason = lists:flatten(io_lib:format("~p", [Reason])), - ErrorReason1 = lists:flatten([string:strip(S,left) || + ErrorReason1 = lists:flatten([string:strip(S,left) || S <- string:tokens(ErrorReason,[$\n])]), ErrorReason2 = if length(ErrorReason1) > 63 -> @@ -3760,13 +3881,13 @@ progress(failed, CaseNum, Mod, Func, unknown, Reason, Time, true -> ErrorReason1 end, - Comment = + Comment = case Comment0 of "" -> "<font color=\"red\">" ++ ErrorReason2 ++ "</font>"; - _ -> "<font color=\"red\">" ++ ErrorReason2 ++ "</font><br>" ++ + _ -> "<font color=\"red\">" ++ ErrorReason2 ++ "</font><br>" ++ to_string(Comment0) end, - print(html, + print(html, "<td>" ++ St0 ++ "~s" ++ St1 ++ "</td>" "<td><font color=\"red\">FAILED</font></td>" "<td>~s</td></tr>\n", @@ -3776,7 +3897,7 @@ progress(failed, CaseNum, Mod, Func, unknown, Reason, Time, print(minor, "=== reason = "++FStr, [FormattedReason]), failed; -progress(failed, CaseNum, Mod, Func, Loc, Reason, Time, +progress(failed, CaseNum, Mod, Func, Loc, Reason, Time, Comment0, {St0,St1}) -> print(major, "=result failed: ~p, ~p", [Reason,Loc]), print(1, "*** FAILED *** ~s", @@ -3784,18 +3905,18 @@ progress(failed, CaseNum, Mod, Func, Loc, Reason, Time, test_server_sup:framework_call(report, [tc_done,{?pl2a(Mod),Func, {failed,Reason}}]), TimeStr = io_lib:format(if is_float(Time) -> "~.3fs"; - true -> "~w" + true -> "~w" end, [Time]), - Comment = + Comment = case Comment0 of "" -> ""; _ -> "<br>" ++ to_string(Comment0) end, FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)), - print(html, + print(html, "<td>" ++ St0 ++ "~s" ++ St1 ++ "</td>" "<td><font color=\"red\">FAILED</font></td>" - "<td><font color=\"red\">~s</font>~s</td></tr>\n", + "<td><font color=\"red\">~s</font>~s</td></tr>\n", [TimeStr,FormatLastLoc,Comment]), FormatLoc = test_server_sup:format_loc(Loc), print(minor, "=== location ~s", [FormatLoc]), @@ -3803,7 +3924,7 @@ progress(failed, CaseNum, Mod, Func, Loc, Reason, Time, print(minor, "=== reason = "++FStr, [FormattedReason]), failed; -progress(ok, _CaseNum, Mod, Func, _Loc, RetVal, Time, +progress(ok, _CaseNum, Mod, Func, _Loc, RetVal, Time, Comment0, {St0,St1}) -> print(minor, "successfully completed test case", []), test_server_sup:framework_call(report, [tc_done,{?pl2a(Mod),Func,ok}]), @@ -3852,9 +3973,9 @@ get_info_str(Func, 0, _Cases) -> get_info_str(_Func, CaseNum, unknown) -> "test case " ++ integer_to_list(CaseNum); get_info_str(_Func, CaseNum, Cases) -> - "test case " ++ integer_to_list(CaseNum) ++ + "test case " ++ integer_to_list(CaseNum) ++ " of " ++ integer_to_list(Cases). - + print_if_known(Known, {SK,AK}, {SU,AU}) -> {S,A} = if Known == unknown -> {SU,AU}; true -> {SK,AK} @@ -3880,7 +4001,7 @@ reason_to_string({failed,{_,FailFunc,bad_return}}) -> atom_to_list(FailFunc) ++ " bad return value"; reason_to_string({failed,{_,FailFunc,{timetrap_timeout,_}}}) -> atom_to_list(FailFunc) ++ " timed out"; -reason_to_string(FWInitFail = {failed,{_CB,init_tc,_Reason}}) -> +reason_to_string(FWInitFail = {failed,{_CB,init_tc,_Reason}}) -> to_string(FWInitFail); reason_to_string({failed,{_,FailFunc,_}}) -> atom_to_list(FailFunc) ++ " failed"; @@ -3889,29 +4010,29 @@ reason_to_string(Other) -> %get_font_style(Prop) -> % {Col,St0,St1} = get_font_style1(Prop), -% {{"<font color="++Col++">","</font>"}, +% {{"<font color="++Col++">","</font>"}, % {"<font color="++Col++">"++St0,St1++"</font>"}}. - + get_font_style(NormalCase, Mode) -> - Prop = if not NormalCase -> + Prop = if not NormalCase -> default; true -> case check_prop(parallel, Mode) of - false -> + false -> case check_prop(sequence, Mode) of - false -> + false -> default; - _ -> + _ -> sequence end; - _ -> + _ -> parallel end end, {Col,St0,St1} = get_font_style1(Prop), - {{"<font color="++Col++">","</font>"}, + {{"<font color="++Col++">","</font>"}, {"<font color="++Col++">"++St0,St1++"</font>"}}. - + get_font_style1(parallel) -> {"\"darkslategray\"","<i>","</i>"}; get_font_style1(sequence) -> @@ -3931,7 +4052,7 @@ get_font_style1(default) -> %% The framework application can switch this feature off by setting %% *its* application environment variable 'format_exception' to false. %% It is also possible to switch formatting off by starting the -%% test_server node with init argument 'test_server_format_exception' +%% test_server node with init argument 'test_server_format_exception' %% set to false. format_exception(Reason={_Error,Stack}) when is_list(Stack) -> @@ -3950,17 +4071,17 @@ format_exception(Reason={_Error,Stack}) when is_list(Stack) -> _ -> do_format_exception(Reason) end - end; + end; format_exception(Error) -> format_exception({Error,[]}). do_format_exception(Reason={Error,Stack}) -> StackFun = fun(_, _, _) -> false end, - PF = fun(Term, I) -> - io_lib:format("~." ++ integer_to_list(I) ++ "p", [Term]) + PF = fun(Term, I) -> + io_lib:format("~." ++ integer_to_list(I) ++ "p", [Term]) end, case catch lib:format_exception(1, error, Error, Stack, StackFun, PF) of - {'EXIT',_} -> + {'EXIT',_} -> {"~p",Reason}; Formatted -> Formatted1 = re:replace(Formatted, "exception error: ", "", [{return,list}]), @@ -3969,8 +4090,8 @@ do_format_exception(Reason={Error,Stack}) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, -%% Where, MultiplyTimetrap) -> +%% run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, +%% Where, TimetrapData) -> %% {{Time,RetVal,Loc,Opts,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} | %% {{died,Reason,unknown,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} %% Name = atom() @@ -3984,24 +4105,24 @@ do_format_exception(Reason={Error,Stack}) -> %% ProcessesBefore = ProcessesAfter = integer() %% %% Where indicates if the test should run on target or always on the host. -%% -%% If test is to be run on target, and target is remote the request is +%% +%% If test is to be run on target, and target is remote the request is %% sent over socket to target, and test_server runs the case and sends the %% result back over the socket. Else test_server runs the case directly on host. -run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, host, MultiplyTimetrap) -> +run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, host, TimetrapData) -> test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit, - MultiplyTimetrap}); -run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, target, MultiplyTimetrap) -> + 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, - MultiplyTimetrap}); + TimetrapData}); JobSock -> %% remote target request(JobSock, {test_case,{CaseNum,Mod,Func,Args,Name,RunInit, - MultiplyTimetrap}}), + TimetrapData}}), read_job_sock_loop(JobSock) end. @@ -4012,15 +4133,15 @@ run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, target, MultiplyTim %% Args = [term()] %% %% Just like io:format, except that depending on the Detail value, the output -%% is directed to console, major and/or minor log files. +%% is directed to console, major and/or minor log files. %% %% To handle printouts to common (not minor) log files from parallel test %% case processes, the test_server_common_io_handler value is checked. If %% set, the data is sent to the main controlling process. Note that test %% cases that belong to a conf group nested under a parallel group will also %% get its io data sent to main rather than immediately printed out, even -%% if the test cases are executed by the same, main, process (ie the main -%% process sends messages to itself then). +%% if the test cases are executed by the same, main, process (ie the main +%% process sends messages to itself then). %% %% Buffered io is handled by the handle_test_case_io_and_status/0 function. @@ -4040,21 +4161,21 @@ print_or_buffer(Detail, Msg, Printer) -> output({Detail,Msg}, Printer); MinLevel when is_number(Detail), Detail >= MinLevel -> output({Detail,Msg}, Printer); - _ -> % Detail < Minor | major | html + _ -> % Detail < Minor | major | html case get(test_server_common_io_handler) of - undefined -> + undefined -> output({Detail,Msg}, Printer); {_,MainPid} -> MainPid ! {print,self(),Detail,Msg} end - end. + end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% print_timestamp(Detail, Leader) -> ok %% %% Prints Leader followed by a time stamp (date and time). Depending on %% the Detail value, the output is directed to console, major and/or minor -%% log files. +%% log files. print_timestamp(Detail, Leader) -> print(Detail, timestamp_get(Leader), []). @@ -4288,7 +4409,7 @@ update_config(Config, []) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% collect_cases(CurMod, TopCase, SkipList) -> +%% collect_cases(CurMod, TopCase, SkipList) -> %% BasicCaseList | {error,Reason} %% %% CurMod = atom() @@ -4319,18 +4440,18 @@ update_config(Config, []) -> %% are listed, and each Module:all(suite) is called %% {dir,Dir,Pattern} All modules <Pattern>_SUITE in the named dir %% are listed, and each Module:all(suite) is called -%% {conf,InitMF,Cases,FinMF} -%% {conf,Props,InitMF,Cases,FinMF} +%% {conf,InitMF,Cases,FinMF} +%% {conf,Props,InitMF,Cases,FinMF} %% InitMF is placed in the BasicCaseList, then %% Cases is treated according to this table, then %% FinMF is placed in the BasicCaseList. InitMF %% and FinMF are configuration manipulation %% functions. See below. -%% {make,InitMFA,Cases,FinMFA} +%% {make,InitMFA,Cases,FinMFA} %% InitMFA is placed in the BasicCaseList, then %% Cases is treated according to this table, then %% FinMFA is placed in the BasicCaseList. InitMFA -%% and FinMFA are make/unmake functions. If InitMFA +%% and FinMFA are make/unmake functions. If InitMFA %% fails, Cases are not run. InitMFA and FinMFA are %% always run on the host - not on target. %% @@ -4339,7 +4460,7 @@ update_config(Config, []) -> %% %% [] Leaf case %% {req,ReqList} Kept for backwards compatibility - same as [] -%% {req,ReqList,Cases} Kept for backwards compatibility - +%% {req,ReqList,Cases} Kept for backwards compatibility - %% Cases parsed recursively with collect_cases/3 %% Cases (list) Recursively parsed with collect_cases/3 %% @@ -4351,7 +4472,7 @@ update_config(Config, []) -> %% Configuration manipulation functions are called with the current %% configuration list as only argument, and are expected to return a new %% configuration list. Such a pair of function may, for example, start a -%% server and stop it after a serie of test cases. +%% server and stop it after a serie of test cases. %% %% SkipCases is expected to be in the format: %% @@ -4364,10 +4485,10 @@ update_config(Config, []) -> skip}). % skip list collect_all_cases(Top, Skip) when is_list(Skip) -> - Result = + Result = case collect_cases(Top, #cc{mod=[],skip=Skip}) of {ok,Cases,_St} -> Cases; - Other -> Other + Other -> Other end, Result. @@ -4379,12 +4500,12 @@ collect_cases([Case|Cs0], St0) -> case collect_cases(Cs0, St1) of {ok,FlatCases2,St} -> {ok,FlatCases1 ++ FlatCases2,St}; - {error,_Reason}=Error -> Error + {error,_Reason} = Error -> Error end; - {error,_Reason}=Error -> Error + {error,_Reason} = Error -> Error end; - + collect_cases({module,Case}, St) when is_atom(Case), is_atom(St#cc.mod) -> collect_case({St#cc.mod,Case}, St); collect_cases({module,Mod,Case}, St) -> @@ -4404,38 +4525,71 @@ collect_cases({conf,InitMF,CaseList,FinF}, St) when is_atom(FinF) -> collect_cases({conf,InitMF,CaseList,FinMF}, St0) -> collect_cases({conf,[],InitMF,CaseList,FinMF}, St0); collect_cases({conf,Props,InitF,CaseList,FinMF}, St) when is_atom(InitF) -> - collect_cases({conf,Props,{St#cc.mod,InitF},CaseList,FinMF}, St); + case init_props(Props) of + {error,_} -> + {ok,[],St}; + Props1 -> + collect_cases({conf,Props1,{St#cc.mod,InitF},CaseList,FinMF}, St) + end; collect_cases({conf,Props,InitMF,CaseList,FinF}, St) when is_atom(FinF) -> - collect_cases({conf,Props,InitMF,CaseList,{St#cc.mod,FinF}}, St); -collect_cases({conf,Props,InitMF,CaseList,FinMF}, St0) -> - case collect_cases(CaseList, St0) of - {ok,[],_St}=Empty -> - Empty; - {ok,FlatCases,St} -> + case init_props(Props) of + {error,_} -> + {ok,[],St}; + Props1 -> + collect_cases({conf,Props1,InitMF,CaseList,{St#cc.mod,FinF}}, St) + end; +collect_cases({conf,Props,InitMF,CaseList,FinMF} = Conf, St) -> + case init_props(Props) of + {error,_} -> + {ok,[],St}; + Props1 -> Ref = make_ref(), - case in_skip_list(InitMF, St#cc.skip) of - {true,Comment} -> - {ok,[{skip_case,{conf,Ref,InitMF,Comment}} | - FlatCases ++ [{conf,Ref,[],FinMF}]],St}; + Skips = St#cc.skip, + case in_skip_list({St#cc.mod,Conf}, Skips) of + {true,Comment} -> % conf init skipped + {ok,[{skip_case,{conf,Ref,InitMF,Comment}} | + [] ++ [{conf,Ref,[],FinMF}]],St}; + {true,Name,Comment} when is_atom(Name) -> % all cases skipped + {ok,[{skip_case,{{St#cc.mod,{group,Name}},Comment}}],St}; + {true,ToSkip,_} when is_list(ToSkip) -> % some cases skipped + case collect_cases(CaseList, + St#cc{skip=ToSkip++Skips}) of + {ok,[],_St} = Empty -> + Empty; + {ok,FlatCases,St1} -> + {ok,[{conf,Ref,Props1,InitMF} | + FlatCases ++ [{conf,Ref, + keep_name(Props1), + FinMF}]],St1#cc{skip=Skips}}; + {error,_Reason} = Error -> + Error + end; false -> - {ok,[{conf,Ref,Props,InitMF} | - FlatCases ++ [{conf,Ref,keep_name(Props),FinMF}]],St} - end; - {error,_Reason}=Error -> - Error + case collect_cases(CaseList, St) of + {ok,[],_St} = Empty -> + Empty; + {ok,FlatCases,St1} -> + {ok,[{conf,Ref,Props1,InitMF} | + FlatCases ++ [{conf,Ref, + keep_name(Props1), + FinMF}]],St1}; + {error,_Reason} = Error -> + Error + end + end end; collect_cases({make,InitMFA,CaseList,FinMFA}, St0) -> case collect_cases(CaseList, St0) of - {ok,[],_St}=Empty -> Empty; + {ok,[],_St} = Empty -> Empty; {ok,FlatCases,St} -> Ref = make_ref(), - {ok,[{make,Ref,InitMFA}|FlatCases ++ + {ok,[{make,Ref,InitMFA}|FlatCases ++ [{make,Ref,FinMFA}]],St}; - {error,_Reason}=Error -> Error + {error,_Reason} = Error -> Error end; -collect_cases({Module, Cases}, St) when is_list(Cases) -> +collect_cases({Module, Cases}, St) when is_list(Cases) -> case (catch collect_case(Cases, St#cc{mod=Module}, [])) of {ok, NewCases, NewSt} -> {ok, NewCases, NewSt}; @@ -4450,8 +4604,11 @@ collect_cases({_Mod,_Case,_Args}=Spec, St) -> collect_case(Spec, St); collect_cases(Case, St) when is_atom(Case), is_atom(St#cc.mod) -> collect_case({St#cc.mod,Case}, St); -collect_cases(Other, _St) -> - {error,{bad_subtest_spec,Other}}. +collect_cases(Other, St) -> + {error,{bad_subtest_spec,St#cc.mod,Other}}. + +collect_case({Mod,{conf,_,_,_,_}=Conf}, St) -> + collect_case_invoke(Mod, Conf, [], St); collect_case(MFA, St) -> case in_skip_list(MFA, St#cc.skip) of @@ -4475,9 +4632,9 @@ collect_case_invoke(Mod, Case, MFA, St) -> case os:getenv("TEST_SERVER_FRAMEWORK") of false -> case catch apply(Mod, Case, [suite]) of - {'EXIT',_} -> + {'EXIT',_} -> {ok,[MFA],St}; - Suite -> + Suite -> collect_subcases(Mod, Case, MFA, St, Suite) end; _ -> @@ -4485,9 +4642,10 @@ collect_case_invoke(Mod, Case, MFA, St) -> collect_subcases(Mod, Case, MFA, St, Suite) end. -collect_subcases(Mod, Case, MFA, St, Suite) -> +collect_subcases(Mod, Case, MFA, St, Suite) -> case Suite of [] when Case == all -> {ok,[],St}; + [] when element(1, Case) == conf -> {ok,[],St}; [] -> {ok,[MFA],St}; %%%! --- START Kept for backwards compatibilty --- %%%! Requirements are not used @@ -4498,6 +4656,8 @@ collect_subcases(Mod, Case, MFA, St, Suite) -> %%%! --- END Kept for backwards compatibilty --- {Skip,Reason} when Skip==skip; Skip==skipped -> {ok,[{skip_case,{MFA,Reason}}],St}; + {error,Reason} -> + throw(Reason); SubCases -> collect_case_subcases(Mod, Case, SubCases, St) end. @@ -4536,7 +4696,7 @@ collect_case_deny(Mod, Case, MFA, ReqList, SubCases, St) -> {granted,SubCases} -> collect_case_subcases(Mod, Case, SubCases, St) end. - + check_deny([Req|Reqs], DenyList) -> case check_deny_req(Req, DenyList) of {denied,_Comment}=Denied -> Denied; @@ -4559,8 +4719,49 @@ check_deny_req(Req, DenyList) -> false -> granted end. +in_skip_list({Mod,{conf,Props,InitMF,_CaseList,_FinMF}}, SkipList) -> + case in_skip_list(InitMF, SkipList) of + {true,_} = Yes -> + Yes; + _ -> + case proplists:get_value(name, Props) of + undefined -> + false; + Name -> + ToSkip = + lists:flatmap( + fun({M,{conf,SProps,_,SCaseList,_},Cmt}) when + M == Mod -> + case proplists:get_value(name, SProps) of + all -> + [{M,all,Cmt}]; + Name -> + case SCaseList of + all -> + [{M,all,Cmt}]; + _ -> + [{M,F,Cmt} || F <- SCaseList] + end; + _ -> + [] + end; + (_) -> + [] + end, SkipList), + case ToSkip of + [] -> + false; + _ -> + case lists:keysearch(all, 2, ToSkip) of + {value,{_,_,Cmt}} -> {true,Name,Cmt}; + _ -> {true,ToSkip,""} + end + end + end + end; + in_skip_list({Mod,Func,_Args}, SkipList) -> - in_skip_list({Mod,Func}, SkipList); + in_skip_list({Mod,Func}, SkipList); in_skip_list({Mod,Func}, [{Mod,Funcs,Comment}|SkipList]) when is_list(Funcs) -> case lists:member(Func, Funcs) of true -> @@ -4577,9 +4778,21 @@ in_skip_list({Mod,Func}, [_|SkipList]) -> in_skip_list(_, []) -> false. +%% remove unnecessary properties +init_props(Props) -> + case get_repeat(Props) of + Repeat = {_RepType,N} when N < 2 -> + if N == 0 -> + {error,{invalid_property,Repeat}}; + true -> + lists:delete(Repeat, Props) + end; + _ -> + Props + end. + keep_name(Props) -> lists:filter(fun({name,_}) -> true; (_) -> false end, Props). - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Target node handling functions %% @@ -4615,13 +4828,13 @@ start_node(Name, Type, Options) -> end, case Warning of [] -> ok; - _ -> + _ -> format(1, Warning), format(minor, Warning) end, {ok, Nodename}; {fail,{Ret, Host, Cmd}} -> - format(minor, + format(minor, "Failed to start node ~p on ~p with command: ~p~n" "Reason: ~p", [Name, Host, Cmd, Ret]), @@ -4630,7 +4843,7 @@ start_node(Name, Type, Options) -> format(minor, "Failed to start node ~p: ~p", [Name,Ret]), Ret; {Ret, Host, Cmd} -> - format(minor, + format(minor, "Failed to start node ~p on ~p with command: ~p~n" "Reason: ~p", [Name, Host, Cmd, Ret]), @@ -4685,7 +4898,7 @@ read_job_sock_loop(Sock) -> exit({controller,connection_lost,Reason}); {ok,<<1,Request/binary>>} -> case decode(binary_to_term(Request)) of - ok -> + ok -> read_job_sock_loop(Sock); {stop,Result} -> Result @@ -4695,14 +4908,14 @@ read_job_sock_loop(Sock) -> decode({apply,{M,F,A}}) -> apply(M,F,A), ok; -decode({sync_apply,{M,F,A}}) -> +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}; + {stop,Result}; decode({privdir,empty_priv_dir}) -> {stop,ok}; decode({{privdir,PrivDirTar},TarBin}) -> @@ -4742,7 +4955,7 @@ p({A,B,C}) -> p(X) -> pinfo(X). -t() -> +t() -> t(wall_clock). t(X) -> element(1, statistics(X)). @@ -4781,7 +4994,7 @@ display_info([Pid|T], R, M) -> Other -> Other end, - Reds = fetch(reductions, Info), + Reds = fetch(reductions, Info), LM = length(fetch(messages, Info)), pformat(io_lib:format("~w", [Pid]), io_lib:format("~w", [Call]), @@ -4822,12 +5035,12 @@ pinfo(P) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% A module is included in the cover analysis if -%% - it belongs to the tested application and is not listed in the +%% - it belongs to the tested application and is not listed in the %% {exclude,List} part of the App.cover file %% - it does not belong to the application, but is listed in the %% {include,List} part of the App.cover file -%% - it does not belong to the application, but is listed in the -%% cross.cover file (in the test_server application) under 'all' +%% - it does not belong to the application, but is listed in the +%% cross.cover file (in the test_server application) under 'all' %% or under the tested application. %% %% The modules listed in the cross.cover file are modules that are @@ -4893,7 +5106,7 @@ read_cover_file(CoverFile) -> io:fwrite("Faulty format of CoverFile ~p\n", [CoverFile]), {[],[]} end; - {error,Reason} -> + {error,Reason} -> io:fwrite("Can't read CoverFile ~p\nReason: ~p\n", [CoverFile,Reason]), {[],[]} @@ -4958,7 +5171,7 @@ cover_analyse({App,CoverInfo}, Analyse, AnalyseMods, TestDir) -> end, io:fwrite(CoverLog, "<p>Excluded module(s): <code>~p</code>\n", [Excluded]), - + Coverage = cover_analyse(Analyse, AnalyseMods), case lists:filter(fun({_M,{_,_,_}}) -> false; @@ -4968,7 +5181,7 @@ cover_analyse({App,CoverInfo}, Analyse, AnalyseMods, TestDir) -> ok; Bad -> io:fwrite(CoverLog, "<p>Analysis failed for ~w module(s): " - "<code>~w</code>\n", + "<code>~w</code>\n", [length(Bad),[BadM || {BadM,{_,_Why}} <- Bad]]) end, @@ -5002,10 +5215,10 @@ cross_cover_analyse(Analyse, CrossModules) -> CoverdataFiles = get_coverdata_files(), lists:foreach(fun(CDF) -> cover:import(CDF) end, CoverdataFiles), io:fwrite("Cover analysing... ", []), - DetailsFun = + DetailsFun = case Analyse of details -> - fun(Dir,M) -> + fun(Dir,M) -> OutFile = filename:join(Dir, atom_to_list(M) ++ ".CROSS_COVER.html"), @@ -5018,7 +5231,7 @@ cross_cover_analyse(Analyse, CrossModules) -> SortedModules = case CrossModules of undefined -> - sort_modules([Mod || Mod <- get_all_cross_modules(), + sort_modules([Mod || Mod <- get_all_cross_modules(), lists:member(Mod, cover:imported_modules())], []); _ -> sort_modules(CrossModules, []) @@ -5031,7 +5244,7 @@ cross_cover_analyse(Analyse, CrossModules) -> %% 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 -> + false -> ok; Dir -> CoverLogName = filename:join(Dir,?cross_coverlog_name), @@ -5045,13 +5258,13 @@ write_cross_cover_logs([{App,Coverage}|T]) -> end, write_cross_cover_logs(T); write_cross_cover_logs([]) -> - io:fwrite("done\n", []). + 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) || + PossibleFiles = [last_coverdata_file(Dir) || Dir <- filelib:wildcard([$*|?logdir_ext]), filelib:is_dir(Dir)], [File || File <- PossibleFiles, filelib:is_file(File)]. @@ -5074,12 +5287,12 @@ last_test([_|Rest], Latest) -> last_test(Rest, Latest); last_test([], Latest) -> Latest. - + %% Sort modules according to the application they belong to. %% Return [{App,LastTestDir,ModuleList}] sort_modules([M|Modules], Acc) -> App = get_app(M), - Acc1 = + Acc1 = case lists:keysearch(App, 1, Acc) of {value,{App,LastTest,List}} -> lists:keyreplace(App, 1, Acc, {App,LastTest,[M|List]}); @@ -5120,9 +5333,9 @@ get_all_cross_modules() -> get_cross_modules(all). get_cross_modules(App) -> case file:consult(?cross_cover_file) of - {ok,List} -> + {ok,List} -> get_cross_modules(App, List, []); - _X -> + _X -> [] end. @@ -5134,11 +5347,11 @@ get_cross_modules(App, [_H|T], Acc) -> get_cross_modules(App, T, Acc); get_cross_modules(_App, [], Acc) -> Acc. - + %% Support functions for writing the cover logs (both cross and normal) write_coverlog_header(CoverLog) -> - case catch + case catch io:fwrite(CoverLog, "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" "<!-- autogenerated by '~w'. -->\n" @@ -5162,13 +5375,13 @@ format_analyse(M,Cov,NotCov,undefined) -> io_lib:fwrite("<tr><td>~w</td>" "<td align=right>~w %</td>" "<td align=right>~w</td>" - "<td align=right>~w</td></tr>\n", + "<td align=right>~w</td></tr>\n", [M,pc(Cov,NotCov),Cov,NotCov]); format_analyse(M,Cov,NotCov,{file,File}) -> io_lib:fwrite("<tr><td><a href=\"~s\">~w</a></td>" "<td align=right>~w %</td>" "<td align=right>~w</td>" - "<td align=right>~w</td></tr>\n", + "<td align=right>~w</td></tr>\n", [filename:basename(File),M,pc(Cov,NotCov),Cov,NotCov]); format_analyse(M,Cov,NotCov,{lines,Lines}) -> CoverOutName = atom_to_list(M)++".COVER.html", @@ -5177,15 +5390,15 @@ format_analyse(M,Cov,NotCov,{lines,Lines}) -> io_lib:fwrite("<tr><td><a href=\"~s\">~w</a></td>" "<td align=right>~w %</td>" "<td align=right>~w</td>" - "<td align=right>~w</td></tr>\n", + "<td align=right>~w</td></tr>\n", [CoverOutName,M,pc(Cov,NotCov),Cov,NotCov]); format_analyse(M,Cov,NotCov,{error,_}) -> io_lib:fwrite("<tr><td>~w</td>" "<td align=right>~w %</td>" "<td align=right>~w</td>" - "<td align=right>~w</td></tr>\n", + "<td align=right>~w</td></tr>\n", [M,pc(Cov,NotCov),Cov,NotCov]). - + pc(0,0) -> 0; @@ -5200,9 +5413,9 @@ write_not_covered(CoverOut,M,Lines) -> "<table border=3 cellpadding=5>\n" "<th>Line Number</th>\n", [M]), - lists:foreach(fun({{_M,Line},{0,1}}) -> + lists:foreach(fun({{_M,Line},{0,1}}) -> io:fwrite(CoverOut,"<tr><td>~w</td></tr>\n", [Line]); - (_) -> + (_) -> ok end, Lines), @@ -5216,7 +5429,7 @@ write_default_coverlog(TestDir) -> file:close(CoverLog). write_default_cross_coverlog(TestDir) -> - {ok,CrossCoverLog} = + {ok,CrossCoverLog} = file:open(filename:join(TestDir,?cross_coverlog_name), [write]), write_coverlog_header(CrossCoverLog), io:fwrite(CrossCoverLog, @@ -5232,7 +5445,7 @@ write_cover_result_table(CoverLog,Coverage) -> "<th>Not covered (Lines)</th>\n", []), {TotCov,TotNotCov} = - lists:foldl(fun({M,{Cov,NotCov,Details}},{AccCov,AccNotCov}) -> + lists:foldl(fun({M,{Cov,NotCov,Details}},{AccCov,AccNotCov}) -> Str = format_analyse(M,Cov,NotCov,Details), io:fwrite(CoverLog,"~s", [Str]), {AccCov+Cov,AccNotCov+NotCov}; diff --git a/lib/test_server/src/test_server_internal.hrl b/lib/test_server/src/test_server_internal.hrl index 6fa5ef75b1..c9c52854e3 100644 --- a/lib/test_server/src/test_server_internal.hrl +++ b/lib/test_server/src/test_server_internal.hrl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -37,7 +37,7 @@ username, % string() cookie, % string(); Cookie for target node naming, % string(); "-name" | "-sname" - master, % string(); For OSE this is the master + master, % string(); Was used for OSE's master % node for main target and slave nodes. % For other platforms the target node % itself is master for slave nodes diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl index ddc89d50d4..49025b1a3d 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/test_server/src/test_server_node.erl @@ -1,31 +1,29 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(test_server_node). --compile(r11). +-compile(r12). %%% %%% The same compiled code for this module must be possible to load -%%% in R11B, R12B and later. To make that possible no bit syntax -%%% must be used. +%%% in R12B and later. %%% - %% Test Controller interface -export([is_release_available/1]). -export([start_remote_main_target/1,stop/1]). diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 89edb0f881..625724fbb5 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -21,7 +21,7 @@ %%% Purpose: Test server support functions. %%%------------------------------------------------------------------- -module(test_server_sup). --export([timetrap/2, timetrap_cancel/1, capture_get/1, messages_get/1, +-export([timetrap/2, timetrap/3, timetrap_cancel/1, capture_get/1, messages_get/1, timecall/3, call_crash/5, app_test/2, check_new_crash_dumps/0, cleanup_crash_dumps/0, crash_dump_dir/0, tar_crash_dumps/0, get_username/0, get_os_family/0, @@ -34,16 +34,23 @@ -define(src_listing_ext, ".src.html"). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% timetrap(Timeout,Pid) -> Handle +%% timetrap(Timeout,Scale,Pid) -> Handle %% Handle = term() %% %% Creates a time trap, that will kill the given process if the %% trap is not cancelled with timetrap_cancel/1, within Timeout %% milliseconds. +%% Scale says if the time should be scaled up to compensate for +%% delays during the test (e.g. if cover is running). timetrap(Timeout0, Pid) -> + timetrap(Timeout0, true, Pid). + +timetrap(Timeout0, Scale, Pid) -> process_flag(priority, max), - Timeout = test_server:timetrap_scale_factor() * Timeout0, + Timeout = if not Scale -> Timeout0; + true -> test_server:timetrap_scale_factor() * Timeout0 + end, receive after trunc(Timeout) -> Line = test_server:get_loc(Pid), @@ -497,6 +504,7 @@ 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, try apply(Mod,Func,Args) of Result -> diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index 1b750c3858..fcd955345f 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/test_server/src/ts.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -71,7 +71,7 @@ %%% ts_erl_config Finds out information about the Erlang system, %%% for instance the location of erl_interface. %%% This works for either an installed OTP or an Erlang -%%% system running from Clearcase. +%%% system running in a git repository/source tree. %%% ts_make Interface to run the `make' program on Unix %%% and other platforms. %%% ts_make_erl A corrected version of the standar Erlang module @@ -112,7 +112,7 @@ " Mandatory for remote targets\n" " {master, {MasterHost, MasterCookie}}\n" " - Master host and cookie for targets which are\n" - " started as slave nodes (i.e. OSE/Delta targets\n" + " started as slave nodes.\n" " erl_boot_server must be started on master before\n" " test is run.\n" " Optional, default is controller host and then\n" diff --git a/lib/test_server/src/ts_erl_config.erl b/lib/test_server/src/ts_erl_config.erl index 4fc46fc5d6..640c8ddc9f 100644 --- a/lib/test_server/src/ts_erl_config.erl +++ b/lib/test_server/src/ts_erl_config.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -70,18 +70,18 @@ dl_vars(Vars, _) -> ShlibRules = ts_lib:subst(ShlibRules0, Vars), [{'SHLIB_RULES', ShlibRules}|Vars]. -erts_lib_name(multi_threaded, win32) -> +erts_lib_name(multi_threaded, {win32, V}) -> link_library("erts_MD" ++ case is_debug_build() of true -> "d"; false -> "" end, - win32); -erts_lib_name(single_threaded, win32) -> + {win32, V}); +erts_lib_name(single_threaded, {win32, V}) -> link_library("erts_ML" ++ case is_debug_build() of true -> "d"; false -> "" end, - win32); + {win32, V}); erts_lib_name(multi_threaded, OsType) -> link_library("erts_r", OsType); erts_lib_name(single_threaded, OsType) -> @@ -107,7 +107,7 @@ erts_lib(Vars,OsType) -> ErtsIncludeInternal, ErtsLib, ErtsLibInternal}; - {Type, Root, Target} when Type == clearcase; Type == srctree -> + {srctree, Root, Target} -> Erts = filename:join([Root, "erts"]), ErtsInclude = filename:join([Erts, "include"]), ErtsIncludeTarget = filename:join([ErtsInclude, Target]), @@ -146,7 +146,7 @@ erl_include(Vars) -> case erl_root(Vars) of {installed, Root} -> filename:join([Root, "usr", "include"]); - {Type, Root, Target} when Type == clearcase; Type == srctree -> + {srctree, Root, Target} -> filename:join([Root, "erts", "emulator", "beam"]) ++ " -I" ++ filename:join([Root, "erts", "emulator"]) ++ system_include(Root, Vars) @@ -161,7 +161,6 @@ system_include(Root, Vars) -> case ts_lib:var(os, Vars) of "Windows" ++ _T -> "sys/win32"; "VxWorks" -> "sys.vxworks"; - "OSE" -> "sys/ose"; _ -> "sys/unix" end, " -I" ++ filename:nativename(filename:join([Root, "erts", "emulator", SysDir])). @@ -180,7 +179,7 @@ erl_interface(Vars,OsType) -> {srctree, _Root, _Target} when OsType =:= vxworks -> {filename:join(Dir, "lib"), filename:join([Dir, "src"])}; - {Type, _Root, Target} when Type == clearcase; Type == srctree -> + {srctree, _Root, Target} -> {filename:join([Dir, "obj", Target]), filename:join([Dir, "src", Target])} end} @@ -219,7 +218,7 @@ erl_interface(Vars,OsType) -> {unix,_} -> "-lpthread"; _ -> - "" % VxWorks or OSE + "" % VxWorks end, CrossCompile = case OsType of vxworks -> "true"; @@ -247,7 +246,7 @@ ic(Vars, OsType) -> case erl_root(Vars) of {installed, _Root} -> filename:join([Dir, "priv", "lib"]); - {Type, _Root, Target} when Type == clearcase; Type == srctree -> + {srctree, _Root, Target} -> filename:join([Dir, "priv", "lib", Target]) end, filename:join(Dir, "include")} @@ -267,21 +266,6 @@ jinterface(Vars, _OsType) -> end, [{jinterface_classpath, filename:nativename(ClassPath)}|Vars]. -%% Unused! -% ig_vars(Vars) -> -% {Lib0, Incl} = -% case erl_root(Vars) of -% {installed, Root} -> -% Base = filename:join([Root, "usr"]), -% {filename:join([Base, "lib"]), -% filename:join([Base, "include"])}; -% {Type, Root, Target} when Type == clearcase; Type == srctree -> -% {filename:join([Root, "lib", "ig", "obj", Target]), -% filename:join([Root, "lib", "ig", "include"])} -% end, -% [{ig_libdir, filename:nativename(Lib0)}, -% {ig_include, filename:nativename(Incl)}|Vars]. - lib_dir(Vars, Lib) -> LibLibDir = case Lib of erts -> @@ -318,9 +302,6 @@ lib_dir(Vars, Lib) -> erl_root(Vars) -> Root = code:root_dir(), case ts_lib:erlang_type() of - {clearcase, _Version} -> - Target = get_var(target, Vars), - {clearcase, Root, Target}; {srctree, _Version} -> Target = get_var(target, Vars), {srctree, Root, Target}; @@ -350,10 +331,7 @@ sock_libraries({unix, _}) -> sock_libraries(vxworks) -> ""; sock_libraries(ose) -> - ""; -sock_libraries(_Other) -> - exit({sock_libraries, not_supported}). - + "". link_library(LibName,{win32, _}) -> LibName ++ ".lib"; diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl index 94926eba80..2ddffccf5b 100644 --- a/lib/test_server/src/ts_install.erl +++ b/lib/test_server/src/ts_install.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(ts_install). @@ -175,15 +175,8 @@ get_testcase_callback() -> get_rsh_name() -> case os:getenv("ERL_RSH") of - false -> - case ts_lib:erlang_type() of - {clearcase, _} -> - "ctrsh"; - {_, _} -> - "rsh" - end; - Str -> - Str + false -> "rsh"; + Str -> Str end. platform_id(Vars) -> @@ -233,9 +226,11 @@ to_upper(String) -> String). word_size() -> - case erlang:system_info(wordsize) of - 4 -> ""; - 8 -> "/64" + case {erlang:system_info({wordsize,external}), + erlang:system_info({wordsize,internal})} of + {4,4} -> ""; + {8,8} -> "/64"; + {8,4} -> "/Halfword" end. linux_dist() -> diff --git a/lib/test_server/src/ts_lib.erl b/lib/test_server/src/ts_lib.erl index 082c9e0519..2f0a4ea8c0 100644 --- a/lib/test_server/src/ts_lib.erl +++ b/lib/test_server/src/ts_lib.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(ts_lib). @@ -21,6 +21,8 @@ -include_lib("kernel/include/file.hrl"). -include("ts.hrl"). +%% Avoid warning for local function error/1 clashing with autoimported BIF. +-compile({no_auto_import,[error/1]}). -export([error/1, var/2, erlang_type/0, initial_capital/1, interesting_logs/1, specs/1, suites/2, last_test/1, @@ -72,12 +74,10 @@ progress(Vars, Level, Format, Args) -> erlang_type() -> {_, Version} = init:script_id(), - RelDir = filename:join([code:root_dir(), "releases"]), % Only in installed - SysDir = filename:join([code:root_dir(), "system"]), % Nonexisting link/dir outside ClearCase - case {filelib:is_file(RelDir),filelib:is_file(SysDir)} of - {true,_} -> {otp, Version}; % installed OTP - {_,true} -> {clearcase, Version}; - _ -> {srctree, Version} + RelDir = filename:join(code:root_dir(), "releases"), % Only in installed + case filelib:is_file(RelDir) of + true -> {otp,Version}; % installed OTP + false -> {srctree,Version} % source code tree end. %% Upcases the first letter in a string. diff --git a/lib/test_server/src/ts_reports.erl b/lib/test_server/src/ts_reports.erl index b41291d342..f981a77ae4 100644 --- a/lib/test_server/src/ts_reports.erl +++ b/lib/test_server/src/ts_reports.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2010. 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 @@ -27,6 +27,8 @@ -include_lib("kernel/include/file.hrl"). -include("ts.hrl"). +-compile({no_auto_import,[error/1]}). + -import(filename, [basename/1, rootname/1]). -import(ts_lib, [error/1]). diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl index 3461e1383c..888ac98973 100644 --- a/lib/test_server/src/ts_run.erl +++ b/lib/test_server/src/ts_run.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -198,8 +198,6 @@ get_spec_filename_1(Vars, TestDir, File) -> case ts_lib:var(os, Vars) of "VxWorks" -> check_spec_filename(TestDir, File, ".spec.vxworks"); - "OSE" -> - check_spec_filename(TestDir, File, ".spec.ose"); "Windows"++_ -> check_spec_filename(TestDir, File, ".spec.win"); _Other -> @@ -306,53 +304,36 @@ make_make(Vars, Spec, State) -> add_make_testcase(Vars, Spec, St) -> Makefile = St#state.makefile, Dir = filename:dirname(Makefile), - case ts_lib:var(os, Vars) of - "OSE" -> - %% For OSE, C code in datadir must be linked in the image file, - %% and erlang code is sent as binaries from test_server_ctrl - %% Making erlang code here because the Makefile.src probably won't - %% work. - Erl_flags=[{i, "../../test_server"}|ts_lib:var(erl_flags,Vars)], - {ok, Cwd} = file:get_cwd(), - ok = file:set_cwd(Dir), - Result = (catch make:all(Erl_flags)), - ok = file:set_cwd(Cwd), - case Result of - up_to_date -> {ok, Vars, Spec, St}; - _error -> {error, {erlang_make_failed,Dir}} - end; + Shortname = filename:basename(Makefile), + Suite = filename:basename(Dir, "_data"), + Config = [{data_dir,Dir},{makefile,Shortname}], + MakeModule = Suite ++ "_make", + MakeModuleSrc = filename:join(filename:dirname(Dir), + MakeModule ++ ".erl"), + MakeMod = list_to_atom(MakeModule), + case filelib:is_file(MakeModuleSrc) of + true -> ok; + false -> generate_make_module(ts_lib:var(make_command, Vars), + MakeModuleSrc, + MakeModule) + end, + case Suite of + "all_SUITE" -> + {ok,Vars,Spec,St#state{all={MakeMod,Config}}}; _ -> - Shortname = filename:basename(Makefile), - Suite = filename:basename(Dir, "_data"), - Config = [{data_dir,Dir},{makefile,Shortname}], - MakeModule = Suite ++ "_make", - MakeModuleSrc = filename:join(filename:dirname(Dir), - MakeModule ++ ".erl"), - MakeMod = list_to_atom(MakeModule), - case filelib:is_file(MakeModuleSrc) of - true -> ok; - false -> generate_make_module(ts_lib:var(make_command, Vars), - MakeModuleSrc, - MakeModule) - end, - case Suite of - "all_SUITE" -> - {ok,Vars,Spec,St#state{all={MakeMod,Config}}}; - _ -> - %% Avoid duplicates of testcases. There is no longer - %% a check for this in test_server_ctrl. - TestCase = {list_to_atom(Suite),all}, - TopCase0 = case St#state.topcase of - List when is_list(List) -> - List -- [TestCase]; - Top -> - [Top] -- [TestCase] - end, - TopCase = [{make,{MakeMod,make,[Config]}, - TestCase, - {MakeMod,unmake,[Config]}}|TopCase0], - {ok,Vars,Spec,St#state{topcase=TopCase}} - end + %% Avoid duplicates of testcases. There is no longer + %% a check for this in test_server_ctrl. + TestCase = {list_to_atom(Suite),all}, + TopCase0 = case St#state.topcase of + List when is_list(List) -> + List -- [TestCase]; + Top -> + [Top] -- [TestCase] + end, + TopCase = [{make,{MakeMod,make,[Config]}, + TestCase, + {MakeMod,unmake,[Config]}}|TopCase0], + {ok,Vars,Spec,St#state{topcase=TopCase}} end. generate_make_module(MakeCmd, Name, ModuleString) -> @@ -392,7 +373,7 @@ make_test_suite(Vars, _Spec, State) -> {ok, Cwd} = file:get_cwd(), ok = file:set_cwd(TestDir), - Result = (catch make:all(Erl_flags)), + Result = (catch make_all(Erl_flags)), ok = file:set_cwd(Cwd), case Result of up_to_date -> @@ -629,9 +610,6 @@ make_test_server_args(Args0,Options,Vars) -> "VxWorks" -> F = write_parameterfile(vxworks,Vars), " PARAMETERS " ++ F; - "OSE" -> - F = write_parameterfile(ose,Vars), - " PARAMETERS " ++ F; _ -> "" end, @@ -743,4 +721,52 @@ split_one(Path) -> split_path(Path) -> string:tokens(Path,";"). +%% +%% Run make:all/1 if the test suite seems to be designed +%% to be built/re-built by ts. +%% +make_all(Flags) -> + case filelib:is_regular("Emakefile") of + false -> + make_all_no_emakefile(Flags); + true -> + make:all(Flags) + end. +make_all_no_emakefile(Flags) -> + case filelib:wildcard("*.beam") of + [] -> + %% Since there are no *.beam files, we will assume + %% that this test suite was designed to be built and + %% re-built by ts. Create an Emakefile so that + %% make:all/1 will be run the next time too + %% (in case a test suite is being interactively + %% developed). + create_emakefile(Flags, "*.erl"); + [_|_] -> + %% There is no Emakefile and there already are + %% some *.beam files here. Assume that this test + %% suite was not designed to be re-built by ts. + %% Only create a Emakefile that will compile + %% generated *_SUITE_make files (if any). + create_emakefile(Flags, "*_SUITE_make.erl") + end. + +create_emakefile(Flags, Wc) -> + case filelib:wildcard(Wc) of + [] -> + %% There are no files to be built (i.e. not even any + %% generated *_SUITE_make.erl files). We must handle + %% this case specially, because make:all/1 will crash + %% on Emakefile with an empty list of modules. + io:put_chars("No Emakefile found - not running make:all/1\n"), + up_to_date; + [_|_]=Ms0 -> + io:format("Creating an Emakefile for compiling files matching ~s\n", + [Wc]), + Ms = [list_to_atom(filename:rootname(M, ".erl")) || M <- Ms0], + Make0 = {Ms,Flags}, + Make = io_lib:format("~p. \n", [Make0]), + ok = file:write_file("Emakefile", Make), + make:all(Flags) + end. |