diff options
Diffstat (limited to 'lib/test_server')
37 files changed, 2792 insertions, 1899 deletions
diff --git a/lib/test_server/doc/src/notes.xml b/lib/test_server/doc/src/notes.xml index b6e0a6cefa..ab329c399b 100644 --- a/lib/test_server/doc/src/notes.xml +++ b/lib/test_server/doc/src/notes.xml @@ -32,6 +32,126 @@ <file>notes.xml</file> </header> +<section><title>Test_Server 3.4.2</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p>Miscellaneous updates</p> + <p> + Own Id: OTP-8976</p> + </item> + </list> + </section> + +</section> + +<section><title>Test_Server 3.4.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Returning {return_group_result,failed} from end_per_group + in a group that is part of a sequence, did not cause the + proceeding cases (or groups) to get skipped. This has + been fixed.</p> + <p> + Own Id: OTP-8753 Aux Id: seq11644 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Common Test has been updated to handle start options and + test specification terms for test case groups (and test + cases in groups). Also, an option named 'label', has been + added that associates the test run with a name that + Common Test prints in the overview HTML logs.</p> + <p> + Own Id: OTP-8725 Aux Id: OTP-8727 </p> + </item> + <item> + <p> + It is now possible to skip all tests in a suite, or a + group, by returning {fail,Reason} from the end_tc/5 + framework function for init_per_suite, or init_per_group.</p> + <p> + Own Id: OTP-8805 Aux Id: seq11664 </p> + </item> + </list> + </section> + +</section> + +<section><title>Test_Server 3.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Returning {fail,Reason} from the framework end_tc + function was not handled properly by Test Server for all + test suite functions.</p> + <p> + Own Id: OTP-8492 Aux Id: seq11502 </p> + </item> + <item> + <p> + If the framework end_tc function would hang and get + aborted by Test Server, there was no indication of + failure in the logs. This has been fixed.</p> + <p> + Own Id: OTP-8682 Aux Id: seq11504 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + It is now possible for the Test Server framework end_tc + function to change the status of the test case from ok or + auto-skipped to failed by returning {fail,Reason}.</p> + <p> + Own Id: OTP-8495 Aux Id: seq11502 </p> + </item> + <item> + <p> + Test Server will now call the end_per_testcase/2 function + even if the test case has been terminated explicitly + (with abort_current_testcase/1), or after a timetrap + timeout. Under these circumstances the return value of + end_per_testcase is completely ignored. Therefore the + function will not be able to change the reason for test + case termination by returning {fail,Reason}, nor will it + be able to save data with {save_config,Data}.</p> + <p> + Own Id: OTP-8500 Aux Id: seq11521 </p> + </item> + <item> + <p> + Previously, a repeat property of a test case group + specified the number of times the group should be + repeated after the main test run. I.e. {repeat,N} would + case the group to execute 1+N times. To be consistent + with the behaviour of the run_test repeat option, this + has been changed. N now specifies the absolute number of + executions instead.</p> + <p> + Own Id: OTP-8689 Aux Id: seq11502 </p> + </item> + </list> + </section> + +</section> + <section><title>Test_Server 3.3.6</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/test_server/doc/src/test_server.xml b/lib/test_server/doc/src/test_server.xml index 6e75425862..0cae75d692 100644 --- a/lib/test_server/doc/src/test_server.xml +++ b/lib/test_server/doc/src/test_server.xml @@ -167,6 +167,22 @@ </desc> </func> <func> + <name>adjusted_sleep(MSecs) -> ok</name> + <fsummary>Suspens the calling task for a specified time.</fsummary> + <type> + <v>MSecs = integer() | float() | infinity</v> + <d>The default number of milliseconds to sleep</d> + </type> + <desc> + <p>This function suspends the calling process for at least the + supplied number of milliseconds. The function behaves the same + way as <c>test_server:sleep/1</c>, only <c>MSecs</c> + will be multiplied by the 'multiply_timetraps' value, if set, + and also automatically scaled up if 'scale_timetraps' is set + to true (which it is by default).</p> + </desc> + </func> + <func> <name>hours(N) -> MSecs</name> <name>minutes(N) -> MSecs</name> <name>seconds(N) -> MSecs</name> diff --git a/lib/test_server/doc/src/test_server_ctrl.xml b/lib/test_server/doc/src/test_server_ctrl.xml index 0ed5f88544..2368c4bacc 100644 --- a/lib/test_server/doc/src/test_server_ctrl.xml +++ b/lib/test_server/doc/src/test_server_ctrl.xml @@ -376,6 +376,31 @@ Optional, if not given the test server controller node </desc> </func> <func> + <name>scale_timetraps(Bool) -> ok</name> + <fsummary>.</fsummary> + <type> + <v>Bool = true | false</v> + </type> + <desc> + <p>This function should be called before a test is started. + The parameter specifies if test_server should attempt + to automatically scale the timetrap value in order to compensate + for delays caused by e.g. the cover tool.</p> + </desc> + </func> + <func> + <name>get_timetrap_parameters() -> {N,Bool} </name> + <fsummary>Read the parameter values that affect timetraps.</fsummary> + <type> + <v>N = integer() | infinity</v> + <v>Bool = true | false</v> + </type> + <desc> + <p>This function may be called to read the values set by + <c>multiply_timetraps/1</c> and <c>scale_timetraps/1</c>.</p> + </desc> + </func> + <func> <name>cover(Application,Analyse) -> ok</name> <name>cover(CoverFile,Analyse) -> ok</name> <name>cover(App,CoverFile,Analyse) -> ok</name> @@ -538,9 +563,6 @@ Optional, if not given the test server controller node test server controller node. The log must be formatted using <c>ttb:format/1/2</c>. </p> - <p>This is valid for all targets except the OSE/Delta target - for which all nodes will be logged and automatically formatted - in one single text file called <c>allnodes-test_server</c>.</p> </desc> </func> <func> @@ -610,7 +632,7 @@ Optional, if not given the test server controller node <tag><c>NAME name</c></tag> <item>Names the test suite to something else than the default name. This does not apply to <c>SPEC</c> which keeps - it's names. + its names. </item> <tag><c>PARAMETERS parameterfile</c></tag> <item>Specifies the parameter file to use when starting diff --git a/lib/test_server/doc/src/ts.xml b/lib/test_server/doc/src/ts.xml index 0f91d3eea2..f60c79aadd 100644 --- a/lib/test_server/doc/src/ts.xml +++ b/lib/test_server/doc/src/ts.xml @@ -250,7 +250,7 @@ running test suites. If a remote host is to be used, the <c>TargetSystem</c> argument must be given so that "cross installation" can be done. This should be used for testing on - VxWorks or OSE/Delta. Installation is required for any of the + VxWorks. Installation is required for any of the functions in <c>ts</c> to work. </p> <p>Opts may be one or more of @@ -275,7 +275,7 @@ strings. </item> <item><c>{slavetargets, SlaveTarges}</c><br></br> - For VxWorks and OSE/Delta only. This is a list of + For VxWorks only. This is a list of available hosts where slave nodes can be started. This is necessary because only one node can run per host in the VxWorks environment. This is not the same as diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile index d55a3a597d..0858d24fce 100644 --- a/lib/test_server/src/Makefile +++ b/lib/test_server/src/Makefile @@ -57,7 +57,8 @@ TS_MODULES= \ ts_erl_config \ ts_autoconf_win32 \ ts_autoconf_vxworks \ - ts_install + ts_install \ + ts_install_cth TARGET_MODULES= $(MODULES:%=$(EBIN)/%) TS_TARGET_MODULES= $(TS_MODULES:%=$(EBIN)/%) @@ -71,7 +72,7 @@ C_FILES = AUTOCONF_FILES = configure.in conf_vars.in COVER_FILES = cross.cover PROGRAMS = configure config.sub config.guess install-sh -CONFIG = ts.config ts.unix.config ts.win32.config ts.vxworks.config +CONFIG = ts.config ts.unix.config ts.win32.config TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) \ $(APP_TARGET) $(APPUP_TARGET) @@ -136,10 +137,10 @@ release_tests_spec: opt $(INSTALL_DIR) $(RELEASE_PATH)/test_server $(INSTALL_DATA) $(ERL_FILES) $(TS_ERL_FILES) \ $(HRL_FILES) $(INTERNAL_HRL_FILES) $(TS_HRL_FILES) \ - $(TARGET_FILES) $(TS_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..2ab4e9c28a 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} -> @@ -470,7 +470,7 @@ cover_analyse(Analyse,Modules) -> overview -> fun(_) -> undefined end end, - R = lists:map( + R = pmap( fun(M) -> case cover:analyse(M,module) of {ok,{M,{Cov,NotCov}}} -> @@ -486,10 +486,23 @@ cover_analyse(Analyse,Modules) -> stick_all_sticky(node(),Sticky), R. +pmap(Fun,List) -> + Collector = self(), + Pids = lists:map(fun(E) -> + spawn(fun() -> + Collector ! {res,self(),Fun(E)} + end) + end, List), + lists:map(fun(Pid) -> + receive + {res,Pid,Res} -> + Res + end + end, Pids). unstick_all_sticky(Node) -> lists:filter( - fun(M) -> + fun(M) -> case code:is_sticky(M) of true -> rpc:call(Node,code,unstick_mod,[M]), @@ -502,24 +515,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 +548,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 +594,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 +616,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 +636,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 +657,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 +671,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 -> + FW when FW =:= false; FW =:= "undefined" -> {test_server,Func}; - _ -> + _ -> {list_to_atom(CB),Func} end, RetVal = {died,{framework_error,Loc,Error},Loc,"Framework error"}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,{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,15 +910,45 @@ 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 + case catch do_end_tc_call(Mod,Func,{Pid,Skip,[[]]},Why) of {'EXIT',FwEndTCErr} -> exit({fw_notify_done,end_tc,FwEndTCErr}); _ -> @@ -838,6 +959,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 = @@ -845,11 +967,9 @@ spawn_fw_call(Mod,{end_per_testcase,Func},Pid,{timetrap_timeout,TVal}=Why, Conf = [{tc_status,ok}], %% if end_per_testcase fails, the test case should be %% reported successful with a warning printed as comment - case catch test_server_sup:framework_call(end_tc, - [?pl2a(Mod),Func, - {Pid, - {failed,{Mod,end_per_testcase,Why}}, - [Conf]}]) of + case catch do_end_tc_call(Mod,Func,{Pid, + {failed,{Mod,end_per_testcase,Why}}, + [Conf]}, Why) of {'EXIT',FwEndTCErr} -> exit({fw_notify_done,end_tc,FwEndTCErr}); _ -> @@ -869,7 +989,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])), @@ -891,9 +1011,7 @@ spawn_fw_call(Mod,Func,Pid,Error,Loc,SendTo,Comment) -> ok end, Conf = [{tc_status,{failed,timetrap_timeout}}], - case catch test_server_sup:framework_call(end_tc, - [?pl2a(Mod),Func, - {Pid,Error,[Conf]}]) of + case catch do_end_tc_call(Mod,Func,{Pid,Error,[Conf]},Error) of {'EXIT',FwEndTCErr} -> exit({fw_notify_done,end_tc,FwEndTCErr}); _ -> @@ -953,32 +1071,33 @@ 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 + {ok, Args0}) of {ok,Args} -> run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback); Error = {error,_Reason} -> - test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func,{Error,Args0}]), - {{0,{skip,{failed,Error}}},{Mod,Func},[]}; + NewResult = do_end_tc_call(Mod,Func,{Error,Args0}, + {skip,{failed,Error}}), + {{0,NewResult},{Mod,Func},[]}; {fail,Reason} -> [Conf] = Args0, Conf1 = [{tc_status,{failed,Reason}} | Conf], fw_error_notify(Mod, Func, Conf, Reason), - test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func, - {{error,Reason},[Conf1]}]), - {{0,{failed,Reason}},{Mod,Func},[]}; + NewResult = do_end_tc_call(Mod,Func, {{error,Reason},[Conf1]}, + {fail, Reason}), + {{0,NewResult},{Mod,Func},[]}; Skip = {skip,_Reason} -> - test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func,{Skip,Args0}]), - {{0,Skip},{Mod,Func},[]}; + NewResult = do_end_tc_call(Mod,Func,{Skip,Args0},Skip), + {{0,NewResult},{Mod,Func},[]}; {auto_skip,Reason} -> - test_server_sup:framework_call(end_tc,[?pl2a(Mod), - Func, - {{skip,Reason},Args0}]), - {{0,{skip,{fw_auto_skip,Reason}}},{Mod,Func},[]} + NewResult = do_end_tc_call(Mod, Func, {{skip,Reason},Args0}, + {skip, {fw_auto_skip,Reason}}), + {{0,NewResult},{Mod,Func},[]} end, exit({Ref,Time,Value,Loc,Opts}). @@ -992,18 +1111,20 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> Skip = {skip,Reason} -> Line = get_loc(), Conf = [{tc_status,{skipped,Reason}}], - test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func,{Skip,[Conf]}]), - {{0,{skip,Reason}},Line,[]}; + NewRes = do_end_tc_call(Mod,Func,{Skip,[Conf]}, Skip), + {{0,NewRes},Line,[]}; {skip_and_save,Reason,SaveCfg} -> Line = get_loc(), Conf = [{tc_status,{skipped,Reason}},{save_config,SaveCfg}], - test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func, - {{skip,Reason},[Conf]}]), - {{0,{skip,Reason}},Line,[]}; + NewRes = do_end_tc_call(Mod, Func, {{skip, Reason}, [Conf]}, + {skip, Reason}), + {{0,NewRes},Line,[]}; {ok,NewConf} -> put(test_server_init_or_end_conf,undefined), %% call user callback function if defined NewConf1 = user_callback(TCCallback, Mod, Func, init, NewConf), + %% save current state in controller loop + 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 +1146,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,16 +1159,16 @@ 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, - case test_server_sup:framework_call(end_tc, [?pl2a(Mod), Func, - {FWReturn1,[EndConf2]}]) of - {fail,Reason} -> - fw_error_notify(Mod, Func, EndConf2, Reason), - {{T,{failed,Reason}},{Mod,Func},[]}; - _ -> - {{T,TSReturn1},Loc,[]} + put(test_server_init_or_end_conf,undefined), + case do_end_tc_call(Mod, Func, {FWReturn1,[EndConf2]}, TSReturn1) of + {failed,Reason} = NewReturn -> + fw_error_notify(Mod,Func,EndConf2, Reason), + {{T,NewReturn},{Mod,Func},[]}; + NewReturn -> + {{T,NewReturn},Loc,[]} end end; skip_init -> @@ -1063,11 +1186,37 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> {{T,Return},Loc} = {ts_tc(Mod, Func, Args2),get_loc()}, %% call user callback function if defined Return1 = user_callback(TCCallback, Mod, Func, 'end', Return), - {Return2,Opts} = process_return_val([Return1], Mod,Func,Args1, Loc, Return1), + {Return2,Opts} = process_return_val([Return1], Mod, Func, + Args1, Loc, Return1), {{T,Return2},Loc,Opts} end. -%% the return value is a list and we have to check if it contains +do_end_tc_call(M,F,Res,Return) -> + Ref = make_ref(), + case test_server_sup:framework_call( + end_tc, [?pl2a(M),F,Res], Ref) of + {fail,FWReason} -> + {failed,FWReason}; + Ref -> + case test_server_sup:framework_call( + end_tc, [?pl2a(M),F,Res, Return], ok) of + {fail,FWReason} -> + {failed,FWReason}; + ok -> + case Return of + {fail,Reason} -> + {failed,Reason}; + Return -> + Return + end; + NewReturn -> + NewReturn + end; + _ -> + Return + end. + +%% the return value is a list and we have to check if it contains %% the result of an end conf case or if it's a Config list process_return_val([Return], M,F,A, Loc, Final) when is_list(Return) -> ReturnTags = [skip,skip_and_save,save_config,comment,return_group_result], @@ -1081,25 +1230,34 @@ process_return_val([Return], M,F,A, Loc, Final) when is_list(Return) -> end, Return) of true -> % must be return value from end conf case process_return_val1(Return, M,F,A, Loc, Final, []); - false -> % must be Config value from init conf case - test_server_sup:framework_call(end_tc, [?pl2a(M),F,{ok,A}]), - {Return,[]} + false -> % must be Config value from init conf case + case do_end_tc_call(M,F,{ok,A}, Return) of + {failed, FWReason} = Failed -> + fw_error_notify(M,F,A, FWReason), + {Failed, []}; + NewReturn -> + {NewReturn, []} + end end; %% the return value is not a list, so it's the return value from an %% end conf case or it's a dummy value that can be ignored process_return_val(Return, M,F,A, Loc, Final) -> process_return_val1(Return, M,F,A, Loc, Final, []). -process_return_val1([Failed={E,TCError}|_], M,F,A=[Args], Loc, _, SaveOpts) when E=='EXIT'; - E==failed -> +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 do_end_tc_call(M,F,{{error,TCError}, + [[{tc_status,{failed,TCError}}|Args]]}, Failed) of + {failed,FWReason} -> + {{failed,FWReason},SaveOpts}; + NewReturn -> + {NewReturn,SaveOpts} + end; +process_return_val1([SaveCfg={save_config,_}|Opts], M,F,[Args], Loc, Final, SaveOpts) -> process_return_val1(Opts, M,F,[[SaveCfg|Args]], Loc, Final, SaveOpts); -process_return_val1([{skip_and_save,Why,SaveCfg}|Opts], M,F,[Args], Loc, _, SaveOpts) -> +process_return_val1([{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 +1267,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 do_end_tc_call(M,F,{Final,A}, Final) of + {failed,FWReason} -> + {{failed,FWReason},SaveOpts}; + NewReturn -> + {NewReturn,lists:reverse(SaveOpts)} + end. user_callback(undefined, _, _, _, Args) -> Args; @@ -1134,11 +1296,11 @@ init_per_testcase(Mod, Func, Args) -> false -> code:load_file(Mod); _ -> ok end, - %% init_per_testcase defined, returns new configuration +%% init_per_testcase defined, returns new configuration 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,40 +1311,40 @@ 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 -> - %% Optional init_per_testcase not defined - %% keep quiet. +%% Optional init_per_testcase not defined +%% keep quiet. [Config] = Args, {ok, Config} end. - + end_per_testcase(Mod, Func, Conf) -> case erlang:function_exported(Mod,end_per_testcase,2) of true -> @@ -1211,11 +1373,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 +1385,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 +1416,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 +1448,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 +1458,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 +1488,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 +1514,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 +1622,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 +1709,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 +1761,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 +1783,6 @@ timetrap1(Timeout) -> Ref. ensure_timetrap(Config) -> - %format("ensure_timetrap:~p~n",[Config]), case get(test_server_timetraps) of [_|_] -> ok; @@ -1623,7 +1823,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 +1963,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 +1992,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 +2017,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 +2057,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 +2067,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 +2095,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 +2118,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 +2137,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 +2214,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 +2237,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 +2354,7 @@ purify_new_fds_inuse() -> {'EXIT', _} -> false; Inuse when is_integer(Inuse) -> Inuse end. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% purify_format(Format, Args) -> ok %% Format = string() @@ -2208,9 +2402,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..7cd58642d0 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,21 +151,24 @@ %%% 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]). -export([set_random_seed/1]). +-export([kill_slavenodes/0]). %%% TEST_SERVER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -export([output/2, print/2, print/3, print_timestamp/2]). @@ -207,13 +210,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 +227,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 +268,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 +283,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 +293,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 +313,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 +332,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 +423,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 +496,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). @@ -503,6 +526,9 @@ testcase_callback(ModFunc) -> set_random_seed(Seed) -> controller_call({set_random_seed,Seed}). +kill_slavenodes() -> + controller_call(kill_slavenodes). + get_hosts() -> get(test_server_hosts). @@ -511,6 +537,8 @@ get_target_os_type() -> undefined -> %% This is probably called on the target node os:type(); + Pid when Pid =:= self() -> + os:type(); _pid -> %% This is called on the controller, e.g. from a %% specification clause of a test case @@ -551,7 +579,7 @@ controller_call(Arg, Timeout) -> Other -> Other end. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -615,9 +643,9 @@ contact_main_target(local) -> %% When used by a general framework, global registration of %% test_server should not be required. case os:getenv("TEST_SERVER_FRAMEWORK") of - false -> + FW when FW =:= false; FW =:= "undefined" -> %% 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 +709,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 +719,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 +736,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 +764,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 +788,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 +804,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 +828,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 +858,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 +886,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 +909,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 +922,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 +973,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 +1006,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 +1044,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 +1052,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 +1116,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 +1137,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 +1163,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 +1179,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 +1190,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 +1211,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 +1225,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 +1245,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 +1255,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 +1272,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 +1311,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 +1319,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 +1375,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 +1389,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 +1429,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 +1477,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 +1502,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 +1525,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 +1566,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 +1593,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 +1639,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 +1672,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"), @@ -1636,14 +1710,14 @@ do_test_cases(TopCases, SkipCases, Config, MultiplyTimetrap) when is_list(TopCas [erlang:system_info(version), code:root_dir()]), case os:getenv("TEST_SERVER_FRAMEWORK") of - false -> + FW when FW =:= false; FW =:= "undefined" -> print(html, "<p>Target:<br>\n"), print_who(TI#target_info.host, TI#target_info.username), print(html, "<br>Used Erlang ~s in <tt>~s</tt>.\n", [TI#target_info.version, TI#target_info.root_dir]); _ -> case test_server_sup:framework_call(target_info, []) of - TargetInfo when is_list(TargetInfo), + TargetInfo when is_list(TargetInfo), length(TargetInfo) > 0 -> print(html, "<p>Target:<br>\n"), print(html, "~s\n", [TargetInfo]); @@ -1658,7 +1732,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 +1755,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 +1815,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 +1856,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 +1927,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 +1993,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 +2039,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 +2047,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 +2071,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 +2130,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 +2141,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 +2186,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 +2223,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 +2251,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 +2273,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 +2290,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 +2315,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 +2347,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 +2373,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 +2398,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 +2430,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 +2458,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 +2520,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 +2536,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 +2559,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 +2583,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 +2617,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 +2633,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 +2642,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 +2698,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 +2707,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 +2787,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 +2806,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 +2883,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 +2919,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 +2953,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 +2980,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 +3001,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 +3067,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 +3076,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 +3096,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 +3211,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 +3237,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 +3251,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 +3262,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 +3279,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 +3290,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 +3313,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 +3334,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 +3358,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 +3376,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 +3396,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 +3413,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 +3425,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 +3434,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 +3500,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 +3523,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 +3536,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 +3550,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, + {_, {Fail, Reason}} when Fail =:= fail; Fail =:= failed -> + 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 +3569,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 +3592,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 +3614,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 +3632,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 +3642,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 +3655,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 +3663,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 +3676,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 +3698,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 +3716,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 +3724,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 +3738,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 +3755,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 +3776,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 +3813,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 +3826,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 +3852,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 +3876,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 +3887,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 +3903,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 +3911,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 +3930,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 +3979,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 +4007,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 +4016,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,12 +4058,12 @@ 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) -> case os:getenv("TEST_SERVER_FRAMEWORK") of - false -> + FW when FW =:= false; FW =:= "undefined" -> case application:get_env(test_server, format_exception) of {ok,false} -> {"~p",Reason}; @@ -3950,17 +4077,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 +4096,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 +4111,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 +4139,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 +4167,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 +4415,7 @@ update_config(Config, []) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% collect_cases(CurMod, TopCase, SkipList) -> +%% collect_cases(CurMod, TopCase, SkipList) -> %% BasicCaseList | {error,Reason} %% %% CurMod = atom() @@ -4319,18 +4446,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 +4466,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 +4478,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 +4491,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 +4506,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 +4531,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 +4610,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 @@ -4473,11 +4636,11 @@ collect_case([Case | Cases], St, Acc) -> collect_case_invoke(Mod, Case, MFA, St) -> case os:getenv("TEST_SERVER_FRAMEWORK") of - false -> + FW when FW =:= false; FW =:= "undefined" -> case catch apply(Mod, Case, [suite]) of - {'EXIT',_} -> + {'EXIT',_} -> {ok,[MFA],St}; - Suite -> + Suite -> collect_subcases(Mod, Case, MFA, St, Suite) end; _ -> @@ -4485,9 +4648,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 +4662,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 +4702,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 +4725,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 +4784,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 +4834,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 +4849,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 +4904,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 +4914,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 +4961,7 @@ p({A,B,C}) -> p(X) -> pinfo(X). -t() -> +t() -> t(wall_clock). t(X) -> element(1, statistics(X)). @@ -4781,7 +5000,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 +5041,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 +5112,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 +5177,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 +5187,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 +5221,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 +5237,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 +5250,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 +5264,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 +5293,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 +5339,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 +5353,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 +5381,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 +5396,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 +5419,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 +5435,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 +5451,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..056d18da96 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]). @@ -86,7 +84,7 @@ start_remote_main_target(Parameters) -> MasterNode,MasterCookie), Cmd = case os:getenv("TEST_SERVER_FRAMEWORK") of - false -> Cmd0; + FW when FW =:= false; FW =:= "undefined" -> Cmd0; FW -> Cmd0 ++ " -env TEST_SERVER_FRAMEWORK " ++ FW end, diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 89edb0f881..4a7804a482 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), @@ -487,7 +494,8 @@ framework_call(Func,Args) -> framework_call(Func,Args,DefaultReturn) -> CB = os:getenv("TEST_SERVER_FRAMEWORK"), framework_call(CB,Func,Args,DefaultReturn). -framework_call(false,_Func,_Args,DefaultReturn) -> +framework_call(FW,_Func,_Args,DefaultReturn) + when FW =:= false; FW =:= "undefined" -> DefaultReturn; framework_call(Callback,Func,Args,DefaultReturn) -> Mod = list_to_atom(Callback), @@ -497,6 +505,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.config b/lib/test_server/src/ts.config index 30ef25a0b8..f021f5958b 100644 --- a/lib/test_server/src/ts.config +++ b/lib/test_server/src/ts.config @@ -1,45 +1,46 @@ %% -*- erlang -*- -{ipv6_hosts,[otptest06,otptest08,sauron,iluvatar]}. -%%% Change these to suite the environment. -%%% test_hosts are looked up using "ypmatch xx yy zz hosts" -{test_hosts, - [bingo, hurin, turin, gandalf, super, - merry, nenya, sam, elrond, isildur]}. +%%% Change these to suite the environment. See the inet_SUITE for info about +%%% what they are used for. +%%% test_hosts are looked up using "ypmatch xx yy zz hosts.byname" +%{test_hosts,[my_ip4_host]}. %% IPv4 host only - no ipv6 entry must exist! -{test_host_ipv4_only, - {"isildur", %Short hostname - "isildur.du.uab.ericsson.se", %Long hostname - "134.138.177.24", %IP string - {134,138,177,24}, %IP tuple - ["isildur"], %Any aliases - "::ffff:134.138.177.24", %IPv6 string (compatibilty addr) - {0,0,0,0,0,65535,34442,45336} %IPv6 tuple - }}. - -{test_host_ipv6_only, - {"otptest06", %Short hostname - "otptest06.du.uab.ericsson.se", %Long hostname - "fec0::a00:20ff:feb2:b4a9", %IPv6 string - {65216,0,0,0,2560,8447,65202,46249}, %IPv6 tuple - ["otptest06-ip6"] %Aliases. - }}. - - - -{test_dummy_host, {"dummy", - "dummy.du.uab.ericsson.se", - "192.138.177.1", - {192,138,177,1}, - ["dummy"], - "::ffff:192.138.177.1", - {0,0,0,0,0,65535,49290,45313} - }}. - -{test_dummy_ipv6_host, {"dummy6", - "dummy6.du.uab.ericsson.se", - "fec0::a00:20ff:feb2:6666", - {65216,0,0,0,2560,8447,65202,26214}, - ["dummy6-ip6"] - }}. +%{test_host_ipv4_only, +% {"my_ip4_host", %Short hostname +% "my_ip4_host.mydomain.com", %Long hostname +% "10.10.0.1", %IP string +% {10,10,0,1}, %IP tuple +% ["my_ip4_host"], %Any aliases +% "::ffff:10.10.0.1", %IPv6 string (compatibilty addr) +% {0,0,0,0,0,65535,2570,1} %IPv6 tuple +% }}. + +%{test_dummy_host, {"dummy", +% "dummy.mydomain.com", +% "192.168.0.1", +% {192,168,0,1}, +% ["dummy"], +% "::ffff:192.168.0.1", +% {0,0,0,0,0,65535,49320,1} +% }}. + + +%%% test_hosts are looked up using "ypmatch xx yy zz ipnodes.byname" +%{ipv6_hosts,[my_ip6_host]}. + + +%{test_host_ipv6_only, +% {"my_ip6_host", %Short hostname +% "my_ip6_host.mydomain.com", %Long hostname +% "::2eff:f2b0:1ea0", %IPv6 string +% {0,0,0,0,0,12031,62128,7840}, %IPv6 tuple +% ["my_ip6_host"] %Aliases. +% }}. + +%{test_dummy_ipv6_host, {"dummy6", +% "dummy6.mydomain.com", +% "127::1", +% {295,0,0,0,0,0,0,1}, +% ["dummy6-ip6"] +% }}. diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index 1b750c3858..3d55f41b8c 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" @@ -150,6 +150,14 @@ help(installed) -> " TraceSpec is the name of a file containing\n", " trace specifications or a list of trace\n", " specification elements.\n", + " {config, Path} - Specify which directory ts should get it's \n" + " config files from. The files should follow\n" + " the convention lib/test_server/src/ts*.config.\n" + " These config files can also be specified by\n" + " setting the TEST_CONFIG_PATH environment\n" + " variable to the directory where the config\n" + " files are. The default location is\n" + " tests/test_server/.\n" "\n", "Supported trace information elements\n", " {tp | tpl, Mod, [] | match_spec()}\n", @@ -249,7 +257,7 @@ run_some([Spec|Specs], Opts) -> run(Testspec) when is_atom(Testspec) -> Options=check_test_get_opts(Testspec, []), File = atom_to_list(Testspec), - run_test(File, ["SPEC current.spec NAME ",File], Options); + run_test(File, [{spec,[File++".spec"]}], Options); %% This can be used from command line, e.g. %% erl -s ts run all_tests <config> @@ -293,11 +301,11 @@ run(List, Opts) when is_list(List), is_list(Opts) -> run(Testspec, Config) when is_atom(Testspec), is_list(Config) -> Options=check_test_get_opts(Testspec, Config), File=atom_to_list(Testspec), - run_test(File, ["SPEC current.spec NAME ", File], Options); + run_test(File, [{spec,[File++".spec"]}], Options); %% Runs one module in a spec (interactive) run(Testspec, Mod) when is_atom(Testspec), is_atom(Mod) -> run_test({atom_to_list(Testspec), Mod}, - ["SPEC current.spec NAME ", atom_to_list(Mod)], + [{suite,Mod}], [interactive]). %% run/3 @@ -305,20 +313,23 @@ run(Testspec, Mod) when is_atom(Testspec), is_atom(Mod) -> run(Testspec,Mod,Config) when is_atom(Testspec), is_atom(Mod), is_list(Config) -> Options=check_test_get_opts(Testspec, Config), run_test({atom_to_list(Testspec), Mod}, - ["SPEC current.spec NAME ", atom_to_list(Mod)], + [{suite,Mod}], Options); %% Runs one testcase in a module. run(Testspec, Mod, Case) when is_atom(Testspec), is_atom(Mod), is_atom(Case) -> Options=check_test_get_opts(Testspec, []), - Args = ["CASE ",atom_to_list(Mod)," ",atom_to_list(Case)], + Args = [{suite,atom_to_list(Mod)},{testcase,atom_to_list(Case)}], run_test(atom_to_list(Testspec), Args, Options). %% run/4 %% Run one testcase in a module with Options. -run(Testspec, Mod, Case, Config) when is_atom(Testspec), is_atom(Mod), is_atom(Case), is_list(Config) -> +run(Testspec, Mod, Case, Config) when is_atom(Testspec), + is_atom(Mod), + is_atom(Case), + is_list(Config) -> Options=check_test_get_opts(Testspec, Config), - Args = ["CASE ",atom_to_list(Mod), " ",atom_to_list(Case)], + Args = [{suite,atom_to_list(Mod)}, {testcase,atom_to_list(Case)}], run_test(atom_to_list(Testspec), Args, Options). %% Check testspec to be valid and get possible Options @@ -327,10 +338,11 @@ check_test_get_opts(Testspec, Config) -> validate_test(Testspec), Mode = configmember(batch, {batch, interactive}, Config), Vars = configvars(Config), - Trace = configtrace(Config), + Trace = get_config(trace,Config), + ConfigPath = get_config(config,Config), KeepTopcase = configmember(keep_topcase, {keep_topcase,[]}, Config), Cover = configcover(Testspec,Config), - lists:flatten([Vars,Mode,Trace,KeepTopcase,Cover]). + lists:flatten([Vars,Mode,Trace,KeepTopcase,Cover,ConfigPath]). to_erlang_term(Atom) -> String = atom_to_list(Atom), @@ -398,8 +410,8 @@ special_vars(Config) -> SpecVars1 end. -configtrace(Config) -> - case lists:keysearch(trace,1,Config) of +get_config(Key,Config) -> + case lists:keysearch(Key,1,Config) of {value,Value} -> Value; false -> [] end. diff --git a/lib/test_server/src/ts.unix.config b/lib/test_server/src/ts.unix.config index b4325f065f..5a2580f464 100644 --- a/lib/test_server/src/ts.unix.config +++ b/lib/test_server/src/ts.unix.config @@ -1,4 +1,4 @@ %% -*- erlang -*- %% Always run a (VNC) X server on host -{xserver, "frumgar.du.uab.ericsson.se:66"}. +%% {xserver, "xserver.example.com:66"}. diff --git a/lib/test_server/src/ts.vxworks.config b/lib/test_server/src/ts.vxworks.config deleted file mode 100644 index b0b66e07ad..0000000000 --- a/lib/test_server/src/ts.vxworks.config +++ /dev/null @@ -1,19 +0,0 @@ -%% -*- erlang -*- - -%%% There is no equivalent command to ypmatch on Win32... :-( -{hardcoded_hosts, - [{"134.138.177.74","strider"}, - {"134.138.177.72", "elrond"}, - {"134.138.177.67", "sam"}, - {"134.138.176.215", "nenya"}, - {"134.138.176.192", "merry"}, - {"134.138.177.35", "lw4"}, - {"134.138.177.35", "lw5"}, - {"134.138.176.16", "super"}, - {"134.138.177.16", "gandalf"}, - {"134.138.177.92", "turin"}, - {"134.138.177.86", "mallor"}]}. - -{hardcoded_ipv6_hosts, - [{"fe80::a00:20ff:feb2:b4a9","otptest06"}, - {"fe80::a00:20ff:feb2:a621","otptest08"}]}. diff --git a/lib/test_server/src/ts.win32.config b/lib/test_server/src/ts.win32.config index 2802c4a75a..cae587bea8 100644 --- a/lib/test_server/src/ts.win32.config +++ b/lib/test_server/src/ts.win32.config @@ -1,15 +1,8 @@ %% -*- erlang -*- %%% There is no equivalent command to ypmatch on Win32... :-( -{hardcoded_hosts, - [{"134.138.177.24","isildur"}, - {"134.138.177.72", "elrond"}, - {"134.138.176.215", "nenya"}, - {"134.138.176.192", "merry"}, - {"134.138.176.16", "super"}, - {"134.138.177.16", "gandalf"}, - {"134.138.177.92", "turin"}]}. +%{hardcoded_hosts, +% [{"127.0.0.1","localhost"}]}. -{hardcoded_ipv6_hosts, - [{"fe80::a00:20ff:feb2:b4a9","otptest06"}, - {"fe80::a00:20ff:feb2:a621","otptest08"}]}. +%{hardcoded_ipv6_hosts, +% [{"::1","localhost"}]}. 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_install_cth.erl b/lib/test_server/src/ts_install_cth.erl new file mode 100644 index 0000000000..f8b4e5a4f8 --- /dev/null +++ b/lib/test_server/src/ts_install_cth.erl @@ -0,0 +1,286 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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% +%% + +%%% @doc TS Installed SCB +%%% +%%% This module does what the make parts of the ts:run/x command did, +%%% but not the Makefile.first parts! So they have to be done by ts or +%%% manually!! + +-module(ts_install_cth). + +%% Suite Callbacks +-export([id/1]). +-export([init/2]). + +-export([pre_init_per_suite/3]). +-export([post_init_per_suite/4]). +-export([pre_end_per_suite/3]). +-export([post_end_per_suite/4]). + +-export([pre_init_per_group/3]). +-export([post_init_per_group/4]). +-export([pre_end_per_group/3]). +-export([post_end_per_group/4]). + +-export([pre_init_per_testcase/3]). +-export([post_end_per_testcase/4]). + +-export([on_tc_fail/3]). +-export([on_tc_skip/3]). + +-export([terminate/1]). + +-include_lib("kernel/include/file.hrl"). + +-type proplist() :: list({atom(),term()}). +-type config() :: proplist(). +-type reason() :: term(). +-type skip_or_fail() :: {skip, reason()} | + {auto_skip, reason()} | + {fail, reason()}. + +-record(state, { ts_conf_dir, target_system, install_opts, nodenames, nodes }). + +%% @doc The id of this SCB +-spec id(Opts :: term()) -> + Id :: term(). +id(_Opts) -> + ?MODULE. + +%% @doc Always called before any other callback function. +-spec init(Id :: term(), Opts :: proplist()) -> + State :: #state{}. +init(_Id, Opts) -> + Nodenames = proplists:get_value(nodenames, Opts, 0), + Nodes = proplists:get_value(nodes, Opts, 0), + TSConfDir = proplists:get_value(ts_conf_dir, Opts), + TargetSystem = proplists:get_value(target_system, Opts, install_local), + InstallOpts = proplists:get_value(install_opts, Opts, []), + #state{ nodenames = Nodenames, + nodes = Nodes, + ts_conf_dir = TSConfDir, + target_system = TargetSystem, + install_opts = InstallOpts }. + +%% @doc Called before init_per_suite is called. +-spec pre_init_per_suite(Suite :: atom(), + Config :: config(), + State :: #state{}) -> + {config() | skip_or_fail(), NewState :: #state{}}. +pre_init_per_suite(Suite,Config,#state{ ts_conf_dir = undefined} = State) -> + DataDir = proplists:get_value(data_dir, Config), + ParentDir = filename:join( + lists:reverse( + tl(lists:reverse(filename:split(DataDir))))), + TSConfDir = filename:join([ParentDir, "..","test_server"]), + pre_init_per_suite(Suite, Config, State#state{ ts_conf_dir = TSConfDir }); +pre_init_per_suite(_Suite,Config,State) -> + DataDir = proplists:get_value(data_dir, Config), + try + {ok,Variables} = + file:consult(filename:join(State#state.ts_conf_dir,"variables")), + + %% Make the stuff in all_SUITE_data if it exists + AllDir = filename:join(DataDir,"../all_SUITE_data"), + case filelib:is_dir(AllDir) of + true -> + make_non_erlang(AllDir,Variables); + false -> + ok + end, + + make_non_erlang(DataDir, Variables), + + {add_node_name(Config, State), State} + catch Error:Reason -> + Stack = erlang:get_stacktrace(), + ct:pal("~p failed! ~p:{~p,~p}",[?MODULE,Error,Reason,Stack]), + {fail,{?MODULE,{Error,Reason, Stack}}} + end. + +%% @doc Called after init_per_suite. +-spec post_init_per_suite(Suite :: atom(), + Config :: config(), + Return :: config() | skip_or_fail(), + State :: #state{}) -> + {config() | skip_or_fail(), NewState :: #state{}}. +post_init_per_suite(_Suite,_Config,Return,State) -> + test_server_ctrl:kill_slavenodes(), + {Return, State}. + +%% @doc Called before end_per_suite. +-spec pre_end_per_suite(Suite :: atom(), + Config :: config() | skip_or_fail(), + State :: #state{}) -> + {ok | skip_or_fail(), NewState :: #state{}}. +pre_end_per_suite(_Suite,Config,State) -> + {Config, State}. + +%% @doc Called after end_per_suite. +-spec post_end_per_suite(Suite :: atom(), + Config :: config(), + Return :: term(), + State :: #state{}) -> + {ok | skip_or_fail(), NewState :: #state{}}. +post_end_per_suite(_Suite,_Config,Return,State) -> + {Return, State}. + +%% @doc Called before each init_per_group. +-spec pre_init_per_group(Group :: atom(), + Config :: config(), + State :: #state{}) -> + {config() | skip_or_fail(), NewState :: #state{}}. +pre_init_per_group(_Group,Config,State) -> + {add_node_name(Config, State), State}. + +%% @doc Called after each init_per_group. +-spec post_init_per_group(Group :: atom(), + Config :: config(), + Return :: config() | skip_or_fail(), + State :: #state{}) -> + {config() | skip_or_fail(), NewState :: #state{}}. +post_init_per_group(_Group,_Config,Return,State) -> + {Return, State}. + +%% @doc Called after each end_per_group. +-spec pre_end_per_group(Group :: atom(), + Config :: config() | skip_or_fail(), + State :: #state{}) -> + {ok | skip_or_fail(), NewState :: #state{}}. +pre_end_per_group(_Group,Config,State) -> + {Config, State}. + +%% @doc Called after each end_per_group. +-spec post_end_per_group(Group :: atom(), + Config :: config(), + Return :: term(), + State :: #state{}) -> + {ok | skip_or_fail(), NewState :: #state{}}. +post_end_per_group(_Group,_Config,Return,State) -> + {Return, State}. + +%% @doc Called before each test case. +-spec pre_init_per_testcase(TC :: atom(), + Config :: config(), + State :: #state{}) -> + {config() | skip_or_fail(), NewState :: #state{}}. +pre_init_per_testcase(_TC,Config,State) -> + {add_node_name(Config, State), State}. + +%% @doc Called after each test case. +-spec post_end_per_testcase(TC :: atom(), + Config :: config(), + Return :: term(), + State :: #state{}) -> + {ok | skip_or_fail(), NewState :: #state{}}. +post_end_per_testcase(_TC,_Config,Return,State) -> + {Return, State}. + +%% @doc Called after a test case failed. +-spec on_tc_fail(TC :: init_per_suite | end_per_suite | + init_per_group | end_per_group | atom(), + Reason :: term(), State :: #state{}) -> + NewState :: #state{}. +on_tc_fail(_TC, _Reason, State) -> + State. + +%% @doc Called when a test case is skipped. +-spec on_tc_skip(TC :: end_per_suite | init_per_group | end_per_group | atom(), + {tc_auto_skip, {failed, {Mod :: atom(), Function :: atom(), + Reason :: term()}}} | + {tc_user_skip, {skipped, Reason :: term()}}, + State :: #state{}) -> + NewState :: #state{}. +on_tc_skip(_TC, _Reason, State) -> + State. + +%% @doc Called when the scope of the SCB is done. +-spec terminate(State :: #state{}) -> + term(). +terminate(_State) -> + ok. + +%%% ============================================================================ +%%% Local functions +%%% ============================================================================ +%% Configure and run all the Makefiles in the data dirs of the suite +%% in question +make_non_erlang(DataDir, Variables) -> + {ok,CurrWD} = file:get_cwd(), + try + file:set_cwd(DataDir), + MakeCommand = proplists:get_value(make_command,Variables), + + FirstMakefile = filename:join(DataDir,"Makefile.first"), + case filelib:is_regular(FirstMakefile) of + true -> + ct:log("Making ~p",[FirstMakefile]), + ok = ts_make:make( + MakeCommand, DataDir, filename:basename(FirstMakefile)); + false -> + ok + end, + + MakefileSrc = filename:join(DataDir,"Makefile.src"), + MakefileDest = filename:join(DataDir,"Makefile"), + case filelib:is_regular(MakefileSrc) of + true -> + ok = ts_lib:subst_file(MakefileSrc,MakefileDest,Variables), + ct:log("Making ~p",[MakefileDest]), + ok = ts_make:make([{makefile,"Makefile"},{data_dir,DataDir} + | Variables]); + false -> + ok + end + after + file:set_cwd(CurrWD), + timer:sleep(100) + end. + +%% Add a nodename to config if it does not exist +add_node_name(Config, State) -> + case proplists:get_value(nodenames, Config) of + undefined -> + lists:keystore( + nodenames, 1, Config, + {nodenames,generate_nodenames(State#state.nodenames)}); + _Else -> + Config + end. + + +%% Copied from test_server_ctrl.erl +generate_nodenames(Num) -> + {ok,Name} = inet:gethostname(), + generate_nodenames2(Num, [Name], []). + +generate_nodenames2(0, _Hosts, Acc) -> + Acc; +generate_nodenames2(N, Hosts, Acc) -> + Host=lists:nth((N rem (length(Hosts)))+1, Hosts), + Name=list_to_atom(temp_nodename("nod", []) ++ "@" ++ Host), + generate_nodenames2(N-1, Hosts, [Name|Acc]). + +temp_nodename([], Acc) -> + lists:flatten(Acc); +temp_nodename([Chr|Base], Acc) -> + {A,B,C} = erlang:now(), + New = [Chr | integer_to_list(Chr bxor A bxor B+A bxor C+B)], + temp_nodename(Base, [New|Acc]). 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..d572b1454c 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% %% @@ -28,7 +28,7 @@ -include("ts.hrl"). --import(lists, [map/2,member/2,filter/2,reverse/1]). +-import(lists, [member/2,filter/2]). -record(state, {file, % File given. @@ -63,50 +63,18 @@ run(File, Args0, Options, Vars0) -> _ -> {false, fun run_interactive/3} end, - HandleTopcase = case member(keep_topcase, Options) of - true -> [fun copy_topcase/3]; - false -> [fun remove_original_topcase/3, - fun init_topcase/3] - end, - MakefileHooks = [fun make_make/3, - fun add_make_testcase/3], - MakeLoop = fun(V, Sp, St) -> make_loop(MakefileHooks, V, Sp, St) end, Hooks = [fun init_state/3, - fun read_spec_file/3] ++ - HandleTopcase ++ - [fun run_preinits/3, - fun find_makefiles/3, - MakeLoop, - fun make_test_suite/3, - fun add_topcase_to_spec/3, - fun write_spec_file/3, + fun run_preinits/3, fun make_command/3, Runner], - Args = make_test_server_args(Args0,Options,Vars), + Args = make_common_test_args(Args0,Options,Vars), St = #state{file=File,test_server_args=Args,batch=Batch}, R = execute(Hooks, Vars, [], St), - case Batch of - true -> ts_reports:make_index(); - false -> ok % ts_reports:make_index() is run on the test_server node - end, case R of {ok,_,_,_} -> ok; Error -> Error end. -make_loop(Hooks, Vars0, Spec0, St0) -> - case St0#state.makefiles of - [Makefile|Rest] -> - case execute(Hooks, Vars0, Spec0, St0#state{makefile=Makefile}) of - {error, Reason} -> - {error, Reason}; - {ok, Vars, Spec, St} -> - make_loop(Hooks, Vars, Spec, St#state{makefiles=Rest}) - end; - [] -> - {ok, Vars0, Spec0, St0} - end. - execute([Hook|Rest], Vars0, Spec0, St0) -> case Hook(Vars0, Spec0, St0) of ok -> @@ -156,103 +124,6 @@ init_state(Vars, [], St0) -> false -> {error,{no_test_directory,TestDir}} end. - -%% Read the spec file for the test suite. - -read_spec_file(Vars, _, St) -> - TestDir = St#state.test_dir, - File = St#state.file, - {SpecFile,Res} = get_spec_filename(Vars, TestDir, File), - case Res of - {ok,Spec} -> - {ok,Vars,Spec,St}; - {error,Atom} when is_atom(Atom) -> - {error,{no_spec,SpecFile}}; - {error,Reason} -> - {error,{bad_spec,lists:flatten(file:format_error(Reason))}} - end. - -get_spec_filename(Vars, TestDir, File) -> - DynSpec = filename:join(TestDir, File ++ ".dynspec"), - case filelib:is_file(DynSpec) of - true -> - Bs0 = erl_eval:new_bindings(), - Bs1 = erl_eval:add_binding('Target', ts_lib:var(target, Vars), Bs0), - Bs2 = erl_eval:add_binding('Os', ts_lib:var(os, Vars), Bs1), - TCCStr = ts_lib:var(test_c_compiler, Vars), - TCC = try - {ok, Toks, _} = erl_scan:string(TCCStr ++ "."), - {ok, Tcc} = erl_parse:parse_term(Toks), - Tcc - catch - _:_ -> undefined - end, - Bs = erl_eval:add_binding('TestCCompiler', TCC, Bs2), - {DynSpec,file:script(DynSpec, Bs)}; - false -> - SpecFile = get_spec_filename_1(Vars, TestDir, File), - {SpecFile,file:consult(SpecFile)} - end. - -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 -> - filename:join(TestDir, File ++ ".spec") - end. - -check_spec_filename(TestDir, File, Ext) -> - Spec = filename:join(TestDir, File ++ Ext), - case filelib:is_file(Spec) of - true -> Spec; - false -> filename:join(TestDir, File ++ ".spec") - end. - -%% Remove the top case from the spec file. We will add our own -%% top case later. - -remove_original_topcase(Vars, Spec, St) -> - {ok,Vars,filter(fun ({topcase,_}) -> false; - (_Other) -> true end, Spec),St}. - -%% Initialize our new top case. We'll keep in it the state to be -%% able to add more to it. - -init_topcase(Vars, Spec, St) -> - TestDir = St#state.test_dir, - TopCase = - case St#state.mod of - Mod when is_atom(Mod) -> - ModStr = atom_to_list(Mod), - case filelib:is_file(filename:join(TestDir,ModStr++".erl")) of - true -> [{Mod,all}]; - false -> - Wc = filename:join(TestDir, ModStr ++ "*_SUITE.erl"), - [{list_to_atom(filename:basename(M, ".erl")),all} || - M <- filelib:wildcard(Wc)] - end; - _Other -> - %% Here we used to return {dir,TestDir}. Now we instead - %% list all suites in TestDir, so we can add make testcases - %% around it later (see add_make_testcase) without getting - %% duplicates of the suite. (test_server_ctrl does no longer - %% check for duplicates of testcases) - Wc = filename:join(TestDir, "*_SUITE.erl"), - [{list_to_atom(filename:basename(M, ".erl")),all} || - M <- filelib:wildcard(Wc)] - end, - {ok,Vars,Spec,St#state{topcase=TopCase}}. - -%% Or if option keep_topcase was given, eh... keep the topcase -copy_topcase(Vars, Spec, St) -> - {value,{topcase,Tc}} = lists:keysearch(topcase,1,Spec), - {ok, Vars, lists:keydelete(topcase,1,Spec),St#state{topcase=Tc}}. - %% Run any "Makefile.first" files first. %% XXX We should fake a failing test case if the make fails. @@ -281,188 +152,14 @@ run_pre_makefile(Vars, Spec, St) -> {error,_Reason}=Error -> Error end. -%% Search for `Makefile.src' in each *_SUITE_data directory. - -find_makefiles(Vars, Spec, St) -> - Wc = filename:join(St#state.data_wc, "Makefile.src"), - Makefiles = reverse(del_skipped_suite_data_dir(filelib:wildcard(Wc), Spec)), - {ok,Vars,Spec,St#state{makefiles=Makefiles}}. - -%% Create "Makefile" from "Makefile.src". - -make_make(Vars, Spec, State) -> - Src = State#state.makefile, - Dest = filename:rootname(Src), - ts_lib:progress(Vars, 1, "Making ~s...\n", [Dest]), - case ts_lib:subst_file(Src, Dest, Vars) of - ok -> - {ok, Vars, Spec, State#state{makefile=Dest}}; - {error, Reason} -> - {error, {Src, Reason}} - end. - -%% Add a testcase which will do the making of the stuff in the data directory. - -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}}}; - _ -> - %% 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 - end. - -generate_make_module(MakeCmd, Name, ModuleString) -> - {ok,Host} = inet:gethostname(), - file:write_file(Name, - ["-module(",ModuleString,").\n", - "\n", - "-export([make/1,unmake/1]).\n", - "\n", - "make(Config) when is_list(Config) ->\n", - " Mins = " ++ integer_to_list(?DEFAULT_MAKE_TIMETRAP_MINUTES) ++ ",\n" - " test_server:format(\"=== Setting timetrap to ~p minutes ===~n\", [Mins]),\n" - " TimeTrap = test_server:timetrap(test_server:minutes(Mins)),\n" - " Res = ts_make:make([{make_command, \""++MakeCmd++"\"},{cross_node,\'ts@" ++ Host ++ "\'}|Config]),\n", - " test_server:timetrap_cancel(TimeTrap),\n" - " Res.\n" - "\n", - "unmake(Config) when is_list(Config) ->\n", - " Mins = " ++ integer_to_list(?DEFAULT_UNMAKE_TIMETRAP_MINUTES) ++ ",\n" - " test_server:format(\"=== Setting timetrap to ~p minutes ===~n\", [Mins]),\n" - " TimeTrap = test_server:timetrap(test_server:minutes(Mins)),\n" - " Res = ts_make:unmake([{make_command, \""++MakeCmd++"\"}|Config]),\n" - " test_server:timetrap_cancel(TimeTrap),\n" - " Res.\n" - "\n"]). - - -make_test_suite(Vars, _Spec, State) -> - TestDir = State#state.test_dir, - - Erl_flags=[{i, "../test_server"}|ts_lib:var(erl_flags,Vars)], - - case code:is_loaded(test_server_line) of - false -> code:load_file(test_server_line); - _ -> ok - end, - - {ok, Cwd} = file:get_cwd(), - ok = file:set_cwd(TestDir), - Result = (catch make:all(Erl_flags)), - ok = file:set_cwd(Cwd), - case Result of - up_to_date -> - ok; - {'EXIT', Reason} -> - %% If I return an error here, the test will be stopped - %% and it will not show up in the top index page. Instead - %% I return ok - the test will run for all existing suites. - %% It might be that there are old suites that are run, but - %% at least one suite is missing, and that is reported on the - %% top index page. - io:format("~s: {error,{make_crashed,~p}\n", - [State#state.file,Reason]), - ok; - error -> - %% See comment above - io:format("~s: {error,make_of_test_suite_failed}\n", - [State#state.file]), - ok - end. - -%% Add topcase to spec. - -add_topcase_to_spec(Vars, Spec, St) -> - Tc = case St#state.all of - {MakeMod,Config} -> - [{make,{MakeMod,make,[Config]}, - St#state.topcase, - {MakeMod,unmake,[Config]}}]; - undefined -> St#state.topcase - end, - {ok,Vars,Spec++[{topcase,Tc}],St}. - -%% Writes the (possibly transformed) spec file. - -write_spec_file(Vars, Spec, _State) -> - F = fun(Term) -> io_lib:format("~p.~n", [Term]) end, - SpecFile = map(F, Spec), - Hosts = - case lists:keysearch(hosts, 1, Vars) of - false -> - []; - {value, {hosts, HostList}} -> - io_lib:format("{hosts,~p}.~n",[HostList]) - end, - DiskLess = - case lists:keysearch(diskless, 1, Vars) of - false -> - []; - {value, {diskless, How}} -> - io_lib:format("{diskless, ~p}.~n",[How]) - end, - Conf = consult_config(), - MoreConfig = io_lib:format("~p.\n", [{config,Conf}]), - file:write_file("current.spec", [DiskLess,Hosts,MoreConfig,SpecFile]). - -consult_config() -> - {ok,Conf} = file:consult("ts.config"), - case os:type() of - {unix,_} -> consult_config("ts.unix.config", Conf); - {win32,_} -> consult_config("ts.win32.config", Conf); - vxworks -> consult_config("ts.vxworks.config", Conf); - _ -> Conf - end. - -consult_config(File, Conf0) -> - case file:consult(File) of - {ok,Conf} -> Conf++Conf0; - {error,enoent} -> Conf0 - end. +get_config_files() -> + TSConfig = "ts.config", + [TSConfig | case os:type() of + {unix,_} -> ["ts.unix.config"]; + {win32,_} -> ["ts.win32.config"]; + vxworks -> ["ts.vxworks.config"]; + _ -> [] + end]. %% Makes the command to start up the Erlang node to run the tests. @@ -476,6 +173,7 @@ backslashify([]) -> []. make_command(Vars, Spec, State) -> + {ok,Cwd} = file:get_cwd(), TestDir = State#state.test_dir, TestPath = filename:nativename(TestDir), Erl = case os:getenv("TS_RUN_VALGRIND") of @@ -506,7 +204,7 @@ make_command(Vars, Spec, State) -> {value,{erl_start_args,Args}} -> Args; false -> "" end, - CrashFile = State#state.file ++ "_erl_crash.dump", + CrashFile = filename:join(Cwd,State#state.file ++ "_erl_crash.dump"), case filelib:is_file(CrashFile) of true -> io:format("ts_run: Deleting dump: ~s\n",[CrashFile]), @@ -514,7 +212,8 @@ make_command(Vars, Spec, State) -> false -> ok end, - Cmd = [Erl, Naming, "test_server -pa ", $", TestPath, $", + %% NOTE: Do not use ' in these commands as it wont work on windows + Cmd = [Erl, Naming, "test_server" " -rsh ", ts_lib:var(rsh_name, Vars), " -env PATH \"", backslashify(lists:flatten([TestPath, path_separator(), @@ -524,15 +223,20 @@ make_command(Vars, Spec, State) -> %% uncomment the line below to disable exception formatting %% " -test_server_format_exception false", " -boot start_sasl -sasl errlog_type error", - " -s test_server_ctrl run_test ", State#state.test_server_args, + " -pz ",Cwd, + " -eval \"file:set_cwd(\\\"",TestDir,"\\\")\" " + " -eval \"ct:run_test(", + backslashify(lists:flatten(State#state.test_server_args)),")\"" " ", ExtraArgs], {ok, Vars, Spec, State#state{command=lists:flatten(Cmd)}}. + run_batch(Vars, _Spec, State) -> process_flag(trap_exit, true), Command = State#state.command ++ " -noinput -s erlang halt", ts_lib:progress(Vars, 1, "Command: ~s~n", [Command]), + io:format(user, "Command: ~s~n",[Command]), Port = open_port({spawn, Command}, [stream, in, eof]), tricky_print_data(Port). @@ -573,7 +277,7 @@ is_testnode_dead([{"test_server",_}|_]) -> false; is_testnode_dead([_|T]) -> is_testnode_dead(T). run_interactive(Vars, _Spec, State) -> - Command = State#state.command ++ " -s ts_reports make_index", + Command = State#state.command, ts_lib:progress(Vars, 1, "Command: ~s~n", [Command]), case ts_lib:var(os, Vars) of "Windows 95" -> @@ -623,80 +327,57 @@ path_separator() -> end. -make_test_server_args(Args0,Options,Vars) -> - Parameters = - case ts_lib:var(os, Vars) of - "VxWorks" -> - F = write_parameterfile(vxworks,Vars), - " PARAMETERS " ++ F; - "OSE" -> - F = write_parameterfile(ose,Vars), - " PARAMETERS " ++ F; - _ -> - "" - end, +make_common_test_args(Args0, Options, _Vars) -> Trace = case lists:keysearch(trace,1,Options) of {value,{trace,TI}} when is_tuple(TI); is_tuple(hd(TI)) -> ok = file:write_file(?tracefile,io_lib:format("~p.~n",[TI])), - " TRACE " ++ ?tracefile; + [{ct_trace,?tracefile}]; {value,{trace,TIFile}} when is_atom(TIFile) -> - " TRACE " ++ atom_to_list(TIFile); + [{ct_trace,atom_to_list(TIFile)}]; {value,{trace,TIFile}} -> - " TRACE " ++ TIFile; + [{ct_trace,TIFile}]; false -> - "" + [] end, Cover = case lists:keysearch(cover,1,Options) of - {value,{cover,App,File,Analyse}} -> - " COVER " ++ to_list(App) ++ " " ++ to_list(File) ++ " " ++ - to_list(Analyse); + {value,{cover, App, none, _Analyse}} -> + io:format("No cover file found for ~p~n",[App]), + []; + {value,{cover,_App,File,_Analyse}} -> + [{cover,to_list(File)}]; false -> - "" + [] end, - TCCallback = - case ts_lib:var(ts_testcase_callback, Vars) of - "" -> - ""; - {Mod,Func} -> - io:format("Function ~w:~w/4 will be called before and " - "after each test case.\n", [Mod,Func]), - " TESTCASE_CALLBACK " ++ to_list(Mod) ++ " " ++ to_list(Func); - ModFunc when is_list(ModFunc) -> - [Mod,Func]=string:tokens(ModFunc," "), - io:format("Function ~s:~s/4 will be called before and " - "after each test case.\n", [Mod,Func]), - " TESTCASE_CALLBACK " ++ ModFunc; - _ -> - "" - end, - Args0 ++ Parameters ++ Trace ++ Cover ++ TCCallback. + + Logdir = case lists:keysearch(logdir, 1, Options) of + {value,{logdir, _}} -> + []; + false -> + [{logdir,"../test_server"}] + end, + + ConfigPath = case {os:getenv("TEST_CONFIG_PATH"), + lists:keysearch(config, 1, Options)} of + {false,{value, {config, Path}}} -> + Path; + {false,false} -> + "../test_server"; + {Path,_} -> + Path + end, + ConfigFiles = [{config,[filename:join(ConfigPath,File) + || File <- get_config_files()]}], + + io_lib:format("~100000p",[Args0++Trace++Cover++Logdir++ + ConfigFiles++Options]). to_list(X) when is_atom(X) -> atom_to_list(X); to_list(X) when is_list(X) -> X. -write_parameterfile(Type,Vars) -> - Cross_host = ts_lib:var(target_host, Vars), - SlaveTargets = case lists:keysearch(slavetargets,1,Vars) of - {value, ST} -> - [ST]; - _ -> - [] - end, - Master = case lists:keysearch(master,1,Vars) of - {value,M} -> [M]; - false -> [] - end, - ToWrite = [{type,Type}, - {target, list_to_atom(Cross_host)}] ++ SlaveTargets ++ Master, - - Crossfile = atom_to_list(Type) ++ "parameters" ++ os:getpid(), - ok = file:write_file(Crossfile,io_lib:format("~p.~n", [ToWrite])), - Crossfile. - %% %% Paths and spaces handling for w2k and XP %% @@ -742,5 +423,3 @@ split_one(Path) -> split_path(Path) -> string:tokens(Path,";"). - - diff --git a/lib/test_server/test/Makefile b/lib/test_server/test/Makefile index 702d73f5af..0648c1f96a 100644 --- a/lib/test_server/test/Makefile +++ b/lib/test_server/test/Makefile @@ -27,11 +27,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES= \ test_server_SUITE \ test_server_line_SUITE \ - test_server_skip_SUITE \ - test_server_conf01_SUITE \ - test_server_conf02_SUITE \ - test_server_parallel01_SUITE \ - test_server_shuffle01_SUITE + test_server_test_lib ERL_FILES= $(MODULES:%=%.erl) @@ -52,6 +48,7 @@ RELSYSDIR = $(RELEASE_PATH)/test_server_test ERL_MAKE_FLAGS += -pa $(ERL_TOP)/lib/test_server/ebin ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/test EBIN = . @@ -88,7 +85,7 @@ release_spec: opt release_tests_spec: make_emakefile $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) $(COVERFILE) $(RELSYSDIR) - $(INSTALL_PROGRAM) test_server.spec $(RELSYSDIR) + $(INSTALL_DATA) test_server.spec test_server.cover $(RELSYSDIR) chmod -f -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) diff --git a/lib/test_server/test/test_server.cover b/lib/test_server/test/test_server.cover index c2366db166..5c59bab494 100644 --- a/lib/test_server/test/test_server.cover +++ b/lib/test_server/test/test_server.cover @@ -1,20 +1,22 @@ -{exclude,[test_server, - test_server_ctrl, - ts_selftest]}. +{incl_app,test_server,details}. -%% Using include list here because the test_server might not find +{excl_mods, test_server, [test_server, + test_server_ctrl, + ts_selftest]}. + +%% Using incl_mods list here because the test_server might not find %% lib_dir for test_server - and so it will not find which modules to %% compile. -{include,[erl2html2, - test_server_node, - test_server_sup, - ts, - ts_autoconf_vxworks, - ts_autoconf_win32, - ts_erl_config, - ts_install, - ts_lib, - ts_make, - ts_run, - vxworks_client]}. +{incl_mods, test_server, [erl2html2, + test_server_node, + test_server_sup, + ts, + ts_autoconf_vxworks, + ts_autoconf_win32, + ts_erl_config, + ts_install, + ts_lib, + ts_make, + ts_run, + vxworks_client]}. diff --git a/lib/test_server/test/test_server.spec b/lib/test_server/test/test_server.spec index 23b0b71963..a3b4d01d08 100644 --- a/lib/test_server/test/test_server.spec +++ b/lib/test_server/test/test_server.spec @@ -1,2 +1 @@ -{topcase, {dir, "../test_server_test"}}. -{skip,{test_server_SUITE,skip_case7,"This case should be noted as `Skipped'"}}. +{suites, "../test_server_test", all}. diff --git a/lib/test_server/test/test_server_SUITE.erl b/lib/test_server/test/test_server_SUITE.erl index dfe1028d3a..f4c19eeaf9 100644 --- a/lib/test_server/test/test_server_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 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 @@ -16,539 +16,149 @@ %% %% %CopyrightEnd% %% - -%%%------------------------------------------------------------------ -%%% Test Server self test. -%%%------------------------------------------------------------------ +%%%------------------------------------------------------------------- +%%% @author Lukas Larsson <[email protected]> +%%% @copyright (C) 2011, Erlang Solutions Ltd. +%%% @doc +%%% +%%% @end +%%% Created : 15 Feb 2011 by Lukas Larsson <[email protected]> +%%%------------------------------------------------------------------- -module(test_server_SUITE). --include_lib("test_server/include/test_server.hrl"). --include_lib("test_server/include/test_server_line.hrl"). --include_lib("kernel/include/file.hrl"). --export([all/1]). --export([init_per_suite/1, end_per_suite/1]). --export([init_per_testcase/2, end_per_testcase/2, fin_per_testcase/2]). --export([config/1, comment/1, timetrap/1, timetrap_cancel/1, multiply_timetrap/1, - init_per_s/1, init_per_tc/1, end_per_tc/1, - timeconv/1, msgs/1, capture/1, timecall/1, - do_times/1, do_times_mfa/1, do_times_fun/1, - skip_cases/1, skip_case1/1, skip_case2/1, skip_case3/1, - skip_case4/1, skip_case5/1, skip_case6/1, skip_case7/1, - skip_case8/1, skip_case9/1, undefined_functions/1, - conf_init/1, check_new_conf/1, conf_cleanup/1, - check_old_conf/1, conf_init_fail/1, start_stop_node/1, - cleanup_nodes_init/1, check_survive_nodes/1, cleanup_nodes_fin/1, - commercial/1]). +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include("test_server_test_lib.hrl"). --export([dummy_function/0,dummy_function/1,doer/1]). +%%-------------------------------------------------------------------- +%% COMMON TEST CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- -all(doc) -> ["Test Server self test"]; -all(suite) -> - [config, comment, timetrap, timetrap_cancel, multiply_timetrap, - init_per_s, init_per_tc, end_per_tc, - timeconv, msgs, capture, timecall, do_times, skip_cases, - undefined_functions, commercial, - {conf, conf_init, [check_new_conf], conf_cleanup}, - check_old_conf, - {conf, conf_init_fail,[conf_member_skip],conf_cleanup_skip}, - start_stop_node, - {conf, cleanup_nodes_init,[check_survive_nodes],cleanup_nodes_fin}, - config - ]. +%% @spec suite() -> Info +suite() -> + [{ct_hooks,[ts_install_cth,test_server_test_lib]}]. +%% @spec init_per_suite(Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} init_per_suite(Config) -> - [{init_per_suite_var,ok}|Config]. + [{path_dirs,[proplists:get_value(data_dir,Config)]} | Config]. +%% @spec end_per_suite(Config) -> _ end_per_suite(_Config) -> - ok. - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:minutes(2)), - Config1 = [{watchdog, Dog}|Config], - case Func of - init_per_tc -> - [{strange_var, 1}|Config1]; - skip_case8 -> - {skipped, "This case should be noted as `Skipped'"}; - skip_case9 -> - {skip, "This case should be noted as `Skipped'"}; - _ -> - Config1 - end; -init_per_testcase(Func, Config) -> - io:format("Func:~p",[Func]), - io:format("Config:~p",[Config]), - ?t:fail("Arguments to init_per_testcase not correct"). - -end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - case Func of - end_per_tc -> io:format("CLEANUP => this test case is ok\n"); - _Other -> ok - end; -end_per_testcase(Func, Config) -> - io:format("Func:~p",[Func]), - io:format("Config:~p",[Config]), - ?t:fail("Arguments to end_per_testcase not correct"). - -fin_per_testcase(Func, Config) -> - io:format("Func:~p",[Func]), - io:format("Config:~p",[Config]), - ?t:fail("fin_per_testcase/2 called, should have called end_per_testcase/2"). + io:format("TEST_SERVER_FRAMEWORK: ~p",[os:getenv("TEST_SERVER_FRAMEWORK")]), + ok. + +%% @spec init_per_group(GroupName, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +init_per_group(_GroupName, Config) -> + Config. + +%% @spec end_per_group(GroupName, Config0) -> +%% void() | {save_config,Config1} +end_per_group(_GroupName, _Config) -> + ok. + +%% @spec init_per_testcase(TestCase, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +init_per_testcase(_TestCase, Config) -> + Config. + +%% @spec end_per_testcase(TestCase, Config0) -> +%% void() | {save_config,Config1} | {fail,Reason} +end_per_testcase(_TestCase, _Config) -> + ok. + +%% @spec: groups() -> [Group] +groups() -> + []. + +%% @spec all() -> GroupsAndTestCases | {skip,Reason} +all() -> + [test_server_SUITE, test_server_parallel01_SUITE, + test_server_conf02_SUITE, test_server_conf01_SUITE, + test_server_skip_SUITE, test_server_shuffle01_SUITE]. + + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- +%% @spec TestCase(Config0) -> +%% ok | exit() | {skip,Reason} | {comment,Comment} | +%% {save_config,Config1} | {skip_and_save,Reason,Config1} +test_server_SUITE(Config) -> +% rpc:call(Node,dbg, tracer,[]), +% rpc:call(Node,dbg, p,[all,c]), +% rpc:call(Node,dbg, tpl,[test_server_ctrl,x]), + run_test_server_tests("test_server_SUITE", 39, 1, 31, + 20, 9, 1, 11, 2, 26, Config). + +test_server_parallel01_SUITE(Config) -> + run_test_server_tests("test_server_parallel01_SUITE", 37, 0, 19, + 19, 0, 0, 0, 0, 37, Config). + +test_server_shuffle01_SUITE(Config) -> + run_test_server_tests("test_server_shuffle01_SUITE", 130, 0, 0, + 76, 0, 0, 0, 0, 130, Config). + +test_server_skip_SUITE(Config) -> + run_test_server_tests("test_server_skip_SUITE", 3, 0, 1, + 0, 0, 1, 3, 0, 0, Config). + +test_server_conf01_SUITE(Config) -> + run_test_server_tests("test_server_conf01_SUITE", 24, 0, 12, + 12, 0, 0, 0, 0, 24, Config). + +test_server_conf02_SUITE(Config) -> + run_test_server_tests("test_server_conf02_SUITE", 26, 0, 12, + 12, 0, 0, 0, 0, 26, Config). + + +run_test_server_tests(SuiteName, NCases, NFail, NExpected, NSucc, + NUsrSkip, NAutoSkip, + NActualSkip, NActualFail, NActualSucc, Config) -> + Node = proplists:get_value(node, Config), + {ok,_Pid} = rpc:call(Node,test_server_ctrl, start, []), + rpc:call(Node, + test_server_ctrl,add_dir_with_skip, + [SuiteName, + [proplists:get_value(data_dir,Config)],SuiteName, + [{test_server_SUITE,skip_case7,"SKIPPED!"}]]), + + until(fun() -> + rpc:call(Node,test_server_ctrl,jobs,[]) =:= [] + end), - -config(suite) -> []; -config(doc) -> ["Test that the Config variable is decent, ", - "and that the std config variables are correct ", - "(check that data/priv dir exists)." - "Also check that ?config macro works."]; -config(Config) when is_list(Config) -> - is_tuplelist(Config), - {value,{data_dir,Dd}}=lists:keysearch(data_dir,1,Config), - {value,{priv_dir,Dp}}=lists:keysearch(priv_dir,1,Config), - true=is_dir(Dd), - {ok, _Bin}=file:read_file(filename:join(Dd, "dummy_file")), - true=is_dir(Dp), - - Dd = ?config(data_dir,Config), - Dp = ?config(priv_dir,Config), - ok; -config(_Config) -> - ?t:fail("Config variable is not a list."). - -is_tuplelist([]) -> - true; -is_tuplelist([{_A,_B}|Rest]) -> - is_tuplelist(Rest); -is_tuplelist(_) -> - false. - -is_dir(Dir) -> - case file:read_file_info(Dir) of - {ok, #file_info{type=directory}} -> - true; - _ -> - false - end. - -comment(suite) -> []; -comment(doc) -> ["Print a comment in the HTML log"]; -comment(Config) when is_list(Config) -> - ?t:comment("This comment should not occur in the HTML log because a later" - " comment shall overwrite it"), - ?t:comment("This comment is printed with the comment/1 function." - " It should occur in the HTML log"). - - - -timetrap(suite) -> []; -timetrap(doc) -> ["Test that timetrap works."]; -timetrap(Config) when is_list(Config) -> - TrapAfter = 3000, - Dog=?t:timetrap(TrapAfter), - process_flag(trap_exit, true), - TimeOut = TrapAfter * test_server:timetrap_scale_factor() + 1000, - receive - {'EXIT', Dog, {timetrap_timeout, _, _}} -> - ok; - {'EXIT', _OtherPid, {timetrap_timeout, _, _}} -> - ?t:fail("EXIT signal from wrong process") - after - TimeOut -> - ?t:fail("Timetrap is not working.") - end, - ?t:timetrap_cancel(Dog), - ok. - - -timetrap_cancel(suite) -> []; -timetrap_cancel(doc) -> ["Test that timetrap_cancel works."]; -timetrap_cancel(Config) when is_list(Config) -> - Dog=?t:timetrap(1000), - receive - after - 500 -> - ok - end, - ?t:timetrap_cancel(Dog), - receive - after 1000 -> - ok - end, - ok. - -multiply_timetrap(suite) -> []; -multiply_timetrap(doc) -> ["Test multiply timetrap"]; -multiply_timetrap(Config) when is_list(Config) -> - %% This simulates the call to test_server_ctrl:multiply_timetraps/1: - put(test_server_multiply_timetraps,2), - - Dog = ?t:timetrap(500), - timer:sleep(800), - ?t:timetrap_cancel(Dog), - - %% Reset - put(test_server_multiply_timetraps,1), - ok. - - -init_per_s(suite) -> []; -init_per_s(doc) -> ["Test that a Config that is altered in ", - "init_per_suite gets through to the testcases."]; -init_per_s(Config) -> - %% Check that the config var sent from init_per_suite - %% really exists. - {value, {init_per_suite_var, ok}} = - lists:keysearch(init_per_suite_var,1,Config), - - %% Check that the other variables still exist. - {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config), - {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config), - ok. - -init_per_tc(suite) -> []; -init_per_tc(doc) -> ["Test that a Config that is altered in ", - "init_per_testcase gets through to the ", - "actual testcase."]; -init_per_tc(Config) -> - %% Check that the config var sent from init_per_testcase - %% really exists. - {value, {strange_var, 1}} = lists:keysearch(strange_var,1,Config), - - %% Check that the other variables still exist. - {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config), - {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config), - ok. - -end_per_tc(suite) -> []; -end_per_tc(doc) -> ["Test that end_per_testcase/2 is called even if" - " test case fails"]; -end_per_tc(Config) when is_list(Config) -> - ?t:fail("This case should fail! Check that \"CLEANUP\" is" - " printed in the minor log file."). - - -timeconv(suite) -> []; -timeconv(doc) -> ["Test that the time unit conversion functions ", - "works."]; -timeconv(Config) when is_list(Config) -> - Val=2, - Secs=Val*1000, - Mins=Secs*60, - Hrs=Mins*60, - Secs=?t:seconds(2), - Mins=?t:minutes(2), - Hrs=?t:hours(2), - ok. - - -msgs(suite) -> []; -msgs(doc) -> ["Tests the messages_get function."]; -msgs(Config) when is_list(Config) -> - self() ! {hej, du}, - self() ! {lite, "data"}, - self() ! en_atom, - [{hej, du}, {lite, "data"}, en_atom] = ?t:messages_get(), - ok. - -capture(suite) -> []; -capture(doc) -> ["Test that the capture functions work properly."]; -capture(Config) when is_list(Config) -> - String1="abcedfghjiklmnopqrstuvwxyz", - String2="0123456789", - ?t:capture_start(), - io:format(String1), - [String1]=?t:capture_get(), - io:format(String2), - [String2]=?t:capture_get(), - ?t:capture_stop(), - []=?t:capture_get(), - io:format(String2), - []=?t:capture_get(), - ok. - -timecall(suite) -> []; -timecall(doc) -> ["Tests that timed calls work."]; -timecall(Config) when is_list(Config) -> - {_Time1, liten_apa_e_oxo_farlig} = ?t:timecall(?MODULE, dummy_function, []), - {Time2, jag_ar_en_gorilla} = ?t:timecall(?MODULE, dummy_function, [gorilla]), - DTime=round(Time2), - if - DTime<1 -> - ?t:fail("Timecall reported a too low time."); - DTime==1 -> + rpc:call(Node,test_server_ctrl, stop, []), + {ok,#suite{ n_cases = NCases, + n_cases_failed = NFail, + n_cases_expected = NExpected, + n_cases_succ = NSucc, + n_cases_user_skip = NUsrSkip, + n_cases_auto_skip = NAutoSkip, + cases = Cases }} = Data = + test_server_test_lib:parse_suite( + hd(filelib:wildcard( + filename:join([proplists:get_value(priv_dir, Config), + SuiteName++".logs","run*","suite.log"])))), + {NActualSkip,NActualFail,NActualSucc} = + lists:foldl(fun(#tc{ result = skip },{S,F,Su}) -> + {S+1,F,Su}; + (#tc{ result = ok },{S,F,Su}) -> + {S,F,Su+1}; + (#tc{ result = failed },{S,F,Su}) -> + {S,F+1,Su} + end,{0,0,0},Cases), + Data. + +until(Fun) -> + case Fun() of + true -> ok; - DTime>1 -> - ?t:fail("Timecall reported a too high time.") - end, - ok. - -dummy_function() -> - liten_apa_e_oxo_farlig. -dummy_function(gorilla) -> - receive after 1000 -> ok end, - jag_ar_en_gorilla. - - -do_times(suite) -> [do_times_mfa, do_times_fun]; -do_times(doc) -> ["Test the do_times function."]. - -do_times_mfa(suite) -> []; -do_times_mfa(doc) -> ["Test the do_times function with M,F,A given."]; -do_times_mfa(Config) when is_list(Config) -> - ?t:do_times(100, ?MODULE, doer, [self()]), - 100=length(?t:messages_get()), - ok. - -do_times_fun(suite) -> []; -do_times_fun(doc) -> ["Test the do_times function with fun given."]; -do_times_fun(Config) when is_list(Config) -> - Self = self(), - ?t:do_times(100, fun() -> doer(Self) end), - 100=length(?t:messages_get()), - ok. - -doer(From) -> - From ! a, - ok. - -skip_cases(doc) -> ["Test all possible ways to skip a test case."]; -skip_cases(suite) -> [skip_case1, skip_case2, skip_case3, skip_case4, - skip_case5, skip_case6, skip_case7, skip_case8, - skip_case9]. - -skip_case1(suite) -> []; -skip_case1(doc) -> ["Test that you can return {skipped, Reason}," - " and that Reason is in the comment field in the HTML log"]; -skip_case1(Config) when is_list(Config) -> - %% If this comment shows, the case failed!! - ?t:comment("ERROR: This case should have been noted as `Skipped'"), - %% The Reason in {skipped, Reason} should overwrite a 'comment' - {skipped, "This case should be noted as `Skipped'"}. - -skip_case2(suite) -> []; -skip_case2(doc) -> ["Test that you can return {skipped, Reason}," - " and that Reason is in the comment field in the HTML log"]; -skip_case2(Config) when is_list(Config) -> - %% If this comment shows, the case failed!! - ?t:comment("ERROR: This case should have been noted as `Skipped'"), - %% The Reason in {skipped, Reason} should overwrite a 'comment' - exit({skipped, "This case should be noted as `Skipped'"}). - -skip_case3(suite) -> []; -skip_case3(doc) -> ["Test that you can return {skip, Reason}," - " and that Reason is in the comment field in the HTML log"]; -skip_case3(Config) when is_list(Config) -> - %% If this comment shows, the case failed!! - ?t:comment("ERROR: This case should have been noted as `Skipped'"), - %% The Reason in {skip, Reason} should overwrite a 'comment' - {skip, "This case should be noted as `Skipped'"}. - -skip_case4(suite) -> []; -skip_case4(doc) -> ["Test that you can return {skip, Reason}," - " and that Reason is in the comment field in the HTML log"]; -skip_case4(Config) when is_list(Config) -> - %% If this comment shows, the case failed!! - ?t:comment("ERROR: This case should have been noted as `Skipped'"), - %% The Reason in {skip, Reason} should overwrite a 'comment' - exit({skip, "This case should be noted as `Skipped'"}). - -skip_case5(suite) -> {skipped, "This case should be noted as `Skipped'"}; -skip_case5(doc) -> ["Test that you can return {skipped, Reason}" - " from the specification clause"]. - -skip_case6(suite) -> {skip, "This case should be noted as `Skipped'"}; -skip_case6(doc) -> ["Test that you can return {skip, Reason}" - " from the specification clause"]. - -skip_case7(suite) -> []; -skip_case7(doc) -> ["Test that skip works from a test specification file"]; -skip_case7(Config) when is_list(Config) -> - %% This case shall be skipped by adding - %% {skip, {test_server_SUITE, skip_case7, Reason}}. - %% to the test specification file. - ?t:fail("This case should have been Skipped by the .spec file"). - -skip_case8(suite) -> []; -skip_case8(doc) -> ["Test that {skipped, Reason} works from" - " init_per_testcase/2"]; -skip_case8(Config) when is_list(Config) -> - %% This case shall be skipped by adding a specific clause to - %% returning {skipped, Reason} from init_per_testcase/2 for this case. - ?t:fail("This case should have been Skipped by init_per_testcase/2"). - -skip_case9(suite) -> []; -skip_case9(doc) -> ["Test that {skip, Reason} works from a init_per_testcase/2"]; -skip_case9(Config) when is_list(Config) -> - %% This case shall be skipped by adding a specific clause to - %% returning {skip, Reason} from init_per_testcase/2 for this case. - ?t:fail("This case should have been Skipped by init_per_testcase/2"). - -undefined_functions(suite) -> []; -undefined_functions(doc) -> ["Check for calls to undefined functions in" - " test_server." - "Skip if cover is running"]; -undefined_functions(Config) when is_list(Config) -> - case whereis(cover_server) of - Pid when is_pid(Pid) -> - {skip,"Cover is running"}; - undefined -> - undefined_functions() - end. - -undefined_functions() -> - TestServerDir = filename:dirname(code:which(test_server)), - Res = xref:d(TestServerDir), - - {value,{unused,Unused}} = lists:keysearch(unused, 1, Res), - case Unused of - [] -> ok; - _ -> - lists:foreach(fun (MFA) -> - io:format("~s unused", [format_mfa(MFA)]) - end, Unused) - end, - - {value,{undefined,Undef0}} = lists:keysearch(undefined, 1, Res), - Undef = [U || U <- Undef0, not unresolved(U)], - case Undef of - [] -> ok; - _ -> - lists:foreach(fun ({MFA1,MFA2}) -> - io:format("~s calls undefined ~s", - [format_mfa(MFA1),format_mfa(MFA2)]) - end, Undef), - ?t:fail({length(Undef),undefined_functions_in_otp}) - end, - ok. - -unresolved({_,{_,'$F_EXPR',_}}) -> true; -unresolved(_) -> false. - -format_mfa({M,F,A}) -> - lists:flatten(io_lib:format("~s:~s/~p", [M,F,A])). - -conf_init(doc) -> ["Test successful conf case: Change Config parameter"]; -conf_init(Config) when is_list(Config) -> - [{conf_init_var,1389}|Config]. - -check_new_conf(suite) -> []; -check_new_conf(doc) -> ["Check that Config parameter changed by" - " conf_init is used"]; -check_new_conf(Config) when is_list(Config) -> - 1389 = ?config(conf_init_var,Config), - ok. - -conf_cleanup(doc) -> ["Test successful conf case: Restore Config parameter"]; -conf_cleanup(Config) when is_list(Config) -> - lists:keydelete(conf_init_var,1,Config). - -check_old_conf(suite) -> []; -check_old_conf(doc) -> ["Test that the restored Config is used after a" - " conf cleanup"]; -check_old_conf(Config) when is_list(Config) -> - undefined = ?config(conf_init_var,Config), - ok. - -conf_init_fail(doc) -> ["Test that config members are skipped if" - " conf init function fails."]; -conf_init_fail(Config) when is_list(Config) -> - ?t:fail("This case should fail! Check that conf_member_skip and" - " conf_cleanup_skip are skipped."). - - - -start_stop_node(suite) -> []; -start_stop_node(doc) -> ["Test start and stop of slave and peer nodes"]; -start_stop_node(Config) when is_list(Config) -> - {ok,Node2} = ?t:start_node(node2,peer,[]), - {error, _} = ?t:start_node(node2,peer,[{fail_on_error,false}]), - true = lists:member(Node2,nodes()), - - {ok,Node3} = ?t:start_node(node3,slave,[]), - {error, _} = ?t:start_node(node3,slave,[]), - true = lists:member(Node3,nodes()), - - {ok,Node4} = ?t:start_node(node4,peer,[{wait,false}]), - case lists:member(Node4,nodes()) of - true -> - ?t:comment("WARNING: Node started with {wait,false}" - " is up faster than expected..."); false -> - wait_for_node(Node4,0), - true = lists:member(Node4,nodes()) - end, - - true = ?t:stop_node(Node2), - false = lists:member(Node2,nodes()), - - true = ?t:stop_node(Node3), - false = lists:member(Node3,nodes()), - - true = ?t:stop_node(Node4), - false = lists:member(Node4,nodes()), - timer:sleep(2000), - false = ?t:stop_node(Node4), - - ok. - - -wait_for_node(Node,Acc) -> - case net_adm:ping(Node) of - pang -> timer:sleep(100), - wait_for_node(Node,Acc+100); - pong -> - Acc + until(Fun) end. - -cleanup_nodes_init(doc) -> ["Test that nodes are terminated when test case" - " is finished unless {cleanup,false} is given."]; -cleanup_nodes_init(Config) when is_list(Config) -> - {ok,DieSlave} = ?t:start_node(die_slave, slave, []), - {ok,SurviveSlave} = ?t:start_node(survive_slave, slave, [{cleanup,false}]), - {ok,DiePeer} = ?t:start_node(die_peer, peer, []), - {ok,SurvivePeer} = ?t:start_node(survive_peer, peer, [{cleanup,false}]), - [{die_slave,DieSlave}, - {survive_slave,SurviveSlave}, - {die_peer,DiePeer}, - {survive_peer,SurvivePeer} | Config]. - - - -check_survive_nodes(suite) -> []; -check_survive_nodes(doc) -> ["Test that nodes with {cleanup,false} survived"]; -check_survive_nodes(Config) when is_list(Config) -> - timer:sleep(1000), - false = lists:member(?config(die_slave,Config),nodes()), - true = lists:member(?config(survive_slave,Config),nodes()), - false = lists:member(?config(die_peer,Config),nodes()), - true = lists:member(?config(survive_peer,Config),nodes()), - ok. - - -cleanup_nodes_fin(doc) -> ["Test that nodes started with {cleanup,false}" - " can be stopped"]; -cleanup_nodes_fin(Config) when is_list(Config) -> - Slave = ?config(survive_slave,Config), - Peer = ?config(survive_peer,Config), - - true = ?t:stop_node(Slave), - false = lists:member(Slave,nodes()), - true = ?t:stop_node(Peer), - false = lists:member(Peer,nodes()), - - C1 = lists:keydelete(die_slave,1,Config), - C2 = lists:keydelete(survive_slave,1,C1), - C3 = lists:keydelete(die_peer,1,C2), - lists:keydelete(survive_peer,1,C3). - -commercial(Config) when is_list(Config) -> - case ?t:is_commercial() of - false -> {comment,"Open-source build"}; - true -> {comment,"Commercial build"} - end. - - + diff --git a/lib/test_server/test/test_server_SUITE_data/Makefile.src b/lib/test_server/test/test_server_SUITE_data/Makefile.src new file mode 100644 index 0000000000..d5af919eec --- /dev/null +++ b/lib/test_server/test/test_server_SUITE_data/Makefile.src @@ -0,0 +1,2 @@ +all: + erlc *.erl
\ No newline at end of file diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl new file mode 100644 index 0000000000..0563e1104f --- /dev/null +++ b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl @@ -0,0 +1,554 @@ +%% +%% %CopyrightBegin% +%% +%% 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% +%% + +%%%------------------------------------------------------------------ +%%% Test Server self test. +%%%------------------------------------------------------------------ +-module(test_server_SUITE). +-include_lib("test_server/include/test_server.hrl"). +-include_lib("test_server/include/test_server_line.hrl"). +-include_lib("kernel/include/file.hrl"). +-export([all/1]). + +-export([init_per_suite/1, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2, fin_per_testcase/2]). +-export([config/1, comment/1, timetrap/1, timetrap_cancel/1, multiply_timetrap/1, + init_per_s/1, init_per_tc/1, end_per_tc/1, + timeconv/1, msgs/1, capture/1, timecall/1, + do_times/1, do_times_mfa/1, do_times_fun/1, + skip_cases/1, skip_case1/1, skip_case2/1, skip_case3/1, + skip_case4/1, skip_case5/1, skip_case6/1, skip_case7/1, + skip_case8/1, skip_case9/1, undefined_functions/1, + conf_init/1, check_new_conf/1, conf_cleanup/1, + check_old_conf/1, conf_init_fail/1, start_stop_node/1, + cleanup_nodes_init/1, check_survive_nodes/1, cleanup_nodes_fin/1, + commercial/1]). + +-export([dummy_function/0,dummy_function/1,doer/1]). + +all(doc) -> ["Test Server self test"]; +all(suite) -> + [config, comment, timetrap, timetrap_cancel, multiply_timetrap, + init_per_s, init_per_tc, end_per_tc, + timeconv, msgs, capture, timecall, do_times, skip_cases, + undefined_functions, commercial, + {conf, conf_init, [check_new_conf], conf_cleanup}, + check_old_conf, + {conf, conf_init_fail,[conf_member_skip],conf_cleanup_skip}, + start_stop_node, + {conf, cleanup_nodes_init,[check_survive_nodes],cleanup_nodes_fin}, + config + ]. + + +init_per_suite(Config) -> + [{init_per_suite_var,ok}|Config]. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog = ?t:timetrap(?t:minutes(2)), + Config1 = [{watchdog, Dog}|Config], + case Func of + init_per_tc -> + [{strange_var, 1}|Config1]; + skip_case8 -> + {skipped, "This case should be noted as `Skipped'"}; + skip_case9 -> + {skip, "This case should be noted as `Skipped'"}; + _ -> + Config1 + end; +init_per_testcase(Func, Config) -> + io:format("Func:~p",[Func]), + io:format("Config:~p",[Config]), + ?t:fail("Arguments to init_per_testcase not correct"). + +end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + case Func of + end_per_tc -> io:format("CLEANUP => this test case is ok\n"); + _Other -> ok + end; +end_per_testcase(Func, Config) -> + io:format("Func:~p",[Func]), + io:format("Config:~p",[Config]), + ?t:fail("Arguments to end_per_testcase not correct"). + +fin_per_testcase(Func, Config) -> + io:format("Func:~p",[Func]), + io:format("Config:~p",[Config]), + ?t:fail("fin_per_testcase/2 called, should have called end_per_testcase/2"). + + +config(suite) -> []; +config(doc) -> ["Test that the Config variable is decent, ", + "and that the std config variables are correct ", + "(check that data/priv dir exists)." + "Also check that ?config macro works."]; +config(Config) when is_list(Config) -> + is_tuplelist(Config), + {value,{data_dir,Dd}}=lists:keysearch(data_dir,1,Config), + {value,{priv_dir,Dp}}=lists:keysearch(priv_dir,1,Config), + true=is_dir(Dd), + {ok, _Bin}=file:read_file(filename:join(Dd, "dummy_file")), + true=is_dir(Dp), + + Dd = ?config(data_dir,Config), + Dp = ?config(priv_dir,Config), + ok; +config(_Config) -> + ?t:fail("Config variable is not a list."). + +is_tuplelist([]) -> + true; +is_tuplelist([{_A,_B}|Rest]) -> + is_tuplelist(Rest); +is_tuplelist(_) -> + false. + +is_dir(Dir) -> + case file:read_file_info(Dir) of + {ok, #file_info{type=directory}} -> + true; + _ -> + false + end. + +comment(suite) -> []; +comment(doc) -> ["Print a comment in the HTML log"]; +comment(Config) when is_list(Config) -> + ?t:comment("This comment should not occur in the HTML log because a later" + " comment shall overwrite it"), + ?t:comment("This comment is printed with the comment/1 function." + " It should occur in the HTML log"). + + + +timetrap(suite) -> []; +timetrap(doc) -> ["Test that timetrap works."]; +timetrap(Config) when is_list(Config) -> + TrapAfter = 3000, + Dog=?t:timetrap(TrapAfter), + process_flag(trap_exit, true), + TimeOut = TrapAfter * test_server:timetrap_scale_factor() + 1000, + receive + {'EXIT', Dog, {timetrap_timeout, _, _}} -> + ok; + {'EXIT', _OtherPid, {timetrap_timeout, _, _}} -> + ?t:fail("EXIT signal from wrong process") + after + TimeOut -> + ?t:fail("Timetrap is not working.") + end, + ?t:timetrap_cancel(Dog), + ok. + + +timetrap_cancel(suite) -> []; +timetrap_cancel(doc) -> ["Test that timetrap_cancel works."]; +timetrap_cancel(Config) when is_list(Config) -> + Dog=?t:timetrap(1000), + receive + after + 500 -> + ok + end, + ?t:timetrap_cancel(Dog), + receive + after 1000 -> + ok + end, + ok. + +multiply_timetrap(suite) -> []; +multiply_timetrap(doc) -> ["Test multiply timetrap"]; +multiply_timetrap(Config) when is_list(Config) -> + %% This simulates the call to test_server_ctrl:multiply_timetraps/1: + put(test_server_multiply_timetraps,{2,true}), + + Dog = ?t:timetrap(500), + timer:sleep(800), + ?t:timetrap_cancel(Dog), + + %% Reset + put(test_server_multiply_timetraps,1), + ok. + + +init_per_s(suite) -> []; +init_per_s(doc) -> ["Test that a Config that is altered in ", + "init_per_suite gets through to the testcases."]; +init_per_s(Config) -> + %% Check that the config var sent from init_per_suite + %% really exists. + {value, {init_per_suite_var, ok}} = + lists:keysearch(init_per_suite_var,1,Config), + + %% Check that the other variables still exist. + {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config), + {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config), + ok. + +init_per_tc(suite) -> []; +init_per_tc(doc) -> ["Test that a Config that is altered in ", + "init_per_testcase gets through to the ", + "actual testcase."]; +init_per_tc(Config) -> + %% Check that the config var sent from init_per_testcase + %% really exists. + {value, {strange_var, 1}} = lists:keysearch(strange_var,1,Config), + + %% Check that the other variables still exist. + {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config), + {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config), + ok. + +end_per_tc(suite) -> []; +end_per_tc(doc) -> ["Test that end_per_testcase/2 is called even if" + " test case fails"]; +end_per_tc(Config) when is_list(Config) -> + ?t:fail("This case should fail! Check that \"CLEANUP\" is" + " printed in the minor log file."). + + +timeconv(suite) -> []; +timeconv(doc) -> ["Test that the time unit conversion functions ", + "works."]; +timeconv(Config) when is_list(Config) -> + Val=2, + Secs=Val*1000, + Mins=Secs*60, + Hrs=Mins*60, + Secs=?t:seconds(2), + Mins=?t:minutes(2), + Hrs=?t:hours(2), + ok. + + +msgs(suite) -> []; +msgs(doc) -> ["Tests the messages_get function."]; +msgs(Config) when is_list(Config) -> + self() ! {hej, du}, + self() ! {lite, "data"}, + self() ! en_atom, + [{hej, du}, {lite, "data"}, en_atom] = ?t:messages_get(), + ok. + +capture(suite) -> []; +capture(doc) -> ["Test that the capture functions work properly."]; +capture(Config) when is_list(Config) -> + String1="abcedfghjiklmnopqrstuvwxyz", + String2="0123456789", + ?t:capture_start(), + io:format(String1), + [String1]=?t:capture_get(), + io:format(String2), + [String2]=?t:capture_get(), + ?t:capture_stop(), + []=?t:capture_get(), + io:format(String2), + []=?t:capture_get(), + ok. + +timecall(suite) -> []; +timecall(doc) -> ["Tests that timed calls work."]; +timecall(Config) when is_list(Config) -> + {_Time1, liten_apa_e_oxo_farlig} = ?t:timecall(?MODULE, dummy_function, []), + {Time2, jag_ar_en_gorilla} = ?t:timecall(?MODULE, dummy_function, [gorilla]), + DTime=round(Time2), + if + DTime<1 -> + ?t:fail("Timecall reported a too low time."); + DTime==1 -> + ok; + DTime>1 -> + ?t:fail("Timecall reported a too high time.") + end, + ok. + +dummy_function() -> + liten_apa_e_oxo_farlig. +dummy_function(gorilla) -> + receive after 1000 -> ok end, + jag_ar_en_gorilla. + + +do_times(suite) -> [do_times_mfa, do_times_fun]; +do_times(doc) -> ["Test the do_times function."]. + +do_times_mfa(suite) -> []; +do_times_mfa(doc) -> ["Test the do_times function with M,F,A given."]; +do_times_mfa(Config) when is_list(Config) -> + ?t:do_times(100, ?MODULE, doer, [self()]), + 100=length(?t:messages_get()), + ok. + +do_times_fun(suite) -> []; +do_times_fun(doc) -> ["Test the do_times function with fun given."]; +do_times_fun(Config) when is_list(Config) -> + Self = self(), + ?t:do_times(100, fun() -> doer(Self) end), + 100=length(?t:messages_get()), + ok. + +doer(From) -> + From ! a, + ok. + +skip_cases(doc) -> ["Test all possible ways to skip a test case."]; +skip_cases(suite) -> [skip_case1, skip_case2, skip_case3, skip_case4, + skip_case5, skip_case6, skip_case7, skip_case8, + skip_case9]. + +skip_case1(suite) -> []; +skip_case1(doc) -> ["Test that you can return {skipped, Reason}," + " and that Reason is in the comment field in the HTML log"]; +skip_case1(Config) when is_list(Config) -> + %% If this comment shows, the case failed!! + ?t:comment("ERROR: This case should have been noted as `Skipped'"), + %% The Reason in {skipped, Reason} should overwrite a 'comment' + {skipped, "This case should be noted as `Skipped'"}. + +skip_case2(suite) -> []; +skip_case2(doc) -> ["Test that you can return {skipped, Reason}," + " and that Reason is in the comment field in the HTML log"]; +skip_case2(Config) when is_list(Config) -> + %% If this comment shows, the case failed!! + ?t:comment("ERROR: This case should have been noted as `Skipped'"), + %% The Reason in {skipped, Reason} should overwrite a 'comment' + exit({skipped, "This case should be noted as `Skipped'"}). + +skip_case3(suite) -> []; +skip_case3(doc) -> ["Test that you can return {skip, Reason}," + " and that Reason is in the comment field in the HTML log"]; +skip_case3(Config) when is_list(Config) -> + %% If this comment shows, the case failed!! + ?t:comment("ERROR: This case should have been noted as `Skipped'"), + %% The Reason in {skip, Reason} should overwrite a 'comment' + {skip, "This case should be noted as `Skipped'"}. + +skip_case4(suite) -> []; +skip_case4(doc) -> ["Test that you can return {skip, Reason}," + " and that Reason is in the comment field in the HTML log"]; +skip_case4(Config) when is_list(Config) -> + %% If this comment shows, the case failed!! + ?t:comment("ERROR: This case should have been noted as `Skipped'"), + %% The Reason in {skip, Reason} should overwrite a 'comment' + exit({skip, "This case should be noted as `Skipped'"}). + +skip_case5(suite) -> {skipped, "This case should be noted as `Skipped'"}; +skip_case5(doc) -> ["Test that you can return {skipped, Reason}" + " from the specification clause"]. + +skip_case6(suite) -> {skip, "This case should be noted as `Skipped'"}; +skip_case6(doc) -> ["Test that you can return {skip, Reason}" + " from the specification clause"]. + +skip_case7(suite) -> []; +skip_case7(doc) -> ["Test that skip works from a test specification file"]; +skip_case7(Config) when is_list(Config) -> + %% This case shall be skipped by adding + %% {skip, {test_server_SUITE, skip_case7, Reason}}. + %% to the test specification file. + ?t:fail("This case should have been Skipped by the .spec file"). + +skip_case8(suite) -> []; +skip_case8(doc) -> ["Test that {skipped, Reason} works from" + " init_per_testcase/2"]; +skip_case8(Config) when is_list(Config) -> + %% This case shall be skipped by adding a specific clause to + %% returning {skipped, Reason} from init_per_testcase/2 for this case. + ?t:fail("This case should have been Skipped by init_per_testcase/2"). + +skip_case9(suite) -> []; +skip_case9(doc) -> ["Test that {skip, Reason} works from a init_per_testcase/2"]; +skip_case9(Config) when is_list(Config) -> + %% This case shall be skipped by adding a specific clause to + %% returning {skip, Reason} from init_per_testcase/2 for this case. + ?t:fail("This case should have been Skipped by init_per_testcase/2"). + +undefined_functions(suite) -> []; +undefined_functions(doc) -> ["Check for calls to undefined functions in" + " test_server." + "Skip if cover is running"]; +undefined_functions(Config) when is_list(Config) -> + case whereis(cover_server) of + Pid when is_pid(Pid) -> + {skip,"Cover is running"}; + undefined -> + undefined_functions() + end. + +undefined_functions() -> + TestServerDir = filename:dirname(code:which(test_server)), + Res = xref:d(TestServerDir), + + {value,{unused,Unused}} = lists:keysearch(unused, 1, Res), + case Unused of + [] -> ok; + _ -> + lists:foreach(fun (MFA) -> + io:format("~s unused", [format_mfa(MFA)]) + end, Unused) + end, + + {value,{undefined,Undef0}} = lists:keysearch(undefined, 1, Res), + Undef = [U || U <- Undef0, not unresolved(U)], + case Undef of + [] -> ok; + _ -> + lists:foreach(fun ({MFA1,MFA2}) -> + io:format("~s calls undefined ~s", + [format_mfa(MFA1),format_mfa(MFA2)]) + end, Undef), + ?t:fail({length(Undef),undefined_functions_in_otp}) + end, + ok. + +unresolved({_,{_,'$F_EXPR',_}}) -> true; +unresolved(_) -> false. + +format_mfa({M,F,A}) -> + lists:flatten(io_lib:format("~s:~s/~p", [M,F,A])). + +conf_init(doc) -> ["Test successful conf case: Change Config parameter"]; +conf_init(Config) when is_list(Config) -> + [{conf_init_var,1389}|Config]. + +check_new_conf(suite) -> []; +check_new_conf(doc) -> ["Check that Config parameter changed by" + " conf_init is used"]; +check_new_conf(Config) when is_list(Config) -> + 1389 = ?config(conf_init_var,Config), + ok. + +conf_cleanup(doc) -> ["Test successful conf case: Restore Config parameter"]; +conf_cleanup(Config) when is_list(Config) -> + lists:keydelete(conf_init_var,1,Config). + +check_old_conf(suite) -> []; +check_old_conf(doc) -> ["Test that the restored Config is used after a" + " conf cleanup"]; +check_old_conf(Config) when is_list(Config) -> + undefined = ?config(conf_init_var,Config), + ok. + +conf_init_fail(doc) -> ["Test that config members are skipped if" + " conf init function fails."]; +conf_init_fail(Config) when is_list(Config) -> + ?t:fail("This case should fail! Check that conf_member_skip and" + " conf_cleanup_skip are skipped."). + + + +start_stop_node(suite) -> []; +start_stop_node(doc) -> ["Test start and stop of slave and peer nodes"]; +start_stop_node(Config) when is_list(Config) -> + {ok,Node2} = ?t:start_node(node2,peer,[]), + {error, _} = ?t:start_node(node2,peer,[{fail_on_error,false}]), + true = lists:member(Node2,nodes()), + + {ok,Node3} = ?t:start_node(node3,slave,[]), + {error, _} = ?t:start_node(node3,slave,[]), + true = lists:member(Node3,nodes()), + + {ok,Node4} = ?t:start_node(node4,peer,[{wait,false}]), + case lists:member(Node4,nodes()) of + true -> + ?t:comment("WARNING: Node started with {wait,false}" + " is up faster than expected..."); + false -> + wait_for_node(Node4,0), + true = lists:member(Node4,nodes()) + end, + + true = ?t:stop_node(Node2), + false = lists:member(Node2,nodes()), + + true = ?t:stop_node(Node3), + false = lists:member(Node3,nodes()), + + true = ?t:stop_node(Node4), + false = lists:member(Node4,nodes()), + timer:sleep(2000), + false = ?t:stop_node(Node4), + + ok. + + +wait_for_node(Node,Acc) -> + case net_adm:ping(Node) of + pang -> + timer:sleep(100), + wait_for_node(Node,Acc+100); + pong -> + Acc + end. + +cleanup_nodes_init(doc) -> ["Test that nodes are terminated when test case" + " is finished unless {cleanup,false} is given."]; +cleanup_nodes_init(Config) when is_list(Config) -> + {ok,DieSlave} = ?t:start_node(die_slave, slave, []), + {ok,SurviveSlave} = ?t:start_node(survive_slave, slave, [{cleanup,false}]), + {ok,DiePeer} = ?t:start_node(die_peer, peer, []), + {ok,SurvivePeer} = ?t:start_node(survive_peer, peer, [{cleanup,false}]), + [{die_slave,DieSlave}, + {survive_slave,SurviveSlave}, + {die_peer,DiePeer}, + {survive_peer,SurvivePeer} | Config]. + + + +check_survive_nodes(suite) -> []; +check_survive_nodes(doc) -> ["Test that nodes with {cleanup,false} survived"]; +check_survive_nodes(Config) when is_list(Config) -> + timer:sleep(1000), + false = lists:member(?config(die_slave,Config),nodes()), + true = lists:member(?config(survive_slave,Config),nodes()), + false = lists:member(?config(die_peer,Config),nodes()), + true = lists:member(?config(survive_peer,Config),nodes()), + ok. + + +cleanup_nodes_fin(doc) -> ["Test that nodes started with {cleanup,false}" + " can be stopped"]; +cleanup_nodes_fin(Config) when is_list(Config) -> + Slave = ?config(survive_slave,Config), + Peer = ?config(survive_peer,Config), + + true = ?t:stop_node(Slave), + false = lists:member(Slave,nodes()), + true = ?t:stop_node(Peer), + false = lists:member(Peer,nodes()), + + C1 = lists:keydelete(die_slave,1,Config), + C2 = lists:keydelete(survive_slave,1,C1), + C3 = lists:keydelete(die_peer,1,C2), + lists:keydelete(survive_peer,1,C3). + +commercial(Config) when is_list(Config) -> + case ?t:is_commercial() of + false -> {comment,"Open-source build"}; + true -> {comment,"Commercial build"} + end. + + diff --git a/lib/test_server/test/test_server_SUITE_data/dummy_file b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file index 65c88fbd75..65c88fbd75 100644 --- a/lib/test_server/test/test_server_SUITE_data/dummy_file +++ b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file diff --git a/lib/test_server/test/test_server_conf01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl index a6d7dfe851..a6d7dfe851 100644 --- a/lib/test_server/test/test_server_conf01_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl diff --git a/lib/test_server/test/test_server_conf02_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl index deba4660c6..deba4660c6 100644 --- a/lib/test_server/test/test_server_conf02_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl diff --git a/lib/test_server/test/test_server_parallel01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl index 0e7f329f89..0e7f329f89 100644 --- a/lib/test_server/test/test_server_parallel01_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl diff --git a/lib/test_server/test/test_server_shuffle01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl index 7ad269501d..7ad269501d 100644 --- a/lib/test_server/test/test_server_shuffle01_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl diff --git a/lib/test_server/test/test_server_skip_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl index 4037e1cc0e..4037e1cc0e 100644 --- a/lib/test_server/test/test_server_skip_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl diff --git a/lib/test_server/test/test_server_line_SUITE.erl b/lib/test_server/test/test_server_line_SUITE.erl index 02897f164f..aa14862e5a 100644 --- a/lib/test_server/test/test_server_line_SUITE.erl +++ b/lib/test_server/test/test_server_line_SUITE.erl @@ -23,20 +23,29 @@ -module(test_server_line_SUITE). -include_lib("test_server/include/test_server.hrl"). --export([all/1]). --export([init_per_testcase/2, fin_per_testcase/2]). +-export([all/0,suite/0]). +-export([init_per_suite/1,end_per_suite/1, + init_per_testcase/2, end_per_testcase/2]). -export([parse_transform/1, lines/1]). -all(doc) -> ["Test of parse transform for collection line numbers"]; -all(suite) -> [parse_transform,lines]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {doc,["Test of parse transform for collection line numbers"]}]. +all() -> [parse_transform,lines]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. init_per_testcase(_Case, Config) -> ?line test_server_line:clear(), Dog = ?t:timetrap(?t:minutes(2)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> ?line test_server_line:clear(), Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog), diff --git a/lib/test_server/test/test_server_test_lib.erl b/lib/test_server/test/test_server_test_lib.erl new file mode 100644 index 0000000000..66ff06e0ce --- /dev/null +++ b/lib/test_server/test/test_server_test_lib.erl @@ -0,0 +1,191 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-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_test_lib). +-export([parse_suite/1]). +-export([init/2, pre_init_per_testcase/3, post_end_per_testcase/4]). + +-include("test_server_test_lib.hrl"). + +%% The CTH hooks all tests +init(_Id, _Opts) -> + []. + +pre_init_per_testcase(_TC,Config,State) -> + case os:type() of + {win32, _} -> + %% Extend timeout for windows as starting node + %% can take a long time there + test_server:timetrap( 120000 * test_server:timetrap_scale_factor()); + _ -> + ok + end, + {start_slave(Config, 50),State}. + +start_slave(Config,_Level) -> + [_,Host] = string:tokens(atom_to_list(node()), "@"), + + ct:log("Trying to start ~s~n", + ["test_server_tester@"++Host]), + case slave:start(Host, test_server_tester, []) of + {error,Reason} -> + test_server:fail(Reason); + {ok,Node} -> + ct:log("Node ~p started~n", [Node]), + IsCover = test_server:is_cover(), + if IsCover -> + cover:start(Node); + true-> + ok + end, + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + + %% PrivDir as well as directory of Test Server suites + %% have to be in code path on Test Server node. + [_ | Parts] = lists:reverse(filename:split(DataDir)), + TSDir = filename:join(lists:reverse(Parts)), + AddPathDirs = case proplists:get_value(path_dirs, Config) of + undefined -> []; + Ds -> Ds + end, + PathDirs = [PrivDir,TSDir | AddPathDirs], + [true = rpc:call(Node, code, add_patha, [D]) || D <- PathDirs], + io:format("Dirs added to code path (on ~w):~n", + [Node]), + [io:format("~s~n", [D]) || D <- PathDirs], + + true = rpc:call(Node, os, putenv, + ["TEST_SERVER_FRAMEWORK", "undefined"]), + + ok = rpc:call(Node, file, set_cwd, [PrivDir]), + [{node,Node} | Config] + end. + +post_end_per_testcase(_TC, Config, Return, State) -> + Node = proplists:get_value(node, Config), + cover:stop(Node), + slave:stop(Node), + + {Return, State}. + +%% Parse an .suite log file +parse_suite(FileName) -> + + case file:open(FileName, [read, raw, read_ahead]) of + {ok, Fd} -> + Data = parse_suite(Fd, #suite{ }), + file:close(Fd), + {ok, Data}; + _ -> + error + end. + +fline(Fd) -> + case prim_file:read_line(Fd) of + eof -> eof; + {ok, Line} -> Line + end. + +parse_suite(Fd, S) -> + _Started = fline(Fd), + _Starting = fline(Fd), + "=cases" ++ NCases = fline(Fd), + "=user" ++ _User = fline(Fd), + "=host" ++ Host = fline(Fd), + "=hosts" ++ _Hosts = fline(Fd), + "=emulator_vsn" ++ Evsn = fline(Fd), + "=emulator" ++ Emu = fline(Fd), + "=otp_release" ++ OtpRel = fline(Fd), + "=started" ++ Start = fline(Fd), + NewS = parse_cases(Fd, S#suite{ + n_cases_expected = list_to_int(clean(NCases)), + host = list_to_binary(clean(Host)), + emulator_vsn = list_to_binary(clean(Evsn)), + emulator = list_to_binary(clean(Emu)), + otp_release = list_to_binary(clean(OtpRel)), + started = list_to_binary(clean(Start)) + }), + "=failed" ++ Failed = fline(Fd), + "=successful" ++ Succ = fline(Fd), + "=user_skipped" ++ UsrSkip = fline(Fd), + "=auto_skipped" ++ AutSkip = fline(Fd), + NewS#suite{ n_cases_failed = list_to_int(clean(Failed)), + n_cases_succ = list_to_int(clean(Succ)), + n_cases_user_skip = list_to_int(clean(UsrSkip)), + n_cases_auto_skip = list_to_int(clean(AutSkip)) }. + + +parse_cases(Fd, #suite{ n_cases = N, + cases = Cases } = S) -> + case parse_case(Fd) of + finished -> S#suite{ log_ok = true }; + {eof, Tc} -> + S#suite{ n_cases = N + 1, + cases = [Tc#tc{ result = crashed }|Cases]}; + {ok, Case} -> + parse_cases(Fd, S#suite{ n_cases = N + 1, + cases = [Case|Cases]}) + end. + +parse_case(Fd) -> parse_case(Fd, #tc{}). +parse_case(Fd, Tc) -> parse_case(fline(Fd), Fd, Tc). + +parse_case(eof, _, Tc) -> {eof, Tc}; +parse_case("=case" ++ Case, Fd, Tc) -> + Name = list_to_binary(clean(Case)), + parse_case(fline(Fd), Fd, Tc#tc{ name = Name }); +parse_case("=logfile" ++ File, Fd, Tc) -> + Log = list_to_binary(clean(File)), + parse_case(fline(Fd), Fd, Tc#tc{ logfile = Log }); +parse_case("=elapsed" ++ Elapsed, Fd, Tc) -> + {ok, [Time], _} = io_lib:fread("~f", clean(Elapsed)), + parse_case(fline(Fd), Fd, Tc#tc{ elapsed = Time }); +parse_case("=result" ++ Result, _, Tc) -> + case clean(Result) of + "ok" ++ _ -> + {ok, Tc#tc{ result = ok } }; + "failed" ++ _ -> + {ok, Tc#tc{ result = failed } }; + "skipped" ++ _ -> + {ok, Tc#tc{ result = skip } } + end; +parse_case("=finished" ++ _ , _Fd, #tc{ name = undefined }) -> + finished; +parse_case(_, Fd, Tc) -> + parse_case(fline(Fd), Fd, Tc). + +skip([]) -> []; +skip([$ |Ts]) -> skip(Ts); +skip(Ts) -> Ts. + +%rmnl(L) -> L. +rmnl([]) -> []; +rmnl([$\n | Ts]) -> rmnl(Ts); +rmnl([T|Ts]) -> [T | rmnl(Ts)]. + +clean(L) -> + rmnl(skip(L)). + +list_to_int(L) -> + try + list_to_integer(L) + catch + _:_ -> + 0 + end. diff --git a/lib/test_server/test/test_server_test_lib.hrl b/lib/test_server/test/test_server_test_lib.hrl new file mode 100644 index 0000000000..27b7be9618 --- /dev/null +++ b/lib/test_server/test/test_server_test_lib.hrl @@ -0,0 +1,23 @@ +-record(tc, { + name, + result, + elapsed, + logfile + }). + +-record(suite, { + application, + n_cases = 0, + n_cases_failed = 0, + n_cases_expected = 0, + n_cases_succ, + n_cases_user_skip, + n_cases_auto_skip, + cases = [], + host, + emulator_vsn, + emulator, + otp_release, + started, + log_ok = false + }). diff --git a/lib/test_server/vsn.mk b/lib/test_server/vsn.mk index e3aac682ec..4e293b76a7 100644 --- a/lib/test_server/vsn.mk +++ b/lib/test_server/vsn.mk @@ -1,2 +1,2 @@ -TEST_SERVER_VSN = 3.3.6 +TEST_SERVER_VSN = 3.4.2 |