diff options
Diffstat (limited to 'lib/test_server')
| -rw-r--r-- | lib/test_server/doc/src/test_server.xml | 25 | ||||
| -rw-r--r-- | lib/test_server/src/configure.in | 27 | ||||
| -rw-r--r-- | lib/test_server/src/test_server.appup.src | 22 | ||||
| -rw-r--r-- | lib/test_server/src/test_server.erl | 46 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_ctrl.erl | 29 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_sup.erl | 311 | ||||
| -rw-r--r-- | lib/test_server/src/ts.erl | 92 |
7 files changed, 511 insertions, 41 deletions
diff --git a/lib/test_server/doc/src/test_server.xml b/lib/test_server/doc/src/test_server.xml index 4a47a8f45c..ed5569e1fe 100644 --- a/lib/test_server/doc/src/test_server.xml +++ b/lib/test_server/doc/src/test_server.xml @@ -625,6 +625,31 @@ Only valid for peer nodes. Note that slave nodes always </desc> </func> <func> + <name>appup_test(App) -> ok | test_server:fail()</name> + <fsummary>Checks an applications .appup file for obvious errors</fsummary> + <type> + <v>App = term()</v> + <d>The name of the application to test</d> + </type> + <desc> + <p>Checks an applications .appup file for obvious errors. + The following is checked: + </p> + <list type="bulleted"> + <item>syntax + </item> + <item>that .app file version and .appup file version match + </item> + <item>for non-library applications: validity of high-level upgrade + instructions, specifying no instructions is explicitly allowed + (in this case the application is not upgradeable)</item> + <item>for library applications: that there is exactly one wildcard + regexp clause restarting the application when upgrading or + downgrading from any version</item> + </list> + </desc> + </func> + <func> <name>comment(Comment) -> ok</name> <fsummary>Print a comment on the HTML result page</fsummary> <type> diff --git a/lib/test_server/src/configure.in b/lib/test_server/src/configure.in index 067663feb4..cd723bcd4d 100644 --- a/lib/test_server/src/configure.in +++ b/lib/test_server/src/configure.in @@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script for Erlang. dnl dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 1997-2013. All Rights Reserved. +dnl Copyright Ericsson AB 1997-2014. All Rights Reserved. dnl dnl The contents of this file are subject to the Erlang Public License, dnl Version 1.1, (the "License"); you may not use this file except in @@ -170,7 +170,30 @@ case $system in fi SHLIB_EXTRACT_ALL="" ;; - *-netbsd*|*-freebsd*|*-openbsd*|*-dragonfly*) + *-openbsd*) + # Not available on all versions: check for include file. + AC_CHECK_HEADER(dlfcn.h, [ + SHLIB_CFLAGS="-fpic" + SHLIB_LD="${CC}" + SHLIB_LDFLAGS="$LDFLAGS -shared" + SHLIB_SUFFIX=".so" + if test X${enable_m64_build} = Xyes; then + AC_MSG_ERROR(don't know how to link 64-bit dynamic drivers) + fi + if test X${enable_m32_build} = Xyes; then + AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers) + fi + ], [ + # No dynamic loading. + SHLIB_CFLAGS="" + SHLIB_LD="ld" + SHLIB_LDFLAGS="" + SHLIB_SUFFIX="" + AC_MSG_ERROR(don't know how to compile and link dynamic drivers) + ]) + SHLIB_EXTRACT_ALL="" + ;; + *-netbsd*|*-freebsd*|*-dragonfly*) # Not available on all versions: check for include file. AC_CHECK_HEADER(dlfcn.h, [ SHLIB_CFLAGS="-fpic" diff --git a/lib/test_server/src/test_server.appup.src b/lib/test_server/src/test_server.appup.src index 0fbe5f23f7..42c6fe2e46 100644 --- a/lib/test_server/src/test_server.appup.src +++ b/lib/test_server/src/test_server.appup.src @@ -1 +1,21 @@ -{"%VSN%",[],[]}.
\ No newline at end of file +%% -*- erlang -*- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +{"%VSN%", + [{<<".*">>,[{restart_application, test_server}]}], + [{<<".*">>,[{restart_application, test_server}]}] +}. diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 54be6d4c72..82672521f7 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -40,7 +40,7 @@ -export([call_crash/3,call_crash/4,call_crash/5]). -export([temp_name/1]). -export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]). --export([app_test/1, app_test/2]). +-export([app_test/1, app_test/2, appup_test/1]). -export([is_native/1]). -export([comment/1, make_priv_dir/0]). -export([os_type/0]). @@ -176,8 +176,6 @@ module_names(Beams) -> do_cover_compile(Modules) -> do_cover_compile1(lists:usort(Modules)). % remove duplicates -do_cover_compile1([Dont|Rest]) when Dont=:=cover -> - do_cover_compile1(Rest); do_cover_compile1([M|Rest]) -> case {code:is_sticky(M),code:is_loaded(M)} of {true,_} -> @@ -405,6 +403,7 @@ run_test_case_apply({CaseNum,Mod,Func,Args,Name, ref :: reference(), pid :: pid(), mf :: {atom(),atom()}, + last_known_loc :: term(), status :: tc_status() | 'undefined', ret_val :: term(), comment :: list(char()), @@ -436,8 +435,9 @@ run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> LogOpts, TCCallback) end), put(test_server_detected_fail, []), - St = #st{ref=Ref,pid=Pid,mf={Mod,Func},status=starting,ret_val=[], - comment="",timeout=infinity,config=hd(Args)}, + St = #st{ref=Ref,pid=Pid,mf={Mod,Func},last_known_loc=unknown, + status=starting,ret_val=[],comment="",timeout=infinity, + config=hd(Args)}, run_test_case_msgloop(St). %% Ugly bug (pre R5A): @@ -537,7 +537,22 @@ run_test_case_msgloop(#st{ref=Ref,pid=Pid,end_conf_pid=EndConfPid0}=St0) -> St = setup_termination(RetVal, St0#st{config=undefined}), run_test_case_msgloop(St); {'EXIT',Pid,Reason} -> - St = handle_tc_exit(Reason, St0), + %% This exit typically happens when an unknown external process + %% has caused a test case process to terminate (e.g. if a linked + %% process has crashed). + St = + case Reason of + {What,[Loc0={_M,_F,A,[{file,_}|_]}|_]} when + is_integer(A) -> + Loc = rewrite_loc_item(Loc0), + handle_tc_exit(What, St0#st{last_known_loc=[Loc]}); + {What,[Details,Loc0={_M,_F,A,[{file,_}|_]}|_]} when + is_integer(A) -> + Loc = rewrite_loc_item(Loc0), + handle_tc_exit({What,Details}, St0#st{last_known_loc=[Loc]}); + _ -> + handle_tc_exit(Reason, St0) + end, run_test_case_msgloop(St); {EndConfPid0,{call_end_conf,Data,_Result}} -> #st{mf={Mod,Func},config=CurrConf} = St0, @@ -695,7 +710,7 @@ handle_tc_exit(Reason, #st{config=Config,mf={Mod,Func0},pid=Pid, {testcase_aborted=E,AbortReason,Loc0} -> {{E,AbortReason},Loc0}; Other -> - {Other,unknown} + {Other,St#st.last_known_loc} end, Func = case Status of init_per_testcase=F -> {F,Func0}; @@ -837,9 +852,13 @@ spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) -> spawn_link(FwCall); spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) -> + Func1 = case Func of + {_InitOrEndPerTC,F} -> F; + F -> F + end, FwCall = fun() -> - case catch fw_error_notify(Mod,Func,[], + case catch fw_error_notify(Mod,Func1,[], Error,Loc) of {'EXIT',FwErrorNotifyErr} -> exit({fw_notify_done,error_notification, @@ -847,8 +866,8 @@ spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) -> _ -> ok end, - Conf = [{tc_status,{failed,timetrap_timeout}}|CurrConf], - case catch do_end_tc_call(Mod,Func, + Conf = [{tc_status,{failed,Error}}|CurrConf], + case catch do_end_tc_call(Mod,Func1, {Pid,Error,[Conf]},Error) of {'EXIT',FwEndTCErr} -> exit({fw_notify_done,end_tc,FwEndTCErr}); @@ -2429,8 +2448,11 @@ app_test(App) -> app_test(App, Mode) -> test_server_sup:app_test(App, Mode). -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% appup_test/1 +%% +appup_test(App) -> + test_server_sup:appup_test(App). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% is_native(Mod) -> true | false diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index e24d6ceacb..dcf905db24 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -487,6 +487,7 @@ init([]) -> ok end, test_server_sup:cleanup_crash_dumps(), + test_server_sup:util_start(), State = #state{jobs=[],finish=false}, TI0 = test_server:init_target_info(), TargetHost = test_server_sup:hoststr(), @@ -1055,6 +1056,7 @@ handle_info(_, State) -> %% test suites (if any) and any possible remainting slave node terminate(_Reason, State) -> + test_server_sup:util_stop(), case State#state.trc of false -> ok; Sock -> test_server_node:stop_tracer_node(Sock) @@ -1725,30 +1727,33 @@ make_html_link(LinkName, Target, Explanation) -> ok = write_html_file(LinkName, H). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% start_minor_log_file(Mod, Func) -> AbsName +%% start_minor_log_file(Mod, Func, ParallelTC) -> AbsName %% Mod = atom() %% Func = atom() +%% ParallelTC = bool() %% AbsName = string() %% %% Create a minor log file for the test case Mod,Func,Args. The log file -%% will be stored in the log directory under the name <Mod>.<Func>.log. -%% Some header info will also be inserted into the log file. +%% will be stored in the log directory under the name <Mod>.<Func>.html. +%% Some header info will also be inserted into the log file. If the test +%% case runs in a parallel group, then to avoid clashing file names if the +%% case is executed more than once, the name <Mod>.<Func>.<Timestamp>.html +%% is used. -start_minor_log_file(Mod, Func) -> +start_minor_log_file(Mod, Func, ParallelTC) -> MFA = {Mod,Func,1}, LogDir = get(test_server_log_dir_base), Name0 = lists:flatten(io_lib:format("~w.~w~ts", [Mod,Func,?html_ext])), Name = downcase(Name0), AbsName = filename:join(LogDir, Name), - case file:read_file_info(AbsName) of - {error,_} -> %% normal case, unique name + case (ParallelTC orelse (element(1,file:read_file_info(AbsName))==ok)) of + false -> %% normal case, unique name start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA); - {ok,_} -> %% special case, duplicate names - {_,S,Us} = now(), + true -> %% special case, duplicate names + Tag = test_server_sup:unique_name(), Name1_0 = - lists:flatten(io_lib:format("~w.~w.~w.~w~ts", [Mod,Func,S, - trunc(Us/1000), - ?html_ext])), + lists:flatten(io_lib:format("~w.~w.~ts~ts", [Mod,Func,Tag, + ?html_ext])), Name1 = downcase(Name1_0), AbsName1 = filename:join(LogDir, Name1), start_minor_log_file1(Mod, Func, LogDir, AbsName1, MFA) @@ -3631,7 +3636,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, TSDir = get(test_server_dir), print(major, "=case ~w:~w", [Mod, Func]), - MinorName = start_minor_log_file(Mod, Func), + MinorName = start_minor_log_file(Mod, Func, self() /= Main), print(minor, "<a name=\"top\"></a>", [], internal_raw), MinorBase = filename:basename(MinorName), print(major, "=logfile ~ts", [filename:basename(MinorName)]), diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 377aa21018..3cfa84a52f 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -29,10 +29,13 @@ hostatom/0, hostatom/1, hoststr/0, hoststr/1, framework_call/2,framework_call/3,framework_call/4, format_loc/1, - call_trace/1]). + util_start/0, util_stop/0, unique_name/0, + call_trace/1, + appup_test/1]). -include("test_server_internal.hrl"). -define(crash_dump_tar,"crash_dumps.tar.gz"). -define(src_listing_ext, ".src.html"). +-record(util_state, {starter, latest_name}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% timetrap(Timeout,Scale,Pid) -> Handle @@ -263,6 +266,249 @@ app_check_export_all([Mod|Mods]) -> end end. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% appup_test/1 +%% +%% Checks one applications .appup file for obvious errors. +%% Checks.. +%% * .. syntax +%% * .. that version in app file matches appup file version +%% * .. validity of appup instructions +%% +%% For library application this function checks that the proper +%% 'restart_application' upgrade and downgrade clauses exist. +appup_test(Application) -> + case is_app(Application) of + {ok, AppFile} -> + case is_appup(Application, proplists:get_value(vsn, AppFile)) of + {ok, Up, Down} -> + StartMod = proplists:get_value(mod, AppFile), + Modules = proplists:get_value(modules, AppFile), + do_appup_tests(StartMod, Application, Up, Down, Modules); + Error -> + test_server:fail(Error) + end; + Error -> + test_server:fail(Error) + end. + +is_appup(Application, Version) -> + AppupFile = atom_to_list(Application) ++ ".appup", + AppupPath = filename:join([code:lib_dir(Application), "ebin", AppupFile]), + case file:consult(AppupPath) of + {ok, [{Version, Up, Down}]} when is_list(Up), is_list(Down) -> + {ok, Up, Down}; + _ -> + test_server:format( + minor, + "Application upgrade (.appup) file not found, " + "or it has very bad syntax.~n"), + {error, appup_not_readable} + end. + +do_appup_tests(undefined, Application, Up, Down, _Modules) -> + %% library application + case Up of + [{<<".*">>, [{restart_application, Application}]}] -> + case Down of + [{<<".*">>, [{restart_application, Application}]}] -> + ok; + _ -> + test_server:format( + minor, + "Library application needs restart_application " + "downgrade instruction.~n"), + {error, library_downgrade_instruction_malformed} + end; + _ -> + test_server:format( + minor, + "Library application needs restart_application " + "upgrade instruction.~n"), + {error, library_upgrade_instruction_malformed} + end; +do_appup_tests(_, _Application, Up, Down, Modules) -> + %% normal application + case check_appup_clauses_plausible(Up, up, Modules) of + ok -> + case check_appup_clauses_plausible(Down, down, Modules) of + ok -> + test_server:format(minor, "OK~n"); + Error -> + test_server:format(minor, "ERROR ~p~n", [Error]), + test_server:fail(Error) + end; + Error -> + test_server:format(minor, "ERROR ~p~n", [Error]), + test_server:fail(Error) + end. + +check_appup_clauses_plausible([], _Direction, _Modules) -> + ok; +check_appup_clauses_plausible([{Re, Instrs} | Rest], Direction, Modules) + when is_binary(Re) -> + case re:compile(Re) of + {ok, _} -> + case check_appup_instructions(Instrs, Direction, Modules) of + ok -> + check_appup_clauses_plausible(Rest, Direction, Modules); + Error -> + Error + end; + {error, Error} -> + {error, {version_regex_malformed, Re, Error}} + end; +check_appup_clauses_plausible([{V, Instrs} | Rest], Direction, Modules) + when is_list(V) -> + case check_appup_instructions(Instrs, Direction, Modules) of + ok -> + check_appup_clauses_plausible(Rest, Direction, Modules); + Error -> + Error + end; +check_appup_clauses_plausible(Clause, _Direction, _Modules) -> + {error, {clause_malformed, Clause}}. + +check_appup_instructions(Instrs, Direction, Modules) -> + case check_instructions(Direction, Instrs, Instrs, [], [], Modules) of + {_Good, []} -> + ok; + {_, Bad} -> + {error, {bad_instructions, Bad}} + end. + +check_instructions(_, [], _, Good, Bad, _) -> + {lists:reverse(Good), lists:reverse(Bad)}; +check_instructions(UpDown, [Instr | Rest], All, Good, Bad, Modules) -> + case catch check_instruction(UpDown, Instr, All, Modules) of + ok -> + check_instructions(UpDown, Rest, All, [Instr | Good], Bad, Modules); + {error, Reason} -> + NewBad = [{Instr, Reason} | Bad], + check_instructions(UpDown, Rest, All, Good, NewBad, Modules) + end. + +check_instruction(up, {add_module, Module}, _, Modules) -> + %% A new module is added + check_module(Module, Modules); +check_instruction(down, {add_module, Module}, _, Modules) -> + %% An old module is re-added + case (catch check_module(Module, Modules)) of + {error, {unknown_module, Module, Modules}} -> ok; + ok -> throw({error, {existing_readded_module, Module}}) + end; +check_instruction(_, {load_module, Module}, _, Modules) -> + check_module(Module, Modules); +check_instruction(_, {load_module, Module, DepMods}, _, Modules) -> + check_module(Module, Modules), + check_depend(DepMods); +check_instruction(_, {load_module, Module, Pre, Post, DepMods}, _, Modules) -> + check_module(Module, Modules), + check_depend(DepMods), + check_purge(Pre), + check_purge(Post); +check_instruction(up, {delete_module, Module}, _, Modules) -> + case (catch check_module(Module, Modules)) of + {error, {unknown_module, Module, Modules}} -> + ok; + ok -> + throw({error,{existing_module_deleted, Module}}) + end; +check_instruction(down, {delete_module, Module}, _, Modules) -> + check_module(Module, Modules); +check_instruction(_, {update, Module}, _, Modules) -> + check_module(Module, Modules); +check_instruction(_, {update, Module, supervisor}, _, Modules) -> + check_module(Module, Modules); +check_instruction(_, {update, Module, DepMods}, _, Modules) + when is_list(DepMods) -> + check_module(Module, Modules); +check_instruction(_, {update, Module, Change}, _, Modules) -> + check_module(Module, Modules), + check_change(Change); +check_instruction(_, {update, Module, Change, DepMods}, _, Modules) -> + check_module(Module, Modules), + check_change(Change), + check_depend(DepMods); +check_instruction(_, {update, Module, Change, Pre, Post, DepMods}, _, Modules) -> + check_module(Module, Modules), + check_change(Change), + check_purge(Pre), + check_purge(Post), + check_depend(DepMods); +check_instruction(_, + {update, Module, Timeout, Change, Pre, Post, DepMods}, + _, + Modules) -> + check_module(Module, Modules), + check_timeout(Timeout), + check_change(Change), + check_purge(Pre), + check_purge(Post), + check_depend(DepMods); +check_instruction(_, + {update, Module, ModType, Timeout, Change, Pre, Post, DepMods}, + _, + Modules) -> + check_module(Module, Modules), + check_mod_type(ModType), + check_timeout(Timeout), + check_change(Change), + check_purge(Pre), + check_purge(Post), + check_depend(DepMods); +check_instruction(_, {restart_application, Application}, _, _) -> + check_application(Application); +check_instruction(_, {remove_application, Application}, _, _) -> + check_application(Application); +check_instruction(_, {add_application, Application}, _, _) -> + check_application(Application); +check_instruction(_, {add_application, Application, Type}, _, _) -> + check_application(Application), + check_restart_type(Type); +check_instruction(_, Instr, _, _) -> + throw({error, {low_level_or_invalid_instruction, Instr}}). + +check_module(Module, Modules) when is_atom(Module) -> + case {is_atom(Module), lists:member(Module, Modules)} of + {true, true} -> ok; + {true, false} -> throw({error, {unknown_module, Module}}); + {false, _} -> throw({error, {bad_module, Module}}) + end. + +check_application(App) -> + case is_atom(App) of + true -> ok; + false -> throw({error, {bad_application, App}}) + end. + +check_depend(Dep) when is_list(Dep) -> ok; +check_depend(Dep) -> throw({error, {bad_depend, Dep}}). + +check_restart_type(permanent) -> ok; +check_restart_type(transient) -> ok; +check_restart_type(temporary) -> ok; +check_restart_type(load) -> ok; +check_restart_type(none) -> ok; +check_restart_type(Type) -> throw({error, {bad_restart_type, Type}}). + +check_timeout(T) when is_integer(T), T > 0 -> ok; +check_timeout(default) -> ok; +check_timeout(infinity) -> ok; +check_timeout(T) -> throw({error, {bad_timeout, T}}). + +check_mod_type(static) -> ok; +check_mod_type(dynamic) -> ok; +check_mod_type(Type) -> throw({error, {bad_mod_type, Type}}). + +check_purge(soft_purge) -> ok; +check_purge(brutal_purge) -> ok; +check_purge(Purge) -> throw({error, {bad_purge, Purge}}). + +check_change(soft) -> ok; +check_change({advanced, _}) -> ok; +check_change(Change) -> throw({error, {bad_change, Change}}). + %% Given two sorted lists, L1 and L2, returns {NotInL2, NotInL1}, %% NotInL2 is the elements of L1 which don't occurr in L2, %% NotInL1 is the elements of L2 which don't ocurr in L1. @@ -583,6 +829,69 @@ downcase([], Result) -> lists:reverse(Result). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% util_start() -> ok +%% +%% Start local utility process +util_start() -> + Starter = self(), + case whereis(?MODULE) of + undefined -> + spawn_link(fun() -> + register(?MODULE, self()), + util_loop(#util_state{starter=Starter}) + end); + _Pid -> + ok + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% util_stop() -> ok +%% +%% Stop local utility process +util_stop() -> + try (?MODULE ! {self(),stop}) of + _ -> + receive {?MODULE,stopped} -> ok + after 5000 -> exit(whereis(?MODULE), kill) + end + catch + _:_ -> + ok + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% unique_name() -> string() +%% +unique_name() -> + ?MODULE ! {self(),unique_name}, + receive {?MODULE,Name} -> Name + after 5000 -> exit({?MODULE,no_util_process}) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% util_loop(State) -> ok +%% +util_loop(State) -> + receive + {From,unique_name} -> + {_,S,Us} = now(), + Ms = trunc(Us/1000), + Name = lists:flatten(io_lib:format("~w.~w", [S,Ms])), + if Name == State#util_state.latest_name -> + timer:sleep(1), + self() ! {From,unique_name}, + util_loop(State); + true -> + From ! {?MODULE,Name}, + util_loop(State#util_state{latest_name = Name}) + end; + {From,stop} -> + catch unlink(State#util_state.starter), + From ! {?MODULE,stopped}, + ok + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% call_trace(TraceSpecFile) -> ok %% %% Read terms on format {m,Mod} | {f,Mod,Func} diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index 189a71a8ce..11d6f7af4d 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/test_server/src/ts.erl @@ -212,6 +212,12 @@ run_all(_Vars) -> run_some([], _Opts) -> ok; +run_some([{Spec,Mod}|Specs], Opts) -> + case run(Spec, Mod, Opts) of + ok -> ok; + Error -> io:format("~p: ~p~n",[{Spec,Mod},Error]) + end, + run_some(Specs, Opts); run_some([Spec|Specs], Opts) -> case run(Spec, Opts) of ok -> ok; @@ -263,8 +269,17 @@ run(List, Opts) when is_list(List), is_list(Opts) -> run_some(List, Opts); %% run/2 -%% Runs one test spec with Options -run(Testspec, Config) when is_atom(Testspec), is_list(Config) -> +%% Runs one test spec with list of suites or with options +run(Testspec, ModsOrConfig) when is_atom(Testspec), + is_list(ModsOrConfig) -> + case is_list_of_suites(ModsOrConfig) of + false -> + run(Testspec, {config_list,ModsOrConfig}); + true -> + run_some([{Testspec,M} || M <- ModsOrConfig], + [batch]) + end; +run(Testspec, {config_list,Config}) -> Options=check_test_get_opts(Testspec, Config), IsSmoke=proplists:get_value(smoke,Config), File=atom_to_list(Testspec), @@ -310,34 +325,85 @@ run(Testspec, Config) when is_atom(Testspec), is_list(Config) -> run_test(File, [{spec,[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}, + run_test({atom_to_list(Testspec),Mod}, [{suite,Mod}], [interactive]). %% run/3 %% Run one module in a spec with Config -run(Testspec,Mod,Config) when is_atom(Testspec), is_atom(Mod), is_list(Config) -> +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}, - [{suite,Mod}], - Options); - -%% Runs one testcase in a module. -run(Testspec, Mod, Case) when is_atom(Testspec), is_atom(Mod), is_atom(Case) -> + run_test({atom_to_list(Testspec),Mod}, + [{suite,Mod}], Options); +%% Run multiple modules with Config +run(Testspec, Mods, Config) when is_atom(Testspec), + is_list(Mods), + is_list(Config) -> + run_some([{Testspec,M} || M <- Mods], Config); +%% Runs one test case in a module. +run(Testspec, Mod, Case) when is_atom(Testspec), + is_atom(Mod), + is_atom(Case) -> Options=check_test_get_opts(Testspec, []), - Args = [{suite,atom_to_list(Mod)},{testcase,atom_to_list(Case)}], + Args = [{suite,Mod},{testcase,Case}], + run_test(atom_to_list(Testspec), Args, Options); +%% Runs one or more groups in a module. +run(Testspec, Mod, Grs={group,_Groups}) when is_atom(Testspec), + is_atom(Mod) -> + Options=check_test_get_opts(Testspec, []), + Args = [{suite,Mod},Grs], + run_test(atom_to_list(Testspec), Args, Options); +%% Runs one or more test cases in a module. +run(Testspec, Mod, TCs={testcase,_Cases}) when is_atom(Testspec), + is_atom(Mod) -> + Options=check_test_get_opts(Testspec, []), + Args = [{suite,Mod},TCs], run_test(atom_to_list(Testspec), Args, Options). %% run/4 -%% Run one testcase in a module with Options. +%% Run one test case in a module with Options. 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 = [{suite,atom_to_list(Mod)}, {testcase,atom_to_list(Case)}], + Args = [{suite,Mod},{testcase,Case}], + run_test(atom_to_list(Testspec), Args, Options); +%% Run one or more test cases in a module with Options. +run(Testspec, Mod, {testcase,Cases}, Config) when is_atom(Testspec), + is_atom(Mod) -> + run(Testspec, Mod, Cases, Config); +run(Testspec, Mod, Cases, Config) when is_atom(Testspec), + is_atom(Mod), + is_list(Cases), + is_list(Config) -> + Options=check_test_get_opts(Testspec, Config), + Args = [{suite,Mod},Cases], + run_test(atom_to_list(Testspec), Args, Options); +%% Run one or more groups in a module with Options. +run(Testspec, Mod, Grs={group,_Groups}, Config) when is_atom(Testspec), + is_atom(Mod) -> + Options=check_test_get_opts(Testspec, Config), + Args = [{suite,Mod},Grs], run_test(atom_to_list(Testspec), Args, Options). + +is_list_of_suites(List) -> + lists:all(fun(Suite) -> + S = if is_atom(Suite) -> atom_to_list(Suite); + true -> Suite + end, + try lists:last(string:tokens(S,"_")) of + "SUITE" -> true; + "suite" -> true; + _ -> false + catch + _:_ -> false + end + end, List). + %% Create a spec to skip all SUITES, this is used when the application %% to be tested is not part of the OTP release to be tested. create_skip_spec(Testspec, SuitesToSkip) -> |