aboutsummaryrefslogtreecommitdiffstats
path: root/lib/test_server
diff options
context:
space:
mode:
Diffstat (limited to 'lib/test_server')
-rw-r--r--lib/test_server/doc/src/test_server.xml25
-rw-r--r--lib/test_server/src/configure.in27
-rw-r--r--lib/test_server/src/test_server.appup.src22
-rw-r--r--lib/test_server/src/test_server.erl46
-rw-r--r--lib/test_server/src/test_server_ctrl.erl29
-rw-r--r--lib/test_server/src/test_server_sup.erl311
-rw-r--r--lib/test_server/src/ts.erl92
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) ->