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/Makefile18
-rw-r--r--lib/test_server/doc/src/notes.xml149
-rw-r--r--lib/test_server/src/Makefile20
-rw-r--r--lib/test_server/src/configure.in34
-rw-r--r--lib/test_server/src/test_server.erl930
-rw-r--r--lib/test_server/src/test_server_ctrl.erl379
-rw-r--r--lib/test_server/src/test_server_h.erl46
-rw-r--r--lib/test_server/src/test_server_node.erl33
-rw-r--r--lib/test_server/src/test_server_sup.erl70
-rw-r--r--lib/test_server/src/ts.erl100
-rw-r--r--lib/test_server/src/ts.hrl1
-rw-r--r--lib/test_server/src/ts_autoconf_win32.erl1
-rw-r--r--lib/test_server/src/ts_erl_config.erl69
-rw-r--r--lib/test_server/src/ts_install.erl142
-rw-r--r--lib/test_server/src/ts_install_cth.erl48
-rw-r--r--lib/test_server/src/ts_lib.erl48
-rw-r--r--lib/test_server/src/ts_make.erl12
-rw-r--r--lib/test_server/src/ts_run.erl2
-rw-r--r--lib/test_server/test/Makefile10
-rw-r--r--lib/test_server/vsn.mk2
20 files changed, 1525 insertions, 589 deletions
diff --git a/lib/test_server/doc/src/Makefile b/lib/test_server/doc/src/Makefile
index b32f3d3c59..3ce549f0e1 100644
--- a/lib/test_server/doc/src/Makefile
+++ b/lib/test_server/doc/src/Makefile
@@ -119,16 +119,16 @@ clean clean_docs:
include $(ERL_TOP)/make/otp_release_targets.mk
release_docs_spec: docs
- $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf
- $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf
- $(INSTALL_DIR) $(RELSYSDIR)/doc/html
+ $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf"
+ $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf"
+ $(INSTALL_DIR) "$(RELSYSDIR)/doc/html"
$(INSTALL_DATA) $(HTMLDIR)/* \
- $(RELSYSDIR)/doc/html
- $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR)
- $(INSTALL_DIR) $(RELEASE_PATH)/man/man3
- $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3
- $(INSTALL_DIR) $(RELEASE_PATH)/man/man6
- $(INSTALL_DATA) $(MAN6_FILES) $(RELEASE_PATH)/man/man6
+ "$(RELSYSDIR)/doc/html"
+ $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)"
+ $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3"
+ $(INSTALL_DATA) $(MAN3_FILES) "$(RELEASE_PATH)/man/man3"
+ $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6"
+ $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6"
release_spec:
diff --git a/lib/test_server/doc/src/notes.xml b/lib/test_server/doc/src/notes.xml
index d90ad2c4ed..3701066e56 100644
--- a/lib/test_server/doc/src/notes.xml
+++ b/lib/test_server/doc/src/notes.xml
@@ -32,6 +32,155 @@
<file>notes.xml</file>
</header>
+<section><title>Test_Server 3.5.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ After a test case timeout or abortion, the
+ end_per_testcase function executes on a new dedicated
+ process. The group leader for this process should be set
+ to the IO server for the test case, which was not done
+ properly. The result of this error was that no warnings
+ about end_per_testcase failing or timing out were ever
+ printed in the test case log. Also, help functions such
+ as e.g. test_server:stop_node/1, attempting to
+ synchronize with the IO server, would hang. The fault has
+ been corrected.</p>
+ <p>
+ Own Id: OTP-9666</p>
+ </item>
+ <item>
+ <p>
+ A deadlock situation could occur if Common Test is
+ forwarding error_handler printouts to Test Server at the
+ same time a new test case is starting. This error has
+ been fixed.</p>
+ <p>
+ Own Id: OTP-9894</p>
+ </item>
+ <item>
+ <p>
+ When a test case was killed because of a timetrap
+ timeout, the current location (suite, case and line) was
+ not printed correctly in the log files. This has been
+ corrected.</p>
+ <p>
+ Own Id: OTP-9930 Aux Id: seq12002 </p>
+ </item>
+ <item>
+ <p>
+ Test Server and Common Test would add new error handlers
+ with each test run and fail to remove previously added
+ ones. In the case of Test Server, this would only happen
+ if SASL was not running on the test node. This has been
+ fixed.</p>
+ <p>
+ Own Id: OTP-9941 Aux Id: seq12009 </p>
+ </item>
+ <item>
+ <p>
+ If a test case process was terminated due to an exit
+ signal from a linked process, Test Server failed to
+ report the correct name of the suite and case to the
+ framework. This has been corrected.</p>
+ <p>
+ Own Id: OTP-9958 Aux Id: OTP-9855 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ A new optional feature has been introduced that enables
+ Common Test to generate priv_dir directory names that are
+ unique for each test case or config function. The name of
+ the option/flag is 'create_priv_dir' and it can be set to
+ value 'auto_per_run' (which is the default, existing,
+ behaviour), or 'auto_per_tc' or 'manual_per_tc'. If
+ 'auto_per_tc' is used, Test Server creates a dedicated
+ priv_dir automatically for each test case (which can be
+ very expensive in case of many and/or repeated cases). If
+ 'manual_per_tc' is used, the user needs to create the
+ priv_dir explicitly by calling the new function
+ ct:make_priv_dir/0.</p>
+ <p>
+ Own Id: OTP-9659 Aux Id: seq11930 </p>
+ </item>
+ <item>
+ <p>
+ A column for test case group name has been added to the
+ suite overview HTML log file.</p>
+ <p>
+ Own Id: OTP-9730 Aux Id: seq11952 </p>
+ </item>
+ <item>
+ <p>
+ It is now possible to use the post_end_per_testcase CT
+ hook function to print a comment for a test case in the
+ overview log file, even if the test case gets killed by a
+ timetrap or unknown exit signal, or if the
+ end_per_testcase function times out.</p>
+ <p>
+ Own Id: OTP-9855 Aux Id: seq11979 </p>
+ </item>
+ <item>
+ <p>
+ Common Test will now print error information (with a time
+ stamp) in the test case log file immediately when a test
+ case fails. This makes it easier to see when, in time,
+ the fault actually occured, and aid the job of locating
+ relevant trace and debug printouts in the log.</p>
+ <p>
+ Own Id: OTP-9904 Aux Id: seq11985, OTP-9900 </p>
+ </item>
+ <item>
+ <p>
+ Test Server has been modified to check the SASL
+ errlog_type parameter when receiving an error logger
+ event, so that it doesn't print reports of type that the
+ user has disabled.</p>
+ <p>
+ Own Id: OTP-9955 Aux Id: seq12013 </p>
+ </item>
+ <item>
+ <p>
+ If an application cannot be found by ts it is
+ automatically skipped when testing.</p>
+ <p>
+ Own Id: OTP-9971</p>
+ </item>
+ <item>
+ <p>
+ By specifying a user defined function ({M,F,A} or fun) as
+ timetrap value, either by means of an info function or by
+ calling ct:timetrap/1, it is now possible to set a
+ timetrap that will be triggered when the user function
+ returns.</p>
+ <p>
+ Own Id: OTP-9988 Aux Id: OTP-9501, seq11894 </p>
+ </item>
+ <item>
+ <p>
+ If the optional configuration functions init_per_suite/1
+ and end_per_suite/1 are not implemented in the test
+ suite, local Common Test versions of these functions are
+ called instead, and will be displayed in the overview log
+ file. Any printouts made by the pre- or
+ post_init_per_suite and pre- or post_end_per_suite hook
+ functions are saved in the log files for these functions.</p>
+ <p>
+ Own Id: OTP-9992</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Test_Server 3.5</title>
<section><title>Improvements and New Features</title>
diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile
index 4bc51873c2..a75855eaab 100644
--- a/lib/test_server/src/Makefile
+++ b/lib/test_server/src/Makefile
@@ -124,22 +124,22 @@ $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
include $(ERL_TOP)/make/otp_release_targets.mk
release_spec: opt
- $(INSTALL_DIR) $(RELSYSDIR)/src
- $(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR)/src
- $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src
- $(INSTALL_DIR) $(RELSYSDIR)/include
- $(INSTALL_DATA) $(HRL_FILES) $(RELSYSDIR)/include
- $(INSTALL_DIR) $(RELSYSDIR)/ebin
- $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+ $(INSTALL_DIR) "$(RELSYSDIR)/src"
+ $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)/src"
+ $(INSTALL_DATA) $(INTERNAL_HRL_FILES) "$(RELSYSDIR)/src"
+ $(INSTALL_DIR) "$(RELSYSDIR)/include"
+ $(INSTALL_DATA) $(HRL_FILES) "$(RELSYSDIR)/include"
+ $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
+ $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin"
release_tests_spec: opt
- $(INSTALL_DIR) $(RELEASE_PATH)/test_server
+ $(INSTALL_DIR) "$(RELEASE_PATH)/test_server"
$(INSTALL_DATA) $(ERL_FILES) $(TS_ERL_FILES) \
$(HRL_FILES) $(INTERNAL_HRL_FILES) $(TS_HRL_FILES) \
$(TS_TARGET_FILES) \
$(AUTOCONF_FILES) $(C_FILES) $(COVER_FILES) $(CONFIG) \
- $(RELEASE_PATH)/test_server
- $(INSTALL_SCRIPT) $(PROGRAMS) $(RELEASE_PATH)/test_server
+ "$(RELEASE_PATH)/test_server"
+ $(INSTALL_SCRIPT) $(PROGRAMS) "$(RELEASE_PATH)/test_server"
release_docs_spec:
diff --git a/lib/test_server/src/configure.in b/lib/test_server/src/configure.in
index 097853bcfc..77bc993ccd 100644
--- a/lib/test_server/src/configure.in
+++ b/lib/test_server/src/configure.in
@@ -108,7 +108,7 @@ AC_CHECK_HEADER(poll.h, AC_DEFINE(HAVE_POLL_H))
# for the system.
AC_MSG_CHECKING([system version (for dynamic loading)])
-system=`uname -s`-`uname -r`
+system=`./config.sub $host`
AC_MSG_RESULT($system)
# Step 2: check for existence of -ldl library. This is needed because
@@ -119,10 +119,9 @@ AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no)
# Step 3: set configuration options based on system name and version.
SHLIB_LDLIBS=
-
fullSrcDir=`cd $srcdir; pwd`
case $system in
- Linux*)
+ *-linux-*)
SHLIB_CFLAGS="-fPIC"
SHLIB_SUFFIX=".so"
if test "$have_dl" = yes; then
@@ -136,7 +135,7 @@ case $system in
fi
SHLIB_EXTRACT_ALL=""
;;
- NetBSD-*|FreeBSD-*|OpenBSD-*|DragonFly*)
+ *-netbsd*|*-freebsd*|*-openbsd*|*-dragonfly*)
# Not available on all versions: check for include file.
AC_CHECK_HEADER(dlfcn.h, [
SHLIB_CFLAGS="-fpic"
@@ -153,28 +152,21 @@ case $system in
])
SHLIB_EXTRACT_ALL=""
;;
- SunOS-4*)
- SHLIB_CFLAGS="-PIC"
- SHLIB_LD="ld"
- SHLIB_LDFLAGS="$LDFLAGS"
- SHLIB_SUFFIX=".so"
- SHLIB_EXTRACT_ALL=""
- ;;
- SunOS-5*|UNIX_SV-4.2*)
+ *-solaris2*|*-sysv4*)
SHLIB_CFLAGS="-KPIC"
SHLIB_LD="/usr/ccs/bin/ld"
SHLIB_LDFLAGS="$LDFLAGS -G -z text"
SHLIB_SUFFIX=".so"
SHLIB_EXTRACT_ALL="-z allextract"
;;
- Darwin*)
+ *darwin*)
SHLIB_CFLAGS="-fno-common"
SHLIB_LD="cc"
SHLIB_LDFLAGS="$LDFLAGS -bundle -flat_namespace -undefined suppress"
SHLIB_SUFFIX=".so"
SHLIB_EXTRACT_ALL=""
;;
- OSF1*)
+ *osf1*)
SHLIB_CFLAGS="-fPIC"
SHLIB_LD="ld"
SHLIB_LDFLAGS="$LDFLAGS -shared"
@@ -206,19 +198,19 @@ esac
if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
case $system in
- AIX-*)
+ *-aix)
;;
- BSD/OS*)
+ *-bsd*)
;;
- IRIX*)
+ *-irix)
;;
- NetBSD-*|FreeBSD-*|OpenBSD-*)
+ *-netbsd|*-freebsd|*-openbsd)
;;
- RISCos-*)
+ *-riscos)
;;
- ULTRIX-4.*)
+ *ultrix4.*)
;;
- Darwin*)
+ *darwin*)
;;
*)
SHLIB_CFLAGS="-fPIC"
diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl
index 51754cb3b4..17c5f5b253 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/test_server/src/test_server.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -35,6 +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([permit_io/2]).
-export([hours/1,minutes/1,seconds/1,sleep/1,adjusted_sleep/1,timecall/3]).
-export([timetrap_scale_factor/0,timetrap/1,get_timetrap_info/0,
timetrap_cancel/1,timetrap_cancel/0]).
@@ -44,12 +45,12 @@
-export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]).
-export([app_test/1, app_test/2]).
-export([is_native/1]).
--export([comment/1]).
+-export([comment/1, make_priv_dir/0]).
-export([os_type/0]).
-export([run_on_shielded_node/2]).
-export([is_cover/0,is_debug/0,is_commercial/0]).
--export([break/1,continue/0]).
+-export([break/1,break/2,break/3,continue/0,continue/1]).
%%% DEBUGGER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([purify_new_leaks/0, purify_format/2, purify_new_fds_inuse/0,
@@ -523,7 +524,7 @@ stick_all_sticky(Node,Sticky) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% run_test_case_apply(Mod,Func,Args,Name,RunInit,TimetrapData) ->
+%% run_test_case_apply(Mod,Func,Args,Name,RunInit,TimetrapData,RejectIoReqs) ->
%% {Time,Value,Loc,Opts,Comment} | {died,Reason,unknown,Comment}
%%
%% Time = float() (seconds)
@@ -558,8 +559,12 @@ stick_all_sticky(Node,Sticky) ->
%% ScaleTimetrap indicates if test_server should attemp to automatically
%% compensate timetraps for runtime delays introduced by e.g. tools like
%% cover.
+%%
+%% RejectIoReqs (bool) is information about whether printouts to stdout
+%% should be visible in the minor log file or not.
-run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,TimetrapData}) ->
+run_test_case_apply({CaseNum,Mod,Func,Args,Name,
+ RunInit,TimetrapData,RejectIoReqs}) ->
purify_format("Test case #~w ~w:~w/1", [CaseNum, Mod, Func]),
case os:getenv("TS_RUN_VALGRIND") of
false ->
@@ -570,17 +575,19 @@ run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,TimetrapData}) ->
end,
test_server_h:testcase({Mod,Func,1}),
ProcBef = erlang:system_info(process_count),
- Result = run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData),
+ Result = run_test_case_apply(Mod, Func, Args, Name, RunInit,
+ TimetrapData, RejectIoReqs),
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, TimetrapData) ->
+run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData, RejectIoReqs) ->
case get(test_server_job_dir) of
undefined ->
%% i'm a local target
- do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData);
+ do_run_test_case_apply(Mod, Func, Args, Name, RunInit,
+ TimetrapData, RejectIoReqs);
JobDir ->
%% i'm a remote target
case Args of
@@ -595,13 +602,14 @@ run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
Config2 = lists:keyreplace(priv_dir, 1, Config1,
{priv_dir,TargetPrivDir}),
do_run_test_case_apply(Mod, Func, [Config2], Name, RunInit,
- TimetrapData);
+ TimetrapData, RejectIoReqs);
_other ->
do_run_test_case_apply(Mod, Func, Args, Name, RunInit,
- TimetrapData)
+ TimetrapData, RejectIoReqs)
end
end.
-do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
+do_run_test_case_apply(Mod, Func, Args, Name, RunInit,
+ TimetrapData, RejectIoReqs) ->
{ok,Cwd} = file:get_cwd(),
Args2Print = case Args of
[Args1] when is_list(Args1) ->
@@ -628,7 +636,8 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
end),
group_leader(OldGLeader, self()),
put(test_server_detected_fail, []),
- run_test_case_msgloop(Ref, Pid, false, false, "", undefined).
+ run_test_case_msgloop(Ref, Pid, false, RejectIoReqs, false, "",
+ undefined, starting).
%% Ugly bug (pre R5A):
%% If this process (group leader of the test case) terminates before
@@ -639,19 +648,37 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
%% A test case is known to have failed if it returns {'EXIT', _} tuple,
%% or sends a message {failed, File, Line} to it's group_leader
%%
-run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
+run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
+ Comment, CurrConf, Status) ->
%% NOTE: Keep job_proxy_msgloop/0 up to date when changes
%% are made in this function!
{Timeout,ReturnValue} =
case Terminate of
{true, ReturnVal} ->
+ %% stop any timetrap timers for the test case
+ %% that have been started by this process
+ timetrap_cancel_all(Pid, false),
{20, ReturnVal};
false ->
{infinity, should_never_appear}
end,
receive
+ {test_case_initialized,Pid} ->
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,running);
+ Abort = {abort_current_testcase,_,_} when Status == starting ->
+ %% we're in init phase, must must postpone this operation
+ %% until test case execution is in progress (or FW:init_tc
+ %% gets killed)
+ self() ! Abort,
+ erlang:yield(),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{abort_current_testcase,Reason,From} ->
- Line = get_loc(Pid),
+ Line = case is_process_alive(Pid) of
+ true -> get_loc(Pid);
+ false -> unknown
+ end,
Mon = erlang:monitor(process, Pid),
exit(Pid,{testcase_aborted,Reason,Line}),
erlang:yield(),
@@ -665,76 +692,104 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
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])),
+ Error = lists:flatten(io_lib:format("Aborted: ~p",
+ [Reason])),
Error1 = lists:flatten([string:strip(S,left) ||
- S <- string:tokens(Error,[$\n])]),
+ S <- string:tokens(Error,
+ [$\n])]),
if length(Error1) > 63 ->
string:substr(Error1,1,60) ++ "...";
true ->
Error1
end
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,NewComment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ NewComment,CurrConf,Status);
+ {permit_io,FromPid} ->
+ put({permit_io,FromPid},true),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{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,CurrConf);
+ run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs,
+ Msg,From,Func),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{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,CurrConf);
+ run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs,
+ Msg,From,Func),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{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,CurrConf);
+ run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs,
+ Bytes,From,put_chars),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{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,CurrConf);
+ run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs,
+ Msg,From,Func),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{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,CurrConf);
+ run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs,
+ Msg,From,Func),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{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,CurrConf);
+ run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs,
+ Msg,From,Func),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{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,CurrConf);
+ run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs,
+ Msg,From,Func),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{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,CurrConf);
+ run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs,
+ unicode_to_latin1(Bytes),From,put_chars),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{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,CurrConf);
+ run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs,
+ Bytes,From,put_chars),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
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,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{structured_io,ClientPid,Msg} ->
output(Msg, ClientPid),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{capture,NewCapture} ->
- run_test_case_msgloop(Ref,Pid,NewCapture,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,NewCapture,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{sync_apply,From,MFA} ->
sync_local_or_remote_apply(false,From,MFA),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{sync_apply_proxy,Proxy,From,MFA} ->
sync_local_or_remote_apply(Proxy,From,MFA),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{printout,Detail,Format,Args} ->
print(Detail,Format,Args),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{comment,NewComment} ->
NewComment1 = test_server_ctrl:to_string(NewComment),
NewComment2 = test_server_sup:framework_call(format_comment,
@@ -747,16 +802,42 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
Other ->
Other
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate1,NewComment2,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate1,
+ NewComment2,CurrConf,Status);
{read_comment,From} ->
From ! {self(),read_comment,Comment},
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{set_curr_conf,From,NewCurrConf} ->
From ! {self(),set_curr_conf,ok},
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,NewCurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,NewCurrConf,Status);
+ {make_priv_dir,From} when CurrConf == undefined ->
+ From ! {self(),make_priv_dir,{error,no_priv_dir_in_config}},
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
+ {make_priv_dir,From} ->
+ Result =
+ case proplists:get_value(priv_dir, element(2, CurrConf)) of
+ undefined ->
+ {error,no_priv_dir_in_config};
+ PrivDir ->
+ case file:make_dir(PrivDir) of
+ ok ->
+ ok;
+ {error, eexist} ->
+ ok;
+ MkDirError ->
+ {error,{MkDirError,PrivDir}}
+ end
+ end,
+ From ! {self(),make_priv_dir,Result},
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ Comment,CurrConf,Status);
{'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,undefined);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ {true,RetVal},Comment,undefined,Status);
{'EXIT',Pid,Reason} ->
case Reason of
{timetrap_timeout,TVal,Loc} ->
@@ -766,37 +847,45 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
%% timout during framework call
spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
{framework_error,{timetrap,TVal}},
- unknown,self(),Comment),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
- Comment,undefined);
+ unknown,self()),
+ run_test_case_msgloop(Ref,Pid,
+ CaptureStdout,RejectIoReqs,
+ Terminate,Comment,
+ undefined,Status);
Loc1 ->
%% call end_per_testcase on a separate process,
- %% only so that the user has a chance to clean up
- %% after init_per_testcase, even after a timetrap timeout
+ %% 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),
+ call_end_conf(
+ Mod,Func,Pid,
+ {timetrap_timeout,TVal},
+ Loc1,[{tc_status,
+ {failed,
+ timetrap_timeout}}|Conf],
+ TVal),
{EndConfPid,{Mod,Func},Conf};
_ ->
{Mod,Func} = get_mf(Loc1),
- %% The framework functions mustn't execute on this
- %% group leader process or io will cause deadlock,
- %% so we spawn a dedicated process for the operation
- %% and let the group leader go back to handle io.
+ %% The framework functions mustn't
+ %% execute on this group leader process
+ %% or io will cause deadlock, so we
+ %% spawn a dedicated process for the
+ %% operation and let the group leader
+ %% go back to handle io.
spawn_fw_call(Mod,Func,CurrConf,Pid,
{timetrap_timeout,TVal},
- Loc1,self(),Comment),
+ Loc1,self()),
undefined
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
- Comment,NewCurrConf)
+ run_test_case_msgloop(Ref,Pid,
+ CaptureStdout,RejectIoReqs,
+ Terminate,Comment,
+ NewCurrConf,Status)
end;
{timetrap_timeout,TVal,Loc,InitOrEnd} ->
case mod_loc(Loc) of
@@ -804,14 +893,25 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
%% timout during framework call
spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
{framework_error,{timetrap,TVal}},
- unknown,self(),Comment);
+ unknown,self());
Loc1 ->
{Mod,_Func} = get_mf(Loc1),
spawn_fw_call(Mod,InitOrEnd,CurrConf,Pid,
{timetrap_timeout,TVal},
- Loc1,self(),Comment)
+ Loc1,self())
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ Terminate,Comment,CurrConf,Status);
+ {testcase_aborted,ErrorMsg={user_timetrap_error,_},AbortLoc} ->
+ %% user timetrap function caused exit
+ %% during start of test case
+ {Mod,Func} = get_mf(mod_loc(AbortLoc)),
+ spawn_fw_call(Mod,Func,CurrConf,Pid,
+ ErrorMsg,unknown,self()),
+ run_test_case_msgloop(Ref,Pid,
+ CaptureStdout,RejectIoReqs,
+ Terminate,Comment,
+ undefined,Status);
{testcase_aborted,AbortReason,AbortLoc} ->
ErrorMsg = {testcase_aborted,AbortReason},
case mod_loc(AbortLoc) of
@@ -819,66 +919,108 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
%% abort during framework call
spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
{framework_error,ErrorMsg},
- unknown,self(),Comment),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
- Comment,undefined);
+ unknown,self()),
+ run_test_case_msgloop(Ref,Pid,
+ CaptureStdout,RejectIoReqs,
+ Terminate,Comment,
+ undefined,Status);
Loc1 ->
- %% call end_per_testcase on a separate process, only so
- %% that the user has a chance to clean up after init_per_testcase,
- %% even after abortion
+ %% 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,
+ 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),
+ call_end_conf(
+ Mod,Func,Pid,
+ ErrorMsg,Loc1,
+ [{tc_status,
+ {failed,ErrorMsg}}|Conf],TVal),
{EndConfPid,{Mod,Func},Conf};
_ ->
{Mod,Func} = get_mf(Loc1),
- spawn_fw_call(Mod,Func,CurrConf,Pid,ErrorMsg,
- Loc1,self(),Comment),
+ spawn_fw_call(Mod,Func,CurrConf,Pid,
+ ErrorMsg,Loc1,self()),
undefined
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
- Comment,NewCurrConf)
+ run_test_case_msgloop(Ref,Pid,
+ CaptureStdout,RejectIoReqs,
+ Terminate,Comment,
+ NewCurrConf,Status)
end;
killed ->
%% result of an exit(TestCase,kill) call, which is the
%% only way to abort a testcase process that traps exits
%% (see abort_current_testcase)
- spawn_fw_call(undefined,undefined,CurrConf,Pid,
+ {Mod,Func} = case CurrConf of
+ {MF,_} -> MF;
+ _ -> {undefined,undefined}
+ end,
+ spawn_fw_call(Mod,Func,CurrConf,Pid,
testcase_aborted_or_killed,
- unknown,self(),Comment),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ unknown,self()),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ Terminate,Comment,CurrConf,Status);
{fw_error,{FwMod,FwFunc,FwError}} ->
- spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,{framework_error,FwError},
- unknown,self(),Comment),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
+ {framework_error,FwError},
+ unknown,self()),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ Terminate,Comment,CurrConf,Status);
_Other ->
%% the testcase has terminated because of Reason (e.g. an exit
%% because a linked process failed)
- spawn_fw_call(undefined,undefined,CurrConf,Pid,Reason,
- unknown,self(),Comment),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf)
+ {Mod,Func} = case CurrConf of
+ {MF,_} -> MF;
+ _ -> {undefined,undefined}
+ end,
+ spawn_fw_call(Mod,Func,CurrConf,Pid,
+ Reason,unknown,self()),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ Terminate,Comment,CurrConf,Status)
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,CurrConf,TCPid,TCExitReason,Loc,self(),Comment),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,undefined);
+ spawn_fw_call(Mod,Func,CurrConf,TCPid,
+ TCExitReason,Loc,self()),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ Terminate,Comment,undefined,Status);
_ ->
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf)
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ Terminate,Comment,CurrConf,Status)
end;
- {_FwCallPid,fw_notify_done,RetVal} ->
+ {_FwCallPid,fw_notify_done,{T,Value,Loc,Opts,AddToComment}} ->
%% the framework has been notified, we're finished
- run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment,undefined);
+ RetVal =
+ case AddToComment of
+ undefined ->
+ {T,Value,Loc,Opts,Comment};
+ _ ->
+ Comment1 =
+ if Comment == "" ->
+ AddToComment;
+ true ->
+ Comment ++
+ test_server_ctrl:xhtml("<br>",
+ "<br />") ++
+ AddToComment
+ end,
+ {T,Value,Loc,Opts,Comment1}
+ end,
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ {true,RetVal},Comment,undefined,Status);
{'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} ->
%% a framework function failed
CB = os:getenv("TEST_SERVER_FRAMEWORK"),
@@ -889,53 +1031,108 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
{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,undefined);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ {true,RetVal},Comment,undefined,Status);
{failed,File,Line} ->
put(test_server_detected_fail,
[{File, Line}| get(test_server_detected_fail)]),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ Terminate,Comment,CurrConf,Status);
+
+ {user_timetrap,Pid,_TrapTime,StartTime,E={user_timetrap_error,_},_} ->
+ case update_user_timetraps(Pid, StartTime) of
+ proceed ->
+ self() ! {abort_current_testcase,E,Pid};
+ ignore ->
+ ok
+ end,
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ Terminate,Comment,CurrConf,Status);
+ {user_timetrap,Pid,TrapTime,StartTime,ElapsedTime,Scale} ->
+ %% a user timetrap is triggered, ignore it if new
+ %% timetrap has been started since
+ case update_user_timetraps(Pid, StartTime) of
+ proceed ->
+ TotalTime = if is_integer(TrapTime) ->
+ TrapTime + ElapsedTime;
+ true ->
+ TrapTime
+ end,
+ timetrap(TrapTime, TotalTime, Pid, Scale);
+ ignore ->
+ ok
+ end,
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ Terminate,Comment,CurrConf,Status);
+ {timetrap_cancel_one,Handle,_From} ->
+ timetrap_cancel_one(Handle, false),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ Terminate,Comment,CurrConf,Status);
+ {timetrap_cancel_all,TCPid,_From} ->
+ timetrap_cancel_all(TCPid, false),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ Terminate,Comment,CurrConf,Status);
+ {get_timetrap_info,TCPid,From} ->
+ Info = get_timetrap_info(TCPid, false),
+ From ! {self(),get_timetrap_info,Info},
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ Terminate,Comment,CurrConf,Status);
_Other when not is_tuple(_Other) ->
%% ignore anything not generated by test server
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ Terminate,Comment,CurrConf,Status);
_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,CurrConf)
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ Terminate,Comment,CurrConf,Status)
after Timeout ->
ReturnValue
end.
-run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func) ->
+run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs,
+ Msg,From,Func) ->
case Msg of
{'EXIT',_} ->
From ! {io_reply,ReplyAs,{error,Func}};
_ ->
From ! {io_reply,ReplyAs,ok}
end,
- if CaptureStdout /= false ->
- CaptureStdout ! {captured,Msg};
- true ->
+ Proceed = if RejectIoReqs -> get({permit_io,From});
+ true -> true
+ end,
+ if Proceed ->
+ if CaptureStdout /= false ->
+ CaptureStdout ! {captured,Msg};
+ true ->
+ ok
+ end,
+ output({minor,Msg},From);
+ true ->
ok
- end,
- output({minor,Msg},From).
+ end.
output(Msg,Sender) ->
local_or_remote_apply({test_server_ctrl,output,[Msg,Sender]}).
call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) ->
+ %% Starter is also the group leader process
Starter = self(),
Data = {Mod,Func,TCPid,TCExitReason,Loc},
EndConfProc =
fun() ->
+ group_leader(Starter, self()),
Supervisor = self(),
EndConfApply =
fun() ->
case catch apply(Mod,end_per_testcase,[Func,Conf]) of
{'EXIT',Why} ->
+ timer:sleep(1),
group_leader() ! {printout,12,
- "ERROR! ~p:end_per_testcase(~p, ~p)"
+ "WARNING! "
+ "~p:end_per_testcase(~p, ~p)"
" crashed!\n\tReason: ~p\n",
[Mod,Func,Conf,Why]};
_ ->
@@ -950,15 +1147,23 @@ call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) ->
{'EXIT',Pid,Reason} ->
Starter ! {self(),{call_end_conf,Data,{error,Reason}}}
after TVal ->
+ exit(Pid, kill),
+ group_leader() ! {printout,12,
+ "WARNING! ~p:end_per_testcase(~p, ~p)"
+ " failed!\n\tReason: timetrap timeout"
+ " after ~w ms!\n", [Mod,Func,Conf,TVal]},
Starter ! {self(),{call_end_conf,Data,{error,timeout}}}
end
end,
spawn_link(EndConfProc).
spawn_fw_call(Mod,{init_per_testcase,Func},_,Pid,{timetrap_timeout,TVal}=Why,
- Loc,SendTo,Comment) ->
+ Loc,SendTo) ->
FwCall =
fun() ->
+ %% set group leader so that printouts/comments
+ %% from the framework get printed in the logs
+ group_leader(SendTo, self()),
Skip = {skip,{failed,{Mod,init_per_testcase,Why}}},
%% if init_per_testcase fails, the test case
%% should be skipped
@@ -970,12 +1175,12 @@ spawn_fw_call(Mod,{init_per_testcase,Func},_,Pid,{timetrap_timeout,TVal}=Why,
end,
%% finished, report back
SendTo ! {self(),fw_notify_done,
- {TVal/1000,Skip,Loc,[],Comment}}
+ {TVal/1000,Skip,Loc,[],undefined}}
end,
spawn_link(FwCall);
spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid,
- {timetrap_timeout,TVal}=Why,_Loc,SendTo,Comment) ->
+ {timetrap_timeout,TVal}=Why,_Loc,SendTo) ->
%%! This is a temporary fix that keeps Test Server alive during
%%! execution of a parallel test case group, when sometimes
%%! this clause gets called with EndConf == undefined. See OTP-9594
@@ -987,6 +1192,9 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid,
end,
FwCall =
fun() ->
+ %% set group leader so that printouts/comments
+ %% from the framework get printed in the logs
+ group_leader(SendTo, self()),
{RetVal,Report} =
case proplists:get_value(tc_status, EndConf1) of
undefined ->
@@ -998,6 +1206,10 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid,
E = {failed,{Mod,end_per_testcase,Why}},
{Result,E}
end,
+ group_leader() ! {printout,12,
+ "WARNING! ~p:end_per_testcase(~p, ~p)"
+ " failed!\n\tReason: timetrap timeout"
+ " after ~w ms!\n", [Mod,Func,EndConf,TVal]},
FailLoc = proplists:get_value(tc_fail_loc, EndConf1),
case catch do_end_tc_call(Mod,Func, FailLoc,
{Pid,Report,[EndConf1]}, Why) of
@@ -1006,42 +1218,48 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid,
_ ->
ok
end,
- %% if end_per_testcase fails a warning should be
- %% printed as comment
- Comment1 = if Comment == "" ->
- "";
- true ->
- Comment ++ test_server_ctrl:xhtml("<br>",
- "<br />")
- end,
- %% finished, report back
+ Warn = "<font color=\"red\">"
+ "WARNING: end_per_testcase timed out!</font>",
+ %% finished, report back (if end_per_testcase fails, a warning
+ %% should be printed as part of the comment)
SendTo ! {self(),fw_notify_done,
- {TVal/1000,RetVal,FailLoc,[],
- [Comment1,"<font color=\"red\">"
- "WARNING: end_per_testcase timed out!"
- "</font>"]}}
+ {TVal/1000,RetVal,FailLoc,[],Warn}}
end,
spawn_link(FwCall);
-spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo,_Comment) ->
+spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) ->
FwCall =
fun() ->
+ %% set group leader so that printouts/comments
+ %% from the framework get printed in the logs
+ group_leader(SendTo, self()),
test_server_sup:framework_call(report, [framework_error,
- {{FwMod,FwFunc},FwError}]),
+ {{FwMod,FwFunc},
+ FwError}]),
Comment =
lists:flatten(
io_lib:format("<font color=\"red\">"
- "WARNING! ~w:~w failed!</font>", [FwMod,FwFunc])),
+ "WARNING! ~w:~w failed!</font>",
+ [FwMod,FwFunc])),
%% finished, report back
SendTo ! {self(),fw_notify_done,
- {died,{error,{FwMod,FwFunc,FwError}},{FwMod,FwFunc},[],Comment}}
+ {died,{error,{FwMod,FwFunc,FwError}},
+ {FwMod,FwFunc},[],Comment}}
end,
spawn_link(FwCall);
-spawn_fw_call(Mod,Func,_,Pid,Error,Loc,SendTo,Comment) ->
+spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) ->
+ {Mod1,Func1} =
+ case {Mod,Func,CurrConf} of
+ {undefined,undefined,{{M,F},_}} -> {M,F};
+ _ -> {Mod,Func}
+ end,
FwCall =
fun() ->
- case catch fw_error_notify(Mod,Func,[],
+ %% set group leader so that printouts/comments
+ %% from the framework get printed in the logs
+ group_leader(SendTo, self()),
+ case catch fw_error_notify(Mod1,Func1,[],
Error,Loc) of
{'EXIT',FwErrorNotifyErr} ->
exit({fw_notify_done,error_notification,
@@ -1050,7 +1268,7 @@ spawn_fw_call(Mod,Func,_,Pid,Error,Loc,SendTo,Comment) ->
ok
end,
Conf = [{tc_status,{failed,timetrap_timeout}}],
- case catch do_end_tc_call(Mod,Func, Loc,
+ case catch do_end_tc_call(Mod1,Func1, Loc,
{Pid,Error,[Conf]},Error) of
{'EXIT',FwEndTCErr} ->
exit({fw_notify_done,end_tc,FwEndTCErr});
@@ -1058,7 +1276,7 @@ spawn_fw_call(Mod,Func,_,Pid,Error,Loc,SendTo,Comment) ->
ok
end,
%% finished, report back
- SendTo ! {self(),fw_notify_done,{died,Error,Loc,Comment}}
+ SendTo ! {self(),fw_notify_done,{died,Error,Loc,[],undefined}}
end,
spawn_link(FwCall).
@@ -1115,10 +1333,11 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit,
TimetrapData, LogOpts, TCCallback) ->
put(test_server_multiply_timetraps, TimetrapData),
put(test_server_logopts, LogOpts),
-
+ FWInitResult = test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0],
+ {ok,Args0}),
+ group_leader() ! {test_case_initialized,self()},
{{Time,Value},Loc,Opts} =
- case test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0],
- {ok,Args0}) of
+ case FWInitResult of
{ok,Args} ->
run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback);
Error = {error,_Reason} ->
@@ -1146,6 +1365,9 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit,
exit({Ref,Time,Value,Loc,Opts}).
run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) ->
+ %% save current state in controller loop
+ sync_send(group_leader(),set_curr_conf,{{Mod,Func},hd(Args)},
+ 5000, fun() -> exit(no_answer_from_group_leader) end),
case RunInit of
run_init ->
put(test_server_init_or_end_conf,{init_per_testcase,Func}),
@@ -1204,8 +1426,8 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) ->
%% call user callback function if defined
EndConf1 = user_callback(TCCallback, Mod, Func, 'end', EndConf),
%% update current state in controller loop
- sync_send(group_leader(),set_curr_conf,EndConf1,
- 5000, fun() -> exit(no_answer_from_group_leader) end),
+ sync_send(group_leader(),set_curr_conf,EndConf1, 5000,
+ fun() -> exit(no_answer_from_group_leader) end),
{FWReturn1,TSReturn1,EndConf2} =
case end_per_testcase(Mod, Func, EndConf1) of
SaveCfg1={save_config,_} ->
@@ -1530,8 +1752,18 @@ get_loc(Pid) ->
lists:foreach(fun({Key,Val}) -> put(Key, Val) end, Dict),
Stk = [rewrite_loc_item(Loc) || Loc <- Stk0],
case get(test_server_loc) of
- undefined -> put(test_server_loc, Stk);
- _ -> ok
+ undefined ->
+ put(test_server_loc, Stk);
+ {Suite,Case} ->
+ %% location info unknown, check if {Suite,Case,Line}
+ %% is available in stacktrace. and if so, use stacktrace
+ %% instead of currect test_server_loc
+ case [match || {S,C,_L} <- Stk, S == Suite, C == Case] of
+ [match|_] -> put(test_server_loc, Stk);
+ _ -> ok
+ end;
+ _ ->
+ ok
end,
get_loc().
@@ -1561,13 +1793,20 @@ mod_loc(Loc) ->
%% handle diff line num versions
case Loc of
[{{_M,_F},_L}|_] ->
- [{?pl2a(M),F,L} || {{M,F},L} <- Loc];
+ [begin if L /= 0 -> {?pl2a(M),F,L};
+ true -> {?pl2a(M),F} end end || {{M,F},L} <- Loc];
[{_M,_F}|_] ->
[{?pl2a(M),F} || {M,F} <- Loc];
+ {{M,F},0} ->
+ [{?pl2a(M),F}];
{{M,F},L} ->
[{?pl2a(M),F,L}];
{M,ForL} ->
[{?pl2a(M),ForL}];
+ {M,F,0} ->
+ [{M,F}];
+ [{M,F,0}|Stack] ->
+ [{M,F}|Stack];
_ ->
Loc
end.
@@ -1760,6 +1999,13 @@ messages_get() ->
test_server_sup:messages_get([]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% permit_io(GroupLeader, FromPid) -> ok
+%%
+%% Make sure proceeding IO from FromPid won't get rejected
+permit_io(GroupLeader, FromPid) ->
+ GroupLeader ! {permit_io,FromPid}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% sleep(Time) -> ok
%% Time = integer() | float() | infinity
%%
@@ -1862,31 +2108,40 @@ fail() ->
%% Break a test case so part of the test can be done manually.
%% Use continue/0 to continue.
break(Comment) ->
- case erase(test_server_timetraps) of
- undefined -> ok;
- List -> lists:foreach(fun({Ref,_,_}) ->
- timetrap_cancel(Ref)
- end, List)
- end,
+ break(?MODULE, Comment).
+
+break(CBM, Comment) ->
+ break(CBM, '', Comment).
+
+break(CBM, TestCase, Comment) ->
+ timetrap_cancel(),
+ {TCName,CntArg,PName} =
+ if TestCase == '' ->
+ {"", "", test_server_break_process};
+ true ->
+ Str = atom_to_list(TestCase),
+ {[32 | Str], Str,
+ list_to_atom("test_server_break_process_" ++ Str)}
+ end,
io:format(user,
"\n\n\n--- SEMIAUTOMATIC TESTING ---"
- "\nThe test case executes on process ~w"
+ "\nThe test case~s executes on process ~w"
"\n\n\n~s"
"\n\n\n-----------------------------\n\n"
- "Continue with --> test_server:continue().\n",
- [self(),Comment]),
- case whereis(test_server_break_process) of
+ "Continue with --> ~w:continue(~s).\n",
+ [TCName,self(),Comment,CBM,CntArg]),
+ case whereis(PName) of
undefined ->
- spawn_break_process(self());
+ spawn_break_process(self(), PName);
OldBreakProcess ->
OldBreakProcess ! cancel,
- spawn_break_process(self())
+ spawn_break_process(self(), PName)
end,
receive continue -> ok end.
-spawn_break_process(Pid) ->
+spawn_break_process(Pid, PName) ->
spawn(fun() ->
- register(test_server_break_process,self()),
+ register(PName, self()),
receive
continue -> continue(Pid);
cancel -> ok
@@ -1895,13 +2150,19 @@ spawn_break_process(Pid) ->
continue() ->
case whereis(test_server_break_process) of
- undefined ->
- ok;
- BreakProcess ->
- BreakProcess ! continue
+ undefined -> ok;
+ BreakProcess -> BreakProcess ! continue
end.
-continue(Pid) ->
+continue(TestCase) when is_atom(TestCase) ->
+ PName = list_to_atom("test_server_break_process_" ++
+ atom_to_list(TestCase)),
+ case whereis(PName) of
+ undefined -> ok;
+ BreakProcess -> BreakProcess ! continue
+ end;
+
+continue(Pid) when is_pid(Pid) ->
Pid ! continue.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1939,26 +2200,56 @@ timetrap_scale_factor() ->
%%
%% 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, true);
- {undefined,false} -> timetrap1(Timeout, false);
- {undefined,_} -> timetrap1(Timeout, true);
- {infinity,_} -> infinity;
- {_Int,_Scale} when Timeout == infinity -> infinity;
- {Int,Scale} -> timetrap1(Timeout*Int, Scale)
- end.
+timetrap(Timeout) ->
+ MultAndScale =
+ case get(test_server_multiply_timetraps) of
+ undefined -> {fun(T) -> T end, true};
+ {undefined,false} -> {fun(T) -> T end, false};
+ {undefined,_} -> {fun(T) -> T end, true};
+ {infinity,_} -> {fun(_) -> infinity end, false};
+ {Int,Scale} -> {fun(infinity) -> infinity;
+ (T) -> T*Int end, Scale}
+ end,
+ timetrap(Timeout, Timeout, self(), MultAndScale).
+
+%% when the function is called from different process than
+%% the test case, the test_server_multiply_timetraps data
+%% is unknown and must be passed as argument
+timetrap(Timeout, TCPid, MultAndScale) ->
+ timetrap(Timeout, Timeout, TCPid, MultAndScale).
+
+timetrap(Timeout0, TimeToReport0, TCPid, MultAndScale = {Multiplier,Scale}) ->
+ %% the time_ms call will either convert Timeout to ms or spawn a
+ %% user timetrap which sends the result to the IO server process
+ Timeout = time_ms(Timeout0, TCPid, MultAndScale),
+ Timeout1 = Multiplier(Timeout),
+ TimeToReport = if Timeout0 == TimeToReport0 ->
+ Timeout1;
+ true ->
+ %% only convert to ms, don't start a
+ %% user timetrap
+ time_ms_check(TimeToReport0)
+ end,
+ cancel_default_timetrap(self() == TCPid),
+ Handle = case Timeout1 of
+ infinity ->
+ infinity;
+ _ ->
+ spawn_link(test_server_sup,timetrap,[Timeout1,TimeToReport,
+ Scale,TCPid])
+ end,
+
+ %% ERROR! This sets dict on IO process instead of testcase process
+ %% if Timeout is return value from previous user timetrap!!
-timetrap1(Timeout, Scale) ->
- TCPid = self(),
- Ref = spawn_link(test_server_sup,timetrap,[Timeout,Scale,TCPid]),
case get(test_server_timetraps) of
- undefined -> put(test_server_timetraps,[{Ref,TCPid,{Timeout,Scale}}]);
- List -> put(test_server_timetraps,[{Ref,TCPid,{Timeout,Scale}}|List])
+ undefined ->
+ put(test_server_timetraps,[{Handle,TCPid,{TimeToReport,Scale}}]);
+ List ->
+ List1 = lists:delete({infinity,TCPid,{infinity,false}}, List),
+ put(test_server_timetraps,[{Handle,TCPid,{TimeToReport,Scale}}|List1])
end,
- Ref.
+ Handle.
ensure_timetrap(Config) ->
case get(test_server_timetraps) of
@@ -1983,7 +2274,10 @@ ensure_timetrap(Config) ->
put(test_server_default_timetrap, timetrap(seconds(DTmo)))
end.
-cancel_default_timetrap() ->
+%% executing on IO process, no default timetrap ever set here
+cancel_default_timetrap(false) ->
+ ok;
+cancel_default_timetrap(true) ->
case get(test_server_default_timetrap) of
undefined ->
ok;
@@ -2001,75 +2295,175 @@ cancel_default_timetrap() ->
error
end.
-
-time_ms({hours,N}) -> hours(N);
-time_ms({minutes,N}) -> minutes(N);
-time_ms({seconds,N}) -> seconds(N);
-time_ms({Other,_N}) ->
+time_ms({hours,N}, _, _) -> hours(N);
+time_ms({minutes,N}, _, _) -> minutes(N);
+time_ms({seconds,N}, _, _) -> seconds(N);
+time_ms({Other,_N}, _, _) ->
format("=== ERROR: Invalid time specification: ~p. "
"Should be seconds, minutes, or hours.~n", [Other]),
exit({invalid_time_format,Other});
-time_ms(Ms) when is_integer(Ms) -> Ms;
-time_ms(infinity) -> infinity;
-time_ms(Fun) when is_function(Fun) ->
- time_ms_apply(Fun);
-time_ms({M,F,A}=MFA) when is_atom(M), is_atom(F), is_list(A) ->
- time_ms_apply(MFA);
-time_ms(Other) -> exit({invalid_time_format,Other}).
-
-time_ms_apply(Func) ->
- time_ms_apply(Func, [5000,30000,60000,infinity]).
-
-time_ms_apply(Func, TOs) ->
- Apply = fun() ->
- case Func of
- {M,F,A} ->
- exit({self(),apply(M, F, A)});
- Fun ->
- exit({self(),Fun()})
- end
- end,
- Pid = spawn(Apply),
- Ref = monitor(process, Pid),
- time_ms_wait(Func, Pid, Ref, TOs).
-
-time_ms_wait(Func, Pid, Ref, [TO|TOs]) ->
- receive
- {'DOWN',Ref,process,Pid,{Pid,Result}} ->
- time_ms_check(Result);
- {'DOWN',Ref,process,Pid,Error} ->
- exit({timetrap_error,Error})
- after
- TO ->
- format("=== WARNING: No return from timetrap function ~p~n", [Func]),
- time_ms_wait(Func, Pid, Ref, TOs)
- end;
-%% this clause will never execute if 'infinity' is in TOs list, that's ok!
-time_ms_wait(Func, Pid, Ref, []) ->
- demonitor(Ref),
- exit(Pid, kill),
- exit({timetrap_error,{no_return_from_timetrap_function,Func}}).
+time_ms(Ms, _, _) when is_integer(Ms) -> Ms;
+time_ms(infinity, _, _) -> infinity;
+time_ms(Fun, TCPid, MultAndScale) when is_function(Fun) ->
+ time_ms_apply(Fun, TCPid, MultAndScale);
+time_ms({M,F,A}=MFA, TCPid, MultAndScale) when is_atom(M), is_atom(F), is_list(A) ->
+ time_ms_apply(MFA, TCPid, MultAndScale);
+time_ms(Other, _, _) -> exit({invalid_time_format,Other}).
time_ms_check(MFA = {M,F,A}) when is_atom(M), is_atom(F), is_list(A) ->
- exit({invalid_time_format,MFA});
+ MFA;
time_ms_check(Fun) when is_function(Fun) ->
- exit({invalid_time_format,Fun});
+ Fun;
time_ms_check(Other) ->
- time_ms(Other).
+ time_ms(Other, undefined, undefined).
+
+time_ms_apply(Func, TCPid, MultAndScale) ->
+ {_,GL} = process_info(TCPid, group_leader),
+ WhoAmI = self(), % either TC or IO server
+ T0 = now(),
+ UserTTSup =
+ spawn(fun() ->
+ user_timetrap_supervisor(Func, WhoAmI, TCPid,
+ GL, T0, MultAndScale)
+ end),
+ receive
+ {UserTTSup,infinity} ->
+ %% remember the user timetrap so that it can be cancelled
+ save_user_timetrap(TCPid, UserTTSup, T0),
+ %% we need to make sure the user timetrap function
+ %% gets time to execute and return
+ timetrap(infinity, TCPid, MultAndScale)
+ after 5000 ->
+ exit(UserTTSup, kill),
+ if WhoAmI /= GL ->
+ exit({user_timetrap_error,time_ms_apply});
+ true ->
+ format("=== ERROR: User timetrap execution failed!", []),
+ ignore
+ end
+ end.
+
+user_timetrap_supervisor(Func, Spawner, TCPid, GL, T0, MultAndScale) ->
+ process_flag(trap_exit, true),
+ Spawner ! {self(),infinity},
+ MonRef = monitor(process, TCPid),
+ UserTTSup = self(),
+ group_leader(GL, UserTTSup),
+ UserTT = spawn_link(fun() -> call_user_timetrap(Func, UserTTSup) end),
+ receive
+ {UserTT,Result} ->
+ demonitor(MonRef, [flush]),
+ Elapsed = trunc(timer:now_diff(now(), T0) / 1000),
+ try time_ms_check(Result) of
+ TimeVal ->
+ %% this is the new timetrap value to set (return value
+ %% from a fun or an MFA)
+ GL ! {user_timetrap,TCPid,TimeVal,T0,Elapsed,MultAndScale}
+ catch _:_ ->
+ %% when other than a legal timetrap value is returned
+ %% which will be the normal case for user timetraps
+ GL ! {user_timetrap,TCPid,0,T0,Elapsed,MultAndScale}
+ end;
+ {'EXIT',UserTT,Error} when Error /= normal ->
+ demonitor(MonRef, [flush]),
+ GL ! {user_timetrap,TCPid,0,T0,{user_timetrap_error,Error},
+ MultAndScale};
+ {'DOWN',MonRef,_,_,_} ->
+ demonitor(MonRef, [flush]),
+ exit(UserTT, kill)
+ end.
+
+call_user_timetrap(Func, Sup) when is_function(Func) ->
+ try Func() of
+ Result ->
+ Sup ! {self(),Result}
+ catch _:Error ->
+ exit({Error,erlang:get_stacktrace()})
+ end;
+call_user_timetrap({M,F,A}, Sup) ->
+ try apply(M,F,A) of
+ Result ->
+ Sup ! {self(),Result}
+ catch _:Error ->
+ exit({Error,erlang:get_stacktrace()})
+ end.
+
+save_user_timetrap(TCPid, UserTTSup, StartTime) ->
+ %% save pid of user timetrap supervisor process so that
+ %% it may be stopped even before the timetrap func has returned
+ NewUserTT = {TCPid,{UserTTSup,StartTime}},
+ case get(test_server_user_timetrap) of
+ undefined ->
+ put(test_server_user_timetrap, [NewUserTT]);
+ UserTTSups ->
+ case proplists:get_value(TCPid, UserTTSups) of
+ undefined ->
+ put(test_server_user_timetrap,
+ [NewUserTT | UserTTSups]);
+ PrevTTSup ->
+ %% remove prev user timetrap
+ remove_user_timetrap(PrevTTSup),
+ put(test_server_user_timetrap,
+ [NewUserTT | proplists:delete(TCPid,
+ UserTTSups)])
+ end
+ end.
+
+update_user_timetraps(TCPid, StartTime) ->
+ %% called when a user timetrap is triggered
+ case get(test_server_user_timetrap) of
+ undefined ->
+ proceed;
+ UserTTs ->
+ case proplists:get_value(TCPid, UserTTs) of
+ {_UserTTSup,StartTime} -> % same timetrap
+ put(test_server_user_timetrap,
+ proplists:delete(TCPid, UserTTs)),
+ proceed;
+ {OtherUserTTSup,OtherStartTime} ->
+ case timer:now_diff(OtherStartTime, StartTime) of
+ Diff when Diff >= 0 ->
+ ignore;
+ _ ->
+ exit(OtherUserTTSup, kill),
+ put(test_server_user_timetrap,
+ proplists:delete(TCPid, UserTTs)),
+ proceed
+ end;
+ undefined ->
+ proceed
+ end
+ end.
+
+remove_user_timetrap(TTSup) ->
+ exit(TTSup, kill).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timetrap_cancel(Handle) -> ok
%% Handle = term()
%%
%% Cancels a time trap.
-timetrap_cancel(infinity) ->
- ok;
timetrap_cancel(Handle) ->
+ timetrap_cancel_one(Handle, true).
+
+timetrap_cancel_one(infinity, _SendToServer) ->
+ ok;
+timetrap_cancel_one(Handle, SendToServer) ->
case get(test_server_timetraps) of
- undefined -> ok;
- [{Handle,_,_}] -> erase(test_server_timetraps);
- Timers -> put(test_server_timetraps,
- lists:keydelete(Handle, 1, Timers))
+ undefined ->
+ ok;
+ [{Handle,_,_}] ->
+ erase(test_server_timetraps);
+ Timers ->
+ case lists:keysearch(Handle, 1, Timers) of
+ {value,_} ->
+ put(test_server_timetraps,
+ lists:keydelete(Handle, 1, Timers));
+ false when SendToServer == true ->
+ group_leader() ! {timetrap_cancel_one,Handle,self()};
+ false ->
+ ok
+ end
end,
test_server_sup:timetrap_cancel(Handle).
@@ -2078,31 +2472,59 @@ timetrap_cancel(Handle) ->
%%
%% Cancels timetrap for current test case.
timetrap_cancel() ->
+ timetrap_cancel_all(self(), true).
+
+timetrap_cancel_all(TCPid, SendToServer) ->
case get(test_server_timetraps) of
undefined ->
ok;
Timers ->
- case lists:keysearch(self(), 2, Timers) of
- {value,{Handle,_,_}} ->
- timetrap_cancel(Handle);
- _ ->
+ [timetrap_cancel_one(Handle, false) ||
+ {Handle,Pid,_} <- Timers, Pid == TCPid]
+ end,
+ case get(test_server_user_timetrap) of
+ undefined ->
+ ok;
+ UserTTs ->
+ case proplists:get_value(TCPid, UserTTs) of
+ {UserTTSup,_StartTime} ->
+ remove_user_timetrap(UserTTSup),
+ put(test_server_user_timetrap,
+ proplists:delete(TCPid, UserTTs));
+ undefined ->
ok
end
- end.
+ end,
+ if SendToServer == true ->
+ group_leader() ! {timetrap_cancel_all,TCPid,self()};
+ true ->
+ ok
+ end,
+ ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% get_timetrap_info() -> {Timeout,Scale} | undefined
%%
%% Read timetrap info for current test case
get_timetrap_info() ->
+ get_timetrap_info(self(), true).
+
+get_timetrap_info(TCPid, SendToServer) ->
case get(test_server_timetraps) of
undefined ->
undefined;
Timers ->
- case lists:keysearch(self(), 2, Timers) of
- {value,{_,_,Info}} ->
- Info;
- _ ->
+ case [Info || {Handle,Pid,Info} <- Timers,
+ Pid == TCPid, Handle /= infinity] of
+ [I|_] ->
+ I;
+ [] when SendToServer == true ->
+ MsgLooper = group_leader(),
+ MsgLooper ! {get_timetrap_info,TCPid,self()},
+ receive
+ {MsgLooper,get_timetrap_info,I} -> I
+ end;
+ [] ->
undefined
end
end.
@@ -2528,11 +2950,23 @@ read_comment() ->
MsgLooper = group_leader(),
MsgLooper ! {read_comment,self()},
receive
- {MsgLooper,read_comment,Comment} ->
- Comment
+ {MsgLooper,read_comment,Comment} -> Comment
+ after
+ 5000 -> ""
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% make_priv_dir() -> ok
+%%
+%% Order test server to create the private directory
+%% for the current test case.
+make_priv_dir() ->
+ MsgLooper = group_leader(),
+ group_leader() ! {make_priv_dir,self()},
+ receive
+ {MsgLooper,make_priv_dir,Result} -> Result
after
- 5000 ->
- ""
+ 5000 -> error
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl
index 3432b3bc8e..df2187bc04 100644
--- a/lib/test_server/src/test_server_ctrl.erl
+++ b/lib/test_server/src/test_server_ctrl.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -162,8 +162,9 @@
-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([reject_io_reqs/1, get_levels/0, set_levels/3]).
-export([multiply_timetraps/1, scale_timetraps/1, get_timetrap_parameters/0]).
+-export([create_priv_dir/1]).
-export([cover/2, cover/3, cover/7,
cross_cover_analyse/1, cross_cover_analyse/2, trc/1, stop_trace/0]).
-export([testcase_callback/1]).
@@ -217,10 +218,11 @@
-define(auto_skip_color, "#FFA64D").
-define(user_skip_color, "#FF8000").
+-define(sortable_table_name, "SortableTable").
--record(state,{jobs=[],levels={1,19,10},
- multiply_timetraps=1,scale_timetraps=true,
- finish=false,
+-record(state,{jobs=[], levels={1,19,10}, reject_io_reqs=false,
+ multiply_timetraps=1, scale_timetraps=true,
+ create_priv_dir=auto_per_run, finish=false,
target_info, trc=false, cover=false, wait_for_node=[],
testcase_callback=undefined, idle_notify=[],
get_totals=false, random_seed=undefined}).
@@ -497,6 +499,9 @@ get_levels() ->
set_levels(Show, Major, Minor) ->
controller_call({set_levels,Show,Major,Minor}).
+reject_io_reqs(Bool) ->
+ controller_call({reject_io_reqs,Bool}).
+
multiply_timetraps(N) ->
controller_call({multiply_timetraps,N}).
@@ -506,6 +511,9 @@ scale_timetraps(Bool) ->
get_timetrap_parameters() ->
controller_call(get_timetrap_parameters).
+create_priv_dir(Value) ->
+ controller_call({create_priv_dir,Value}).
+
trc(TraceFile) ->
controller_call({trace,TraceFile}, 2*?ACCEPT_TIMEOUT).
@@ -646,8 +654,8 @@ init([Param]) ->
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
- FW when FW =:= false; FW =:= "undefined" ->
+ case get_fw_mod(undefined) of
+ undefined ->
%% Local target! The global test_server process implemented by
%% test_server.erl will not be started, so we simulate it by
%% globally registering this process instead.
@@ -811,6 +819,8 @@ handle_call({add_job,Dir,Name,TopCase,Skip}, _From, State) ->
[SpecName,{State#state.multiply_timetraps,
State#state.scale_timetraps}],
LogDir, Name, State#state.levels,
+ State#state.reject_io_reqs,
+ State#state.create_priv_dir,
State#state.testcase_callback, ExtraTools1),
NewJobs = [{Name,Pid}|State#state.jobs],
{reply, ok, State#state{jobs=NewJobs}};
@@ -820,6 +830,8 @@ handle_call({add_job,Dir,Name,TopCase,Skip}, _From, State) ->
[SpecList,{State#state.multiply_timetraps,
State#state.scale_timetraps}],
LogDir, Name, State#state.levels,
+ State#state.reject_io_reqs,
+ State#state.create_priv_dir,
State#state.testcase_callback, ExtraTools1),
NewJobs = [{Name,Pid}|State#state.jobs],
{reply, ok, State#state{jobs=NewJobs}};
@@ -837,6 +849,8 @@ handle_call({add_job,Dir,Name,TopCase,Skip}, _From, State) ->
{State#state.multiply_timetraps,
State#state.scale_timetraps}],
LogDir, Name, State#state.levels,
+ State#state.reject_io_reqs,
+ State#state.create_priv_dir,
State#state.testcase_callback, ExtraTools1),
NewJobs = [{Name,Pid}|State#state.jobs],
{reply, ok, State#state{jobs=NewJobs}}
@@ -968,6 +982,15 @@ handle_call({set_levels,Show,Major,Minor}, _From, State) ->
{reply,ok,State#state{levels={Show,Major,Minor}}};
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% handle_call({reject_io_reqs,Bool}, _, State) -> ok
+%% Bool = bool()
+%%
+%% May be used to switch off stdout printouts to the minor log file
+
+handle_call({reject_io_reqs,Bool}, _From, State) ->
+ {reply,ok,State#state{reject_io_reqs=Bool}};
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({multiply_timetraps,N}, _, State) -> ok
%% N = integer() | infinity
%%
@@ -1045,6 +1068,18 @@ handle_call({cover,App,Analyse}, _From, State) ->
{reply,ok,State#state{cover={App,Analyse}}};
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% handle_call({create_priv_dir,Value}, _, State) -> ok | {error,Reason}
+%%
+%% Set create_priv_dir to either auto_per_run (create common priv dir once
+%% per test run), manual_per_tc (the priv dir name will be unique for each
+%% test case, but the user has to call test_server:make_priv_dir/0 to create
+%% it), or auto_per_tc (unique priv dir created automatically for each test
+%% case).
+
+handle_call({create_priv_dir,Value}, _From, State) ->
+ {reply,ok,State#state{create_priv_dir=Value}};
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({testcase_callback,{Mod,Func}}, _, State) -> ok | {error,Reason}
%%
%% Add a callback function that will be called before and after every
@@ -1301,7 +1336,12 @@ terminate(_Reason, State) ->
end,
kill_all_jobs(State#state.jobs),
test_server_node:stop(State#state.target_info),
- test_server_h:restore(),
+ case lists:keysearch(sasl, 1, application:which_applications()) of
+ {value,_} ->
+ test_server_h:restore();
+ _ ->
+ ok
+ end,
ok.
kill_all_jobs([{_Name,JobPid}|Jobs]) ->
@@ -1316,14 +1356,16 @@ kill_all_jobs([]) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% spawn_tester(Mod, Func, Args, Dir, Name, Levels,
-%% TestCaseCallback, ExtraTools) -> Pid
+%% spawn_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs,
+%% CreatePrivDir, TestCaseCallback, ExtraTools) -> Pid
%% Mod = atom()
%% Func = atom()
%% Args = [term(),...]
%% Dir = string()
%% Name = string()
%% Levels = {integer(),integer(),integer()}
+%% RejectIoReqs = bool()
+%% CreatePrivDir = auto_per_run | manual_per_tc | auto_per_tc
%% TestCaseCallback = {CBMod,CBFunc} | undefined
%% ExtraTools = [ExtraTool,...]
%% ExtraTool = CoverInfo | TraceInfo | RandomSeed
@@ -1334,14 +1376,15 @@ kill_all_jobs([]) ->
%% 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_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs,
+ CreatePrivDir, TCCallback, ExtraTools) ->
spawn_link(
- fun() -> init_tester(Mod, Func, Args, Dir, Name, Levels,
- TCCallback, ExtraTools)
+ fun() -> init_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs,
+ CreatePrivDir, TCCallback, ExtraTools)
end).
-init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev},
- TCCallback, ExtraTools) ->
+init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, RejectIoReqs,
+ CreatePrivDir, TCCallback, ExtraTools) ->
process_flag(trap_exit, true),
put(test_server_name, Name),
put(test_server_dir, Dir),
@@ -1352,8 +1395,22 @@ init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev},
put(test_server_summary_level, SumLev),
put(test_server_major_level, MajLev),
put(test_server_minor_level, MinLev),
+ put(test_server_reject_io_reqs, RejectIoReqs),
+ put(test_server_create_priv_dir, CreatePrivDir),
put(test_server_random_seed, proplists:get_value(random_seed, ExtraTools)),
put(test_server_testcase_callback, TCCallback),
+ case os:getenv("TEST_SERVER_FRAMEWORK") of
+ FW when FW =:= false; FW =:= "undefined" ->
+ put(test_server_framework, '$none');
+ FW ->
+ put(test_server_framework_name, list_to_atom(FW)),
+ case os:getenv("TEST_SERVER_FRAMEWORK_NAME") of
+ FWName when FWName =:= false; FWName =:= "undefined" ->
+ put(test_server_framework_name, '$none');
+ FWName ->
+ put(test_server_framework_name, list_to_atom(FWName))
+ end
+ end,
%% before first print, read and set logging options
LogOpts = test_server_sup:framework_call(get_logopts, [], []),
put(test_server_logopts, LogOpts),
@@ -1385,8 +1442,10 @@ init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev},
end,
OkN = get(test_server_ok),
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",
+ print(html,"\n</tbody>\n<tfoot>\n"
+ "<tr><td></td><td><b>TOTAL</b></td><td></td><td></td><td></td>"
+ "<td>~.3fs</td><td><b>~s</b></td><td>~p Ok, ~p Failed~s of ~p</td></tr>\n"
+ "</tfoot>\n",
[Time,SuccessStr,OkN,FailedN,SkipStr,OkN+FailedN+SkippedN]).
%% timer:tc/3
@@ -1447,7 +1506,7 @@ stop_extra_tools([], _) ->
%% Reads the named test suite specification file, and executes it.
%%
%% This function is meant to be called by a process created by
-%% spawn_tester/7, which sets up some necessary dictionary values.
+%% spawn_tester/10, which sets up some necessary dictionary values.
do_spec(SpecName, TimetrapSpec) when is_list(SpecName) ->
case file:consult(SpecName) of
@@ -1496,7 +1555,7 @@ do_spec(SpecName, TimetrapSpec) when is_list(SpecName) ->
%% should not be used. Use a configuration test case instead.
%%
%% This function is meant to be called by a process created by
-%% spawn_tester/7, which sets up some necessary dictionary values.
+%% spawn_tester/10, which sets up some necessary dictionary values.
do_spec_list(TermList0, TimetrapSpec) ->
Nodes = [],
@@ -1663,7 +1722,7 @@ add_mod(Mod, Mods) ->
%% configuration information into the log files.
%%
%% This function is meant to be called by a process created by
-%% spawn_tester/7, which sets up some necessary dictionary values.
+%% spawn_tester/10, which sets up some necessary dictionary values.
do_test_cases(TopCases, SkipCases,
Config, MultiplyTimetrap) when is_integer(MultiplyTimetrap);
MultiplyTimetrap == infinity ->
@@ -1673,11 +1732,7 @@ do_test_cases(TopCases, SkipCases,
Config, TimetrapData) when is_list(TopCases),
is_tuple(TimetrapData) ->
{ok,TestDir} = start_log_file(),
- FwMod =
- case os:getenv("TEST_SERVER_FRAMEWORK") of
- FW when FW =:= false; FW =:= "undefined" -> ?MODULE;
- FW -> list_to_atom(FW)
- end,
+ FwMod = get_fw_mod(?MODULE),
case collect_all_cases(TopCases, SkipCases) of
{error,Why} ->
print(1, "Error starting: ~p", [Why]),
@@ -1706,7 +1761,8 @@ do_test_cases(TopCases, SkipCases,
test_server_sup:framework_call(report, [tests_start,{Test,N}]),
{Header,Footer} =
case test_server_sup:framework_call(get_html_wrapper,
- [TestDescr,true,TestDir], "") of
+ [TestDescr,true,TestDir,
+ {[],[2,3,4,7,8],[1,6]}], "") of
Empty when (Empty == "") ; (element(2,Empty) == "") ->
put(basic_html, true),
{["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n",
@@ -1768,13 +1824,15 @@ do_test_cases(TopCases, SkipCases,
[?suitelog_name,?coverlog_name]),
print(html,
"<p>~s</p>\n" ++
- xhtml("<table bgcolor=\"white\" border=\"3\" cellpadding=\"5\">",
- "<table>") ++
- "<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, {"<i>Executing <b>~p</b> test cases...</i>\n",[N]},
+ xhtml("<table bgcolor=\"white\" border=\"3\" cellpadding=\"5\">",
+ ["<table id=\"",?sortable_table_name,"\">\n",
+ "<thead>\n"]) ++
+ "<tr><th>Num</th><th>Module</th><th>Group</th>" ++
+ "<th>Case</th><th>Log</th><th>Time</th><th>Result</th>" ++
+ "<th>Comment</th></tr>\n</thead>\n<tbody>\n",
+ [print_if_known(N, {"<i>Executing <b>~p</b> test cases...</i>" ++
+ xhtml("\n<br>\n", "\n<br />\n"),[N]},
{"",[]})]),
- print(html, xhtml("<br>", "<br />")),
print(major, "=cases ~p", [get(test_server_cases)]),
print(major, "=user ~s", [TI#target_info.username]),
@@ -1812,7 +1870,7 @@ do_test_cases(TopCase, SkipCases, Config, TimetrapSpec) ->
%% Creates the log directories, the major log file and the html log file.
%% The log files are initialized with some header information.
%%
-%% The name of the log directory will be <Name>.LOGS/run.<Date>/ where
+%% The name of the log directory will be <Name>.logs/run.<Date>/ where
%% Name is the test suite name and Date is the current date and time.
start_log_file() ->
@@ -1928,7 +1986,8 @@ start_minor_log_file1(Mod, Func, LogDir, AbsName) ->
{Header,Footer} =
case test_server_sup:framework_call(get_html_wrapper,
[TestDescr,false,
- filename:dirname(AbsName)], "") of
+ filename:dirname(AbsName),
+ undefined], "") of
Empty when (Empty == "") ; (element(2,Empty) == "") ->
put(basic_html, true),
{["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n",
@@ -2058,7 +2117,7 @@ html_possibly_convert(Src, SrcInfo, Dest) ->
Header =
case test_server_sup:framework_call(get_html_wrapper,
["Module "++Src,false,
- OutDir], "") of
+ OutDir,undefined], "") of
Empty when (Empty == "") ; (element(2,Empty) == "") ->
["<!DOCTYPE HTML PUBLIC",
"\"-//W3C//DTD HTML 3.2 Final//EN\">\n",
@@ -2101,17 +2160,17 @@ add_init_and_end_per_suite([{make,_,_}=Case|Cases], LastMod, LastRef, FwMod) ->
add_init_and_end_per_suite([{skip_case,{{Mod,all},_}}=Case|Cases], LastMod,
LastRef, FwMod) when Mod =/= LastMod ->
{PreCases, NextMod, NextRef} =
- do_add_end_per_suite_and_skip(LastMod, LastRef, Mod),
+ do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod),
PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)];
add_init_and_end_per_suite([{skip_case,{{Mod,_},_}}=Case|Cases], LastMod,
LastRef, FwMod) when Mod =/= LastMod ->
{PreCases, NextMod, NextRef} =
- do_add_init_and_end_per_suite(LastMod, LastRef, Mod),
+ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)];
add_init_and_end_per_suite([{skip_case,{conf,_,{Mod,_},_}}=Case|Cases], LastMod,
LastRef, FwMod) when Mod =/= LastMod ->
{PreCases, NextMod, NextRef} =
- do_add_init_and_end_per_suite(LastMod, LastRef, Mod),
+ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)];
add_init_and_end_per_suite([{skip_case,_}=Case|Cases], LastMod, LastRef, FwMod) ->
[Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
@@ -2123,7 +2182,7 @@ add_init_and_end_per_suite([{conf,Ref,Props,{FwMod,Func}}=Case|Cases], LastMod,
case proplists:get_value(suite, Props) of
Suite when Suite =/= undefined, Suite =/= LastMod ->
{PreCases, NextMod, NextRef} =
- do_add_init_and_end_per_suite(LastMod, LastRef, Suite),
+ do_add_init_and_end_per_suite(LastMod, LastRef, Suite, FwMod),
Case1 = {conf,Ref,proplists:delete(suite,Props),{FwMod,Func}},
PreCases ++ [Case1|add_init_and_end_per_suite(Cases, NextMod,
NextRef, FwMod)];
@@ -2133,19 +2192,19 @@ add_init_and_end_per_suite([{conf,Ref,Props,{FwMod,Func}}=Case|Cases], LastMod,
add_init_and_end_per_suite([{conf,_,_,{Mod,_}}=Case|Cases], LastMod,
LastRef, FwMod) when Mod =/= LastMod, Mod =/= FwMod ->
{PreCases, NextMod, NextRef} =
- do_add_init_and_end_per_suite(LastMod, LastRef, Mod),
+ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)];
add_init_and_end_per_suite([{conf,_,_,_}=Case|Cases], LastMod, LastRef, FwMod) ->
[Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
add_init_and_end_per_suite([{Mod,_}=Case|Cases], LastMod, LastRef, FwMod)
when Mod =/= LastMod, Mod =/= FwMod ->
{PreCases, NextMod, NextRef} =
- do_add_init_and_end_per_suite(LastMod, LastRef, Mod),
+ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)];
add_init_and_end_per_suite([{Mod,_,_}=Case|Cases], LastMod, LastRef, FwMod)
when Mod =/= LastMod, Mod =/= FwMod ->
{PreCases, NextMod, NextRef} =
- do_add_init_and_end_per_suite(LastMod, LastRef, Mod),
+ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)];
add_init_and_end_per_suite([Case|Cases], LastMod, LastRef, FwMod)->
[Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
@@ -2153,10 +2212,23 @@ add_init_and_end_per_suite([], _LastMod, undefined, _FwMod) ->
[];
add_init_and_end_per_suite([], _LastMod, skipped_suite, _FwMod) ->
[];
-add_init_and_end_per_suite([], LastMod, LastRef, _FwMod) ->
- [{conf,LastRef,[],{LastMod,end_per_suite}}].
+add_init_and_end_per_suite([], LastMod, LastRef, FwMod) ->
+ %% we'll add end_per_suite here even if it's not exported
+ %% (and simply let the call fail if it's missing)
+ case erlang:function_exported(LastMod, end_per_suite, 1) of
+ true ->
+ [{conf,LastRef,[],{LastMod,end_per_suite}}];
+ false ->
+ %% let's call a "fake" end_per_suite if it exists
+ case erlang:function_exported(FwMod, end_per_suite, 1) of
+ true ->
+ [{conf,LastRef,[{suite,LastMod}],{FwMod,end_per_suite}}];
+ false ->
+ [{conf,LastRef,[],{LastMod,end_per_suite}}]
+ end
+ end.
-do_add_init_and_end_per_suite(LastMod, LastRef, Mod) ->
+do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) ->
case code:is_loaded(Mod) of
false -> code:load_file(Mod);
_ -> ok
@@ -2167,7 +2239,16 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod) ->
Ref = make_ref(),
{[{conf,Ref,[],{Mod,init_per_suite}}],Mod,Ref};
false ->
- {[],Mod,undefined}
+ %% let's call a "fake" init_per_suite if it exists
+ case erlang:function_exported(FwMod, init_per_suite, 1) of
+ true ->
+ Ref = make_ref(),
+ {[{conf,Ref,[{suite,Mod}],
+ {FwMod,init_per_suite}}],Mod,Ref};
+ false ->
+ {[],Mod,undefined}
+ end
+
end,
Cases =
if LastRef==undefined ->
@@ -2175,20 +2256,44 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod) ->
LastRef==skipped_suite ->
Init;
true ->
- %% 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
- %% exist, it will only fail...
- [{conf,LastRef,[],{LastMod,end_per_suite}}|Init]
+ %% we'll add end_per_suite here even if it's not exported
+ %% (and simply let the call fail if it's missing)
+ case erlang:function_exported(LastMod, end_per_suite, 1) of
+ true ->
+ [{conf,LastRef,[],{LastMod,end_per_suite}}|Init];
+ false ->
+ %% let's call a "fake" end_per_suite if it exists
+ case erlang:function_exported(FwMod, end_per_suite, 1) of
+ true ->
+ [{conf,LastRef,[{suite,Mod}],
+ {FwMod,end_per_suite}}|Init];
+ false ->
+ [{conf,LastRef,[],{LastMod,end_per_suite}}|Init]
+ end
+ end
end,
{Cases,NextMod,NextRef}.
-do_add_end_per_suite_and_skip(LastMod, LastRef, Mod) ->
+do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) ->
case LastRef of
No when No==undefined ; No==skipped_suite ->
{[],Mod,skipped_suite};
_Ref ->
- {[{conf,LastRef,[],{LastMod,end_per_suite}}],Mod,skipped_suite}
+ case erlang:function_exported(LastMod, end_per_suite, 1) of
+ true ->
+ {[{conf,LastRef,[],{LastMod,end_per_suite}}],
+ Mod,skipped_suite};
+ false ->
+ case erlang:function_exported(FwMod, end_per_suite, 1) of
+ true ->
+ %% let's call "fake" end_per_suite if it exists
+ {[{conf,LastRef,[],{FwMod,end_per_suite}}],
+ Mod,skipped_suite};
+ false ->
+ {[{conf,LastRef,[],{LastMod,end_per_suite}}],
+ Mod,skipped_suite}
+ end
+ end
end.
@@ -2748,7 +2853,16 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
{skipped,TcSkip},
{failed,TcFail}]}]
end,
- TSDirs = [{priv_dir,get(test_server_priv_dir)},{data_dir,get_data_dir(Mod)}],
+
+ SuiteName = proplists:get_value(suite, Props),
+ case get(test_server_create_priv_dir) of
+ auto_per_run -> % use common priv_dir
+ TSDirs = [{priv_dir,get(test_server_priv_dir)},
+ {data_dir,get_data_dir(Mod, SuiteName)}];
+ _ ->
+ TSDirs = [{data_dir,get_data_dir(Mod, SuiteName)}]
+ end,
+
ActualCfg =
if not StartConf ->
update_config(hd(Config), TSDirs ++ CfgProps);
@@ -2758,7 +2872,8 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
end, Mode0),
update_config(hd(Config),
TSDirs ++ [{tc_group_path,GroupPath} | CfgProps])
- end,
+ end,
+
CurrMode = curr_mode(Ref, Mode0, Mode),
ConfCaseResult = run_test_case(Ref, 0, Mod, Func, [ActualCfg], skip_init, target,
TimetrapData, CurrMode),
@@ -2910,8 +3025,13 @@ run_test_cases_loop([{conf,_Ref,_Props,_X}=Conf|_Cases0],
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)}]),
+ case get(test_server_create_priv_dir) of
+ auto_per_run ->
+ update_config(hd(Config), [{priv_dir,get(test_server_priv_dir)},
+ {data_dir,get_data_dir(Mod)}]);
+ _ ->
+ update_config(hd(Config), [{data_dir,get_data_dir(Mod)}])
+ end,
run_test_cases_loop([{Mod,Case,[ActualCfg]}|Cases], Config,
TimetrapData, Mode, Status);
@@ -3076,13 +3196,20 @@ conf_start(Ref, Mode) ->
false -> 0
end.
+
get_data_dir(Mod) ->
- case code:which(Mod) of
+ get_data_dir(Mod, undefined).
+
+get_data_dir(Mod, Suite) ->
+ UseMod = if Suite == undefined -> Mod;
+ true -> Suite
+ end,
+ case code:which(UseMod) of
non_existing ->
print(12, "The module ~p is not loaded", [Mod]),
[];
FullPath ->
- filename:dirname(FullPath) ++ "/" ++ cast_to_list(Mod) ++
+ filename:dirname(FullPath) ++ "/" ++ cast_to_list(UseMod) ++
?data_dir_suffix
end.
@@ -3248,16 +3375,21 @@ skip_case1(Type, CaseNum, Mod, Func, Comment, Mode) ->
print(major, "=started ~s", [lists:flatten(timestamp_get(""))]),
print(major, "=result skipped: ~s", [Comment1]),
print(2,"*** Skipping test case #~w ~p ***", [CaseNum,{Mod,Func}]),
- TR = xhtml("<tr valign=\"top\">", ["<tr class=\"",odd_or_even(),"\">"]),
+ TR = xhtml("<tr valign=\"top\">", ["<tr class=\"",odd_or_even(),"\">"]),
+ GroupName = case get_name(Mode) of
+ undefined -> "";
+ Name -> cast_to_list(Name)
+ end,
print(html,
TR ++ "<td>" ++ Col0 ++ "~s" ++ Col1 ++ "</td>"
"<td>" ++ Col0 ++ "~p" ++ Col1 ++ "</td>"
+ "<td>" ++ Col0 ++ "~s" ++ Col1 ++ "</td>"
"<td>" ++ Col0 ++ "~p" ++ Col1 ++ "</td>"
"<td>" ++ Col0 ++ "< >" ++ Col1 ++ "</td>"
"<td>" ++ Col0 ++ "0.000s" ++ Col1 ++ "</td>"
"<td><font color=\"~s\">SKIPPED</font></td>"
"<td>~s</td></tr>\n",
- [num2str(CaseNum),Mod,Func,ResultCol,Comment1]),
+ [num2str(CaseNum),fw_name(Mod),GroupName,Func,ResultCol,Comment1]),
if CaseNum > 0 ->
{US,AS} = get(test_server_skipped),
case Type of
@@ -3627,9 +3759,14 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where,
%% 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,
+ 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),
+ 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
%% (no matter if case runs on parallel or main process)
case get(test_server_common_io_handler) of
@@ -3649,24 +3786,58 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where,
MinorBase = filename:basename(MinorName),
print(major, "=logfile ~s", [filename:basename(MinorName)]),
- Args1 = [[{tc_logfile,MinorName} | proplists:delete(tc_logfile,hd(Args))]],
- test_server_sup:framework_call(report, [tc_start,{{?pl2a(Mod),Func},MinorName}]),
+ UpdatedArgs =
+ %% maybe create unique private directory for test case or config func
+ case get(test_server_create_priv_dir) of
+ auto_per_run ->
+ update_config(hd(Args), [{tc_logfile,MinorName}]);
+ PrivDirMode ->
+ RunDir = filename:dirname(MinorName),
+ Ext =
+ if Num == 0 ->
+ {_,S,Us} = now(),
+ lists:flatten(io_lib:format(".~w.~w", [S,Us]));
+ true ->
+ %% create unique private directory for test case
+ RunDir = filename:dirname(MinorName),
+ lists:flatten(io_lib:format(".~w", [Num]))
+ end,
+ PrivDir = filename:join(RunDir, ?priv_dir) ++ Ext,
+ if PrivDirMode == auto_per_tc ->
+ ok = file:make_dir(PrivDir);
+ PrivDirMode == manual_per_tc ->
+ ok
+ end,
+ update_config(hd(Args), [{priv_dir,PrivDir++"/"},
+ {tc_logfile,MinorName}])
+ end,
+
+ test_server_sup:framework_call(report,
+ [tc_start,{{?pl2a(Mod),Func},MinorName}]),
print_props((RunInit==skip_init), get_props(Mode)),
+ GroupName = case get_name(Mode) of
+ undefined -> "";
+ Name -> cast_to_list(Name)
+ end,
print(major, "=started ~s", [lists:flatten(timestamp_get(""))]),
{{Col0,Col1},Style} = get_font_style((RunInit==run_init), Mode),
TR = xhtml("<tr valign=\"top\">", ["<tr class=\"",odd_or_even(),"\">"]),
print(html, TR ++ "<td>" ++ Col0 ++ "~s" ++ Col1 ++ "</td>"
"<td>" ++ Col0 ++ "~p" ++ Col1 ++ "</td>"
+ "<td>" ++ Col0 ++ "~s" ++ Col1 ++ "</td>"
"<td><a href=\"~s\">~p</a></td>"
"<td><a href=\"~s#top\"><</a> <a href=\"~s#end\">></a></td>",
- [num2str(Num),Mod,MinorBase,Func,MinorBase,MinorBase]),
+ [num2str(Num),fw_name(Mod),GroupName,MinorBase,Func,
+ MinorBase,MinorBase]),
do_if_parallel(Main, ok, fun erlang:yield/0),
+
+ RejectIoReqs = get(test_server_reject_io_reqs),
%% run the test case
{Result,DetectedFail,ProcsBefore,ProcsAfter} =
- run_test_case_apply(Num, Mod, Func, Args1, get_name(Mode),
- RunInit, Where, TimetrapData),
+ run_test_case_apply(Num, Mod, Func, [UpdatedArgs], get_name(Mode),
+ RunInit, Where, TimetrapData, RejectIoReqs),
{Time,RetVal,Loc,Opts,Comment} =
case Result of
Normal={_Time,_RetVal,_Loc,_Opts,_Comment} -> Normal;
@@ -4107,6 +4278,46 @@ progress(ok, _CaseNum, Mod, Func, _Loc, RetVal, Time,
%%--------------------------------------------------------------------
%% various help functions
+get_fw_mod(Mod) ->
+ case get(test_server_framework) of
+ undefined ->
+ case os:getenv("TEST_SERVER_FRAMEWORK") of
+ FW when FW =:= false; FW =:= "undefined" ->
+ Mod;
+ FW ->
+ list_to_atom(FW)
+ end;
+ '$none' -> Mod;
+ FW -> FW
+ end.
+
+fw_name(?MODULE) ->
+ test_server;
+fw_name(Mod) ->
+ case get(test_server_framework_name) of
+ undefined ->
+ case get_fw_mod(undefined) of
+ undefined ->
+ Mod;
+ Mod ->
+ case os:getenv("TEST_SERVER_FRAMEWORK_NAME") of
+ FWName when FWName =:= false; FWName =:= "undefined" ->
+ Mod;
+ FWName ->
+ list_to_atom(FWName)
+ end;
+ _ ->
+ Mod
+ end;
+ '$none' ->
+ Mod;
+ FWName ->
+ case get_fw_mod(Mod) of
+ Mod -> FWName;
+ _ -> Mod
+ end
+ end.
+
if_auto_skip(Reason={failed,{_,init_per_testcase,_}}, True, _False) ->
{Reason,True()};
if_auto_skip({_T,{skip,Reason={failed,{_,init_per_testcase,_}}},_Opts}, True, _False) ->
@@ -4210,8 +4421,8 @@ get_font_style1(default) ->
%% set to false.
format_exception(Reason={_Error,Stack}) when is_list(Stack) ->
- case os:getenv("TEST_SERVER_FRAMEWORK") of
- FW when FW =:= false; FW =:= "undefined" ->
+ case get_fw_mod(undefined) of
+ undefined ->
case application:get_env(test_server, format_exception) of
{ok,false} ->
{"~p",Reason};
@@ -4219,7 +4430,7 @@ format_exception(Reason={_Error,Stack}) when is_list(Stack) ->
do_format_exception(Reason)
end;
FW ->
- case application:get_env(list_to_atom(FW), format_exception) of
+ case application:get_env(FW, format_exception) of
{ok,false} ->
{"~p",Reason};
_ ->
@@ -4245,7 +4456,7 @@ do_format_exception(Reason={Error,Stack}) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit,
-%% Where, TimetrapData) ->
+%% Where, TimetrapData, RejectIoReqs) ->
%% {{Time,RetVal,Loc,Opts,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} |
%% {{died,Reason,unknown,Comment},DetectedFail,ProcessesBefore,ProcessesAfter}
%% Name = atom()
@@ -4264,19 +4475,21 @@ do_format_exception(Reason={Error,Stack}) ->
%% sent over socket to target, and test_server runs the case and sends the
%% result back over the socket. Else test_server runs the case directly on host.
-run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, host, TimetrapData) ->
+run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, host,
+ TimetrapData, RejectIoReqs) ->
test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,
- TimetrapData});
-run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, target, TimetrapData) ->
+ TimetrapData,RejectIoReqs});
+run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, target,
+ TimetrapData, RejectIoReqs) ->
case get(test_server_ctrl_job_sock) of
undefined ->
%% local target
test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,
- TimetrapData});
+ TimetrapData,RejectIoReqs});
JobSock ->
%% remote target
request(JobSock, {test_case,{CaseNum,Mod,Func,Args,Name,RunInit,
- TimetrapData}}),
+ TimetrapData,RejectIoReqs}}),
read_job_sock_loop(JobSock)
end.
@@ -4815,8 +5028,8 @@ collect_case([Case | Cases], St, Acc) ->
collect_case(Cases, NewSt, Acc ++ FlatCases).
collect_case_invoke(Mod, Case, MFA, St) ->
- case os:getenv("TEST_SERVER_FRAMEWORK") of
- FW when FW =:= false; FW =:= "undefined" ->
+ case get_fw_mod(undefined) of
+ undefined ->
case catch apply(Mod, Case, [suite]) of
{'EXIT',_} ->
{ok,[MFA],St};
@@ -4824,7 +5037,9 @@ collect_case_invoke(Mod, Case, MFA, St) ->
collect_subcases(Mod, Case, MFA, St, Suite)
end;
_ ->
- Suite = test_server_sup:framework_call(get_suite, [?pl2a(Mod),Case], []),
+ Suite = test_server_sup:framework_call(get_suite,
+ [?pl2a(Mod),Case],
+ []),
collect_subcases(Mod, Case, MFA, St, Suite)
end.
@@ -4978,7 +5193,9 @@ init_props(Props) ->
end.
keep_name(Props) ->
- lists:filter(fun({name,_}) -> true; (_) -> false end, Props).
+ lists:filter(fun({name,_}) -> true;
+ ({suite,_}) -> true;
+ (_) -> false end, Props).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Target node handling functions %%
diff --git a/lib/test_server/src/test_server_h.erl b/lib/test_server/src/test_server_h.erl
index e423863b99..fdeee59326 100644
--- a/lib/test_server/src/test_server_h.erl
+++ b/lib/test_server/src/test_server_h.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -79,10 +79,21 @@ set_group_leader() ->
handle_event({_Type, GL, _Msg}, State) when node(GL)/=node() ->
{ok, State};
handle_event({Tag, _GL, {_Pid, Type, _Report}} = Event, State) ->
- case report(Tag, Type) of
- sasl ->
- tag(State#state.testcase),
- sasl_report_tty_h:handle_event(Event, State#state.sasl);
+ SASL = lists:keyfind(sasl, 1, application:which_applications()),
+ case report_receiver(Tag, Type) of
+ sasl when SASL /= false ->
+ {ok,ErrLogType} = application:get_env(sasl, errlog_type),
+ SReport = sasl_report:format_report(group_leader(), ErrLogType,
+ tag_event(Event)),
+ if is_list(SReport) ->
+ tag(State#state.testcase),
+ sasl_report_tty_h:handle_event(Event,
+ State#state.sasl);
+ true -> %% Report is an atom if no logging is to be done
+ ignore
+ end;
+ sasl -> %% SASL not running
+ ignore;
kernel ->
tag(State#state.testcase),
error_logger_tty_h:handle_event(Event, State#state.kernel);
@@ -111,19 +122,22 @@ terminate(_Reason, _State) ->
code_change(_OldVsn, State, _Extra) ->
{ok, State}.
-report(error_report, supervisor_report) -> sasl;
-report(error_report, crash_report) -> sasl;
-report(info_report, progress) -> sasl;
-report(error, _) -> kernel;
-report(error_report, _) -> kernel;
-report(warning_msg, _) -> kernel;
-report(warning_report, _) -> kernel;
-report(info, _) -> kernel;
-report(info_msg, _) -> kernel;
-report(info_report, _) -> kernel;
-report(_, _) -> none.
+report_receiver(error_report, supervisor_report) -> sasl;
+report_receiver(error_report, crash_report) -> sasl;
+report_receiver(info_report, progress) -> sasl;
+report_receiver(error, _) -> kernel;
+report_receiver(error_report, _) -> kernel;
+report_receiver(warning_msg, _) -> kernel;
+report_receiver(warning_report, _) -> kernel;
+report_receiver(info, _) -> kernel;
+report_receiver(info_msg, _) -> kernel;
+report_receiver(info_report, _) -> kernel;
+report_receiver(_, _) -> none.
tag({M,F,A}) when is_atom(M), is_atom(F), is_integer(A) ->
io:format(user, "~n=TESTCASE: ~p:~p/~p", [M,F,A]);
tag(Testcase) ->
io:format(user, "~n=TESTCASE: ~p", [Testcase]).
+
+tag_event(Event) ->
+ {calendar:local_time(), Event}.
diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl
index 1fd40d1dd9..6358efa764 100644
--- a/lib/test_server/src/test_server_node.erl
+++ b/lib/test_server/src/test_server_node.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -407,7 +407,7 @@ start_node_peer(SlaveName, OptList, From, TI) ->
% Support for erl_crash_dump files..
CrashFile = filename:join([TI#target_info.test_server_dir,
"erl_crash_dump."++cast_to_list(SlaveName)]),
- CrashArgs = lists:concat([" -env ERL_CRASH_DUMP ",CrashFile," "]),
+ CrashArgs = lists:concat([" -env ERL_CRASH_DUMP \"",CrashFile,"\" "]),
FailOnError = start_node_get_option_value(fail_on_error, OptList, true),
Pa = TI#target_info.test_server_dir,
Prog0 = start_node_get_option_value(erl, OptList, default),
@@ -420,7 +420,7 @@ start_node_peer(SlaveName, OptList, From, TI) ->
Cmd = lists:concat([Prog,
" -detached ",
TI#target_info.naming, " ", SlaveName,
- " -pa ", Pa,
+ " -pa \"", Pa,"\"",
NodeStarted,
CrashArgs,
" ", Args]),
@@ -472,9 +472,9 @@ start_node_slave(SlaveName, OptList, From, TI) ->
CrashFile = filename:join([TI#target_info.test_server_dir,
"erl_crash_dump."++cast_to_list(SlaveName)]),
- CrashArgs = lists:concat([" -env ERL_CRASH_DUMP ",CrashFile," "]),
+ CrashArgs = lists:concat([" -env ERL_CRASH_DUMP \"",CrashFile,"\" "]),
Pa = TI#target_info.test_server_dir,
- Args = lists:concat([" -pa ", Pa, " ", SuppliedArgs, CrashArgs]),
+ Args = lists:concat([" -pa \"", Pa, "\" ", SuppliedArgs, CrashArgs]),
Prog0 = start_node_get_option_value(erl, OptList, default),
Prog = pick_erl_program(Prog0),
@@ -943,12 +943,23 @@ find_rel_suse_1(Rel, RootWc) ->
end.
find_rel_suse_2(Rel, RootWc) ->
- Wc = RootWc ++ "_" ++ Rel,
- case filelib:wildcard(Wc) of
- [] ->
- [];
- [R|_] ->
- [filename:join([R,"bin","erl"])]
+ RelDir = filename:dirname(RootWc),
+ Pat = filename:basename(RootWc ++ "_" ++ Rel) ++ ".*",
+ case file:list_dir(RelDir) of
+ {ok,Dirs} ->
+ case lists:filter(fun(Dir) ->
+ case re:run(Dir, Pat) of
+ nomatch -> false;
+ _ -> true
+ end
+ end, Dirs) of
+ [] ->
+ [];
+ [R|_] ->
+ [filename:join([RelDir,R,"bin","erl"])]
+ end;
+ _ ->
+ []
end.
%% suse_release() -> VersionString | none.
diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl
index 875f45eea6..9d111ff769 100644
--- a/lib/test_server/src/test_server_sup.erl
+++ b/lib/test_server/src/test_server_sup.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -21,7 +21,8 @@
%%% Purpose: Test server support functions.
%%%-------------------------------------------------------------------
-module(test_server_sup).
--export([timetrap/2, timetrap/3, timetrap_cancel/1, capture_get/1, messages_get/1,
+-export([timetrap/2, timetrap/3, timetrap/4,
+ 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,
@@ -44,9 +45,12 @@
%% delays during the test (e.g. if cover is running).
timetrap(Timeout0, Pid) ->
- timetrap(Timeout0, true, Pid).
+ timetrap(Timeout0, Timeout0, true, Pid).
timetrap(Timeout0, Scale, Pid) ->
+ timetrap(Timeout0, Timeout0, Scale, Pid).
+
+timetrap(Timeout0, ReportTVal, Scale, Pid) ->
process_flag(priority, max),
Timeout = if not Scale -> Timeout0;
true -> test_server:timetrap_scale_factor() * Timeout0
@@ -54,28 +58,36 @@ timetrap(Timeout0, Scale, Pid) ->
TruncTO = trunc(Timeout),
receive
after TruncTO ->
- MFLs = test_server:get_loc(Pid),
- Mon = erlang:monitor(process, Pid),
- Trap =
- case get(test_server_init_or_end_conf) of
- undefined ->
- {timetrap_timeout,TruncTO,MFLs};
- InitOrEnd ->
- {timetrap_timeout,TruncTO,MFLs,InitOrEnd}
- end,
- exit(Pid, Trap),
- receive
- {'DOWN', Mon, process, Pid, _} ->
+ case is_process_alive(Pid) of
+ true ->
+ TimeToReport = if Timeout0 == ReportTVal -> TruncTO;
+ true -> ReportTVal end,
+ MFLs = test_server:get_loc(Pid),
+ Mon = erlang:monitor(process, Pid),
+ Trap =
+ case get(test_server_init_or_end_conf) of
+ undefined ->
+ {timetrap_timeout,TimeToReport,MFLs};
+ InitOrEnd ->
+ {timetrap_timeout,TimeToReport,MFLs,InitOrEnd}
+ end,
+ exit(Pid, Trap),
+ receive
+ {'DOWN', Mon, process, Pid, _} ->
+ ok
+ after 10000 ->
+ %% Pid is probably trapping exits, hit it harder...
+ catch error_logger:warning_msg(
+ "Testcase process ~p not "
+ "responding to timetrap "
+ "timeout:~n"
+ " ~p.~n"
+ "Killing testcase...~n",
+ [Pid, Trap]),
+ exit(Pid, kill)
+ end;
+ false ->
ok
- after 10000 ->
- %% Pid is probably trapping exits, hit it harder...
- catch error_logger:warning_msg("Testcase process ~p not "
- "responding to timetrap "
- "timeout:~n"
- " ~p.~n"
- "Killing testcase...~n",
- [Pid, Trap]),
- exit(Pid, kill)
end
end.
@@ -88,8 +100,12 @@ timetrap_cancel(Handle) ->
unlink(Handle),
MonRef = erlang:monitor(process, Handle),
exit(Handle, kill),
- receive {'DOWN',MonRef,_,_,_} -> ok after 2000 -> ok end.
-
+ receive {'DOWN',MonRef,_,_,_} -> ok
+ after
+ 2000 ->
+ erlang:demonitor(MonRef, [flush]),
+ ok
+ end.
capture_get(Msgs) ->
receive
@@ -99,7 +115,6 @@ capture_get(Msgs) ->
lists:reverse(Msgs)
end.
-
messages_get(Msgs) ->
receive
Msg ->
@@ -108,7 +123,6 @@ messages_get(Msgs) ->
lists:reverse(Msgs)
end.
-
timecall(M, F, A) ->
Befor = erlang:now(),
Val = apply(M, F, A),
diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl
index 729a2b11fc..4899f38d2b 100644
--- a/lib/test_server/src/ts.erl
+++ b/lib/test_server/src/ts.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -27,9 +27,10 @@
-export([run/0, run/1, run/2, run/3, run/4,
clean/0, clean/1,
tests/0, tests/1,
- install/0, install/1, install/2, index/0,
+ install/0, install/1, index/0,
estone/0, estone/1,
cross_cover_analyse/1,
+ compile_testcases/0, compile_testcases/1,
help/0]).
-export([i/0, l/1, r/0, r/1, r/2, r/3]).
@@ -88,35 +89,25 @@
-define(
install_help,
[
- " ts:install() - Install TS for local target with no Options.\n"
- " ts:install([Options])\n",
- " - Install TS for local target with Options\n"
- " ts:install({Architecture, Target_name})\n",
- " - Install TS for a remote target architecture.\n",
- " and target network name (e.g. {vxworks_cpu32, sauron}).\n",
- " ts:install({Architecture, Target_name}, [Options])\n",
- " - Install TS as above, and with Options.\n",
+ " ts:install() - Install TS with no Options.\n"
+ " ts:install([Options]) - Install TS with Options\n"
"\n",
"Installation options supported:\n",
" {longnames, true} - Use fully qualified hostnames\n",
- " {hosts, [HostList]}\n"
- " - Use theese hosts for distributed testing.\n"
" {verbose, Level} - Sets verbosity level for TS output (0,1,2), 0 is\n"
" quiet(default).\n"
- " {slavetargets, SlaveTarges}\n"
- " - Available hosts for starting slave nodes for\n"
- " platforms which cannot have more than one erlang\n"
- " node per host.\n"
- " {crossroot, TargetErlRoot}\n"
- " - Erlang root directory on target host\n"
- " Mandatory for remote targets\n"
- " {master, {MasterHost, MasterCookie}}\n"
- " - Master host and cookie for targets which are\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"
- " erl_boot_server is started autmatically\n"
+ " {crossroot, ErlTop}\n"
+ " - Erlang root directory on build host, ~n"
+ " normally same value as $ERL_TOP\n"
+ " {crossenv, [{Key,Val}]}\n"
+ " - Environmentals used by test configure on build host\n"
+ " {crossflags, FlagsString}\n"
+ " - Flags used by test configure on build host\n"
+ " {xcomp, XCompFile}\n"
+ " - The xcomp file to use for cross compiling the~n"
+ " testcases. Using this option will override any~n"
+ " cross* configurations given to ts. Note that you~n"
+ " have to have a correct ERL_TOP as well.~n"
]).
help() ->
@@ -183,26 +174,24 @@ help(installed) ->
" cover_details. Analyses modules specified in\n"
" cross.cover.\n"
" Level can be 'overview' or 'details'.\n",
+ " ts:compile_testcases()~n"
+ " ts:compile_testcases(Apps)~n"
+ " - Compile all testcases for usage in a cross ~n"
+ " compile environment."
" \n"
"Installation (already done):\n"
],
show_help([H,?install_help]).
show_help(H) ->
- io:put_chars(lists:flatten(H)).
+ io:format(lists:flatten(H)).
%% Installs tests.
install() ->
ts_install:install(install_local,[]).
-install({Architecture, Target_name}) ->
- ts_install:install({ts_lib:maybe_atom_to_list(Architecture),
- ts_lib:maybe_atom_to_list(Target_name)}, []);
install(Options) when is_list(Options) ->
ts_install:install(install_local,Options).
-install({Architecture, Target_name}, Options) when is_list(Options)->
- ts_install:install({ts_lib:maybe_atom_to_list(Architecture),
- ts_lib:maybe_atom_to_list(Target_name)}, Options).
%% Updates the local index page.
@@ -301,7 +290,15 @@ 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,[File++".spec"]}], Options);
+ Spec = case code:lib_dir(Testspec) of
+ {error, bad_name} when Testspec /= emulator,
+ Testspec /= system,
+ Testspec /= epmd ->
+ create_skip_spec(Testspec, tests(Testspec));
+ _ ->
+ File++".spec"
+ end,
+ 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},
@@ -332,6 +329,21 @@ run(Testspec, Mod, Case, Config) when is_atom(Testspec),
Args = [{suite,atom_to_list(Mod)}, {testcase,atom_to_list(Case)}],
run_test(atom_to_list(Testspec), Args, Options).
+%% 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) ->
+ {ok,Cwd} = file:get_cwd(),
+ TestspecString = atom_to_list(Testspec),
+ Specname = TestspecString++"_skip.spec",
+ {ok,D} = file:open(filename:join([filename:dirname(Cwd),
+ TestspecString++"_test",Specname]),
+ [write]),
+ TestDir = "\"../"++TestspecString++"_test\"",
+ io:format(D,"{suites, "++TestDir++", all}.~n",[]),
+ io:format(D,"{skip_suites, "++TestDir++", ~w, \"Skipped as application"
+ " is not in path!\"}.",[SuitesToSkip]),
+ Specname.
+
%% Check testspec to be valid and get possible Options
%% from the config.
check_test_get_opts(Testspec, Config) ->
@@ -705,3 +717,23 @@ cover_type(cover_details) -> details.
do_load(Mod) ->
code:purge(Mod),
code:load_file(Mod).
+
+
+compile_testcases() ->
+ compile_datadirs("../*/*_data").
+
+compile_testcases(App) when is_atom(App) ->
+ compile_testcases([App]);
+compile_testcases([App | T]) ->
+ compile_datadirs(io_lib:format("../~s_test/*_data", [App])),
+ compile_testcases(T);
+compile_testcases([]) ->
+ ok.
+
+compile_datadirs(DataDirs) ->
+ {ok,Variables} = file:consult("variables"),
+
+ lists:foreach(fun(Dir) ->
+ ts_lib:make_non_erlang(Dir, Variables)
+ end,
+ filelib:wildcard(DataDirs)).
diff --git a/lib/test_server/src/ts.hrl b/lib/test_server/src/ts.hrl
index 885a726c54..db804d23a1 100644
--- a/lib/test_server/src/ts.hrl
+++ b/lib/test_server/src/ts.hrl
@@ -28,6 +28,7 @@
-define(run_summary, "suite.summary").
-define(cover_total,"total_cover.log").
-define(variables, "variables").
+-define(cross_variables, "variables-cross").
-define(LF, [10]). % Newline in VxWorks script
-define(CHAR_PER_LINE, 60). % Characters per VxWorks script building line
-define(CROSS_COOKIE, "cross"). % cookie used when cross platform testing
diff --git a/lib/test_server/src/ts_autoconf_win32.erl b/lib/test_server/src/ts_autoconf_win32.erl
index 9103542fd2..258040b39e 100644
--- a/lib/test_server/src/ts_autoconf_win32.erl
+++ b/lib/test_server/src/ts_autoconf_win32.erl
@@ -67,6 +67,7 @@ system_type(Vars) ->
{5,1,_} -> "Windows XP";
{5,2,_} -> "Windows 2003";
{6,0,_} -> "Windows Vista";
+ {6,1,_} -> "Windows 7";
{_,_,_} -> "Windows NCC-1701-D"
end;
{win32, windows} ->
diff --git a/lib/test_server/src/ts_erl_config.erl b/lib/test_server/src/ts_erl_config.erl
index 5585e8ccd3..45d88016a4 100644
--- a/lib/test_server/src/ts_erl_config.erl
+++ b/lib/test_server/src/ts_erl_config.erl
@@ -128,15 +128,15 @@ erts_lib(Vars,OsType) ->
ErtsLibInternal}
end,
[{erts_lib_include,
- filename:nativename(ErtsLibInclude)},
+ quote(filename:nativename(ErtsLibInclude))},
{erts_lib_include_generated,
- filename:nativename(ErtsLibIncludeGenerated)},
+ quote(filename:nativename(ErtsLibIncludeGenerated))},
{erts_lib_include_internal,
- filename:nativename(ErtsLibIncludeInternal)},
+ quote(filename:nativename(ErtsLibIncludeInternal))},
{erts_lib_include_internal_generated,
- filename:nativename(ErtsLibIncludeInternalGenerated)},
- {erts_lib_path, filename:nativename(ErtsLibPath)},
- {erts_lib_internal_path, filename:nativename(ErtsLibInternalPath)},
+ quote(filename:nativename(ErtsLibIncludeInternalGenerated))},
+ {erts_lib_path, quote(filename:nativename(ErtsLibPath))},
+ {erts_lib_internal_path, quote(filename:nativename(ErtsLibInternalPath))},
{erts_lib_multi_threaded, erts_lib_name(multi_threaded, OsType)},
{erts_lib_single_threaded, erts_lib_name(single_threaded, OsType)}
| Vars].
@@ -145,13 +145,13 @@ erl_include(Vars) ->
Include =
case erl_root(Vars) of
{installed, Root} ->
- filename:join([Root, "usr", "include"]);
+ quote(filename:join([Root, "usr", "include"]));
{srctree, Root, Target} ->
- filename:join([Root, "erts", "emulator", "beam"])
- ++ " -I" ++ filename:join([Root, "erts", "emulator"])
+ quote(filename:join([Root, "erts", "emulator", "beam"]))
+ ++ " -I" ++ quote(filename:join([Root, "erts", "emulator"]))
++ system_include(Root, Vars)
- ++ " -I" ++ filename:join([Root, "erts", "include"])
- ++ " -I" ++ filename:join([Root, "erts", "include", Target])
+ ++ " -I" ++ quote(filename:join([Root, "erts", "include"]))
+ ++ " -I" ++ quote(filename:join([Root, "erts", "include", Target]))
end,
[{erl_include, filename:nativename(Include)}|Vars].
@@ -163,7 +163,7 @@ system_include(Root, Vars) ->
"VxWorks" -> "sys.vxworks";
_ -> "sys/unix"
end,
- " -I" ++ filename:nativename(filename:join([Root, "erts", "emulator", SysDir])).
+ " -I" ++ quote(filename:nativename(filename:join([Root, "erts", "emulator", SysDir]))).
erl_interface(Vars,OsType) ->
{Incl, {LibPath, MkIncl}} =
@@ -220,20 +220,16 @@ erl_interface(Vars,OsType) ->
_ ->
"" % VxWorks
end,
- CrossCompile = case OsType of
- vxworks -> "true";
- _ -> "false"
- end,
- [{erl_interface_libpath, filename:nativename(LibPath)},
+ [{erl_interface_libpath, quote(filename:nativename(LibPath))},
{erl_interface_sock_libs, sock_libraries(OsType)},
{erl_interface_lib, Lib},
{erl_interface_eilib, Lib1},
{erl_interface_lib_drv, LibDrv},
{erl_interface_eilib_drv, Lib1Drv},
{erl_interface_threadlib, ThreadLib},
- {erl_interface_include, filename:nativename(Incl)},
- {erl_interface_mk_include, filename:nativename(MkIncl)},
- {erl_interface_cross_compile, CrossCompile} | Vars].
+ {erl_interface_include, quote(filename:nativename(Incl))},
+ {erl_interface_mk_include, quote(filename:nativename(MkIncl))}
+ | Vars].
ic(Vars, OsType) ->
{ClassPath, LibPath, Incl} =
@@ -250,10 +246,10 @@ ic(Vars, OsType) ->
end,
filename:join(Dir, "include")}
end,
- [{ic_classpath, filename:nativename(ClassPath)},
- {ic_libpath, filename:nativename(LibPath)},
+ [{ic_classpath, quote(filename:nativename(ClassPath))},
+ {ic_libpath, quote(filename:nativename(LibPath))},
{ic_lib, link_library("ic", OsType)},
- {ic_include_path, filename:nativename(Incl)}|Vars].
+ {ic_include_path, quote(filename:nativename(Incl))}|Vars].
jinterface(Vars, _OsType) ->
ClassPath =
@@ -263,7 +259,7 @@ jinterface(Vars, _OsType) ->
Dir ->
filename:join([Dir, "priv", "OtpErlang.jar"])
end,
- [{jinterface_classpath, filename:nativename(ClassPath)}|Vars].
+ [{jinterface_classpath, quote(filename:nativename(ClassPath))}|Vars].
lib_dir(Vars, Lib) ->
LibLibDir = case Lib of
@@ -276,8 +272,6 @@ lib_dir(Vars, Lib) ->
case {get_var(crossroot, Vars), LibLibDir} of
{{error, _}, _} -> %no crossroot
LibLibDir;
- {_, {error, _}} -> %no lib
- LibLibDir;
{CrossRoot, _} ->
%% XXX: Ugly. So ugly I won't comment it
%% /Patrik
@@ -299,18 +293,16 @@ lib_dir(Vars, Lib) ->
end.
erl_root(Vars) ->
- Root = code:root_dir(),
- case ts_lib:erlang_type() of
+ Root = case get_var(crossroot,Vars) of
+ {error, notfound} -> code:root_dir();
+ CrossRoot -> CrossRoot
+ end,
+ case ts_lib:erlang_type(Root) of
{srctree, _Version} ->
Target = get_var(target, Vars),
{srctree, Root, Target};
{_, _Version} ->
- case get_var(crossroot,Vars) of
- {error, notfound} ->
- {installed, Root};
- CrossRoot ->
- {installed, CrossRoot}
- end
+ {installed, Root}
end.
@@ -362,10 +354,17 @@ ssl(Vars, _OsType) ->
{error, bad_name} ->
throw({cannot_find_app, ssl});
Dir ->
- [{ssl_libdir, filename:nativename(Dir)}| Vars]
+ [{ssl_libdir, quote(filename:nativename(Dir))}| Vars]
end.
separators(Vars, {win32,_}) ->
[{'DS',"\\"},{'PS',";"}|Vars];
separators(Vars, _) ->
[{'DS',"/"},{'PS',":"}|Vars].
+
+quote([$ |R]) ->
+ "\\ "++quote(R);
+quote([C|R]) ->
+ [C|quote(R)];
+quote([]) ->
+ [].
diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl
index 9703478f20..99ccfbc9bc 100644
--- a/lib/test_server/src/ts_install.erl
+++ b/lib/test_server/src/ts_install.erl
@@ -28,12 +28,25 @@ install(install_local, Options) ->
install(os:type(), Options);
install(TargetSystem, Options) ->
- io:format("Running configure for cross architecture, network target name~n"
- "~p~n", [TargetSystem]),
- case autoconf(TargetSystem) of
+ case file:consult(?variables) of
+ {ok, Vars} ->
+ case proplists:get_value(cross,Vars) of
+ "yes" when Options == []->
+ target_install(Vars);
+ _ ->
+ build_install(TargetSystem, Options)
+ end;
+ _ ->
+ build_install(TargetSystem, Options)
+ end.
+
+
+build_install(TargetSystem, Options) ->
+ XComp = parse_xcomp_file(proplists:get_value(xcomp,Options)),
+ case autoconf(TargetSystem, XComp++Options) of
{ok, Vars0} ->
OsType = os_type(TargetSystem),
- Vars1 = ts_erl_config:variables(merge(Vars0,Options),OsType),
+ Vars1 = ts_erl_config:variables(Vars0++XComp++Options,OsType),
{Options1, Vars2} = add_vars(Vars1, Options),
Vars3 = lists:flatten([Options1|Vars2]),
write_terms(?variables, Vars3);
@@ -45,32 +58,43 @@ os_type({unix,_}=OsType) -> OsType;
os_type({win32,_}=OsType) -> OsType;
os_type(_Other) -> vxworks.
-merge(Vars,[]) ->
- Vars;
-merge(Vars,[{crossroot,X}| Tail]) ->
- merge([{crossroot, X} | Vars], Tail);
-merge(Vars,[_X | Tail]) ->
- merge(Vars,Tail).
+target_install(CrossVars) ->
+ io:format("Cross installation detected, skipping configure and data_dir make~n"),
+ case file:rename(?variables,?cross_variables) of
+ ok ->
+ ok;
+ _ ->
+ io:format("Could not find variables file from cross make~n"),
+ throw(cross_installation_failed)
+ end,
+ CPU = proplists:get_value('CPU',CrossVars),
+ OS = proplists:get_value(os,CrossVars),
+ {Options,Vars} = add_vars([{cross,"yes"},{'CPU',CPU},{os,OS}],[]),
+ Variables = lists:flatten([Options|Vars]),
+ write_terms(?variables, Variables).
%% Autoconf for various platforms.
%% unix uses the configure script
%% win32 uses ts_autoconf_win32
%% VxWorks uses ts_autoconf_vxworks.
-autoconf(TargetSystem) ->
- case autoconf1(TargetSystem) of
+autoconf(TargetSystem, XComp) ->
+ case autoconf1(TargetSystem, XComp) of
ok ->
autoconf2(file:read_file("conf_vars"));
Error ->
Error
end.
-autoconf1({win32, _}) ->
+autoconf1({win32, _},[{cross,"no"}]) ->
ts_autoconf_win32:configure();
-autoconf1({unix, _}) ->
- unix_autoconf();
-autoconf1(Other) ->
- ts_autoconf_vxworks:configure(Other).
+autoconf1({unix, _},XCompFile) ->
+ unix_autoconf(XCompFile);
+autoconf1(Other,[{cross,"no"}]) ->
+ ts_autoconf_vxworks:configure(Other);
+autoconf1(_,_) ->
+ io:format("cross compilation not supported for that this platform~n"),
+ throw(cross_installation_failed).
autoconf2({ok, Bin}) ->
get_vars(binary_to_list(Bin), name, [], []);
@@ -92,27 +116,40 @@ get_vars([], name, [], Result) ->
get_vars(_, _, _, _) ->
{error, fatal_bad_conf_vars}.
-unix_autoconf() ->
+unix_autoconf(XConf) ->
Configure = filename:absname("configure"),
- Args = case catch erlang:system_info(threads) of
- false -> "";
- _ -> " --enable-shlib-thread-safety"
- end
- ++ case catch string:str(erlang:system_info(system_version),
- "debug") > 0 of
- false -> "";
- _ -> " --enable-debug-mode"
- end,
+ Flags = proplists:get_value(crossflags,XConf,[]),
+ Env = proplists:get_value(crossenv,XConf,[]),
+ Host = get_xcomp_flag("host", Flags),
+ Build = get_xcomp_flag("build", Flags),
+ Threads = [" --enable-shlib-thread-safety" ||
+ erlang:system_info(threads) /= false],
+ Debug = [" --enable-debug-mode" ||
+ string:str(erlang:system_info(system_version),"debug") > 0],
+ Args = Host ++ Build ++ Threads ++ Debug,
case filelib:is_file(Configure) of
true ->
- Env = macosx_cflags(),
- Port = open_port({spawn, Configure ++ Args},
- [stream, eof, {env,Env}]),
+ OSXEnv = macosx_cflags(),
+ io:format("Running ~sEnv: ~p~n",
+ [lists:flatten(Configure ++ Args),Env++OSXEnv]),
+ Port = open_port({spawn, lists:flatten(["\"",Configure,"\"",Args])},
+ [stream, eof, {env,Env++OSXEnv}]),
ts_lib:print_data(Port);
false ->
{error, no_configure_script}
end.
+
+get_xcomp_flag(Flag, Flags) ->
+ get_xcomp_flag(Flag, Flag, Flags).
+get_xcomp_flag(Flag, Tag, Flags) ->
+ case proplists:get_value(Flag,Flags) of
+ undefined -> "";
+ "guess" -> [" --",Tag,"=",os:cmd("$ERL_TOP/erts/autoconf/config.guess")];
+ HostVal -> [" --",Tag,"=",HostVal]
+ end.
+
+
macosx_cflags() ->
case os:type() of
{unix, darwin} ->
@@ -125,10 +162,33 @@ macosx_cflags() ->
[]
end.
+parse_xcomp_file(undefined) ->
+ [{cross,"no"}];
+parse_xcomp_file(Filepath) ->
+ {ok,Bin} = file:read_file(Filepath),
+ Lines = binary:split(Bin,<<"\n">>,[global,trim]),
+ {Envs,Flags} = parse_xcomp_file(Lines,[],[]),
+ [{cross,"yes"},{crossroot,os:getenv("ERL_TOP")},
+ {crossenv,Envs},{crossflags,Flags}].
+
+parse_xcomp_file([<<A:8,_/binary>> = Line|R],Envs,Flags)
+ when $A =< A, A =< $Z ->
+ [Var,Value] = binary:split(Line,<<"=">>),
+ parse_xcomp_file(R,[{binary_to_list(Var),
+ binary_to_list(Value)}|Envs],Flags);
+parse_xcomp_file([<<"erl_xcomp_",Line/binary>>|R],Envs,Flags) ->
+ [Var,Value] = binary:split(Line,<<"=">>),
+ parse_xcomp_file(R,Envs,[{binary_to_list(Var),
+ binary_to_list(Value)}|Flags]);
+parse_xcomp_file([_|R],Envs,Flags) ->
+ parse_xcomp_file(R,Envs,Flags);
+parse_xcomp_file([],Envs,Flags) ->
+ {lists:reverse(Envs),lists:reverse(Flags)}.
+
write_terms(Name, Terms) ->
case file:open(Name, [write]) of
{ok, Fd} ->
- Result = write_terms1(Fd, Terms),
+ Result = write_terms1(Fd, remove_duplicates(Terms)),
file:close(Fd),
Result;
{error, Reason} ->
@@ -141,6 +201,17 @@ write_terms1(Fd, [Term|Rest]) ->
write_terms1(_, []) ->
ok.
+remove_duplicates(List) ->
+ lists:reverse(
+ lists:foldl(fun({Key,Val},Acc) ->
+ R = make_ref(),
+ case proplists:get_value(Key,Acc,R) of
+ R -> [{Key,Val}|Acc];
+ _Else ->
+ Acc
+ end
+ end,[],List)).
+
add_vars(Vars0, Opts0) ->
{Opts,LongNames} =
case lists:keymember(longnames, 1, Opts0) of
@@ -209,12 +280,11 @@ platform(Vars) ->
LC = lock_checking(),
MT = modified_timing(),
AsyncThreads = async_threads(),
- HeapType = heap_type_label(),
Debug = debug(),
CpuBits = word_size(),
Common = lists:concat([Hostname,"/",OsType,"/",CpuType,CpuBits,LinuxDist,
Schedulers,BindType,KP,IOTHR,LC,MT,AsyncThreads,
- HeapType,Debug,ExtraLabel]),
+ Debug,ExtraLabel]),
PlatformId = lists:concat([ErlType, " ", Version, Common]),
PlatformLabel = ErlType ++ Common,
PlatformFilename = platform_as_filename(PlatformId),
@@ -272,12 +342,6 @@ hostname() ->
"/localhost"
end.
-heap_type_label() ->
- case catch erlang:system_info(heap_type) of
- hybrid -> "/Hybrid";
- _ -> "" %private
- end.
-
async_threads() ->
case catch erlang:system_info(threads) of
true -> "/A"++integer_to_list(erlang:system_info(thread_pool_size));
diff --git a/lib/test_server/src/ts_install_cth.erl b/lib/test_server/src/ts_install_cth.erl
index a41916fd0a..67f2df0cae 100644
--- a/lib/test_server/src/ts_install_cth.erl
+++ b/lib/test_server/src/ts_install_cth.erl
@@ -95,17 +95,12 @@ pre_init_per_suite(_Suite,Config,State) ->
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
+ case proplists:get_value(cross,Variables) of
+ "yes" ->
+ ct:log("Not making data dir as tests have been cross compiled");
+ _ ->
+ ts_lib:make_non_erlang(DataDir, Variables)
end,
-
- make_non_erlang(DataDir, Variables),
{add_node_name(Config, State), State}
catch Error:Reason ->
@@ -219,39 +214,6 @@ terminate(_State) ->
%%% ============================================================================
%%% 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) ->
diff --git a/lib/test_server/src/ts_lib.erl b/lib/test_server/src/ts_lib.erl
index 2f0a4ea8c0..d521d2beda 100644
--- a/lib/test_server/src/ts_lib.erl
+++ b/lib/test_server/src/ts_lib.erl
@@ -24,10 +24,12 @@
%% 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,
+ erlang_type/1,
initial_capital/1, interesting_logs/1,
specs/1, suites/2, last_test/1,
force_write_file/2, force_delete/1,
subst_file/3, subst/2, print_data/1,
+ make_non_erlang/2,
maybe_atom_to_list/1, progress/4
]).
@@ -73,8 +75,10 @@ progress(Vars, Level, Format, Args) ->
%% Returns: {Type, Version} where Type is otp|src
erlang_type() ->
+ erlang_type(code:root_dir()).
+erlang_type(RootDir) ->
{_, Version} = init:script_id(),
- RelDir = filename:join(code:root_dir(), "releases"), % Only in installed
+ RelDir = filename:join(RootDir, "releases"), % Only in installed
case filelib:is_file(RelDir) of
true -> {otp,Version}; % installed OTP
false -> {srctree,Version} % source code tree
@@ -333,3 +337,45 @@ maybe_atom_to_list(To_list) when is_list(To_list) ->
maybe_atom_to_list(To_list) when is_atom(To_list)->
atom_to_list(To_list).
+
+%% Configure and run all the Makefiles in the data dir of the suite
+%% in question
+make_non_erlang(DataDir, 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_do(AllDir,Variables);
+ false ->
+ ok
+ end,
+ make_non_erlang_do(DataDir, Variables).
+
+make_non_erlang_do(DataDir, Variables) ->
+ try
+ MakeCommand = proplists:get_value(make_command,Variables),
+
+ FirstMakefile = filename:join(DataDir,"Makefile.first"),
+ case filelib:is_regular(FirstMakefile) of
+ true ->
+ io:format("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),
+ io:format("Making ~p",[MakefileDest]),
+ ok = ts_make:make([{makefile,"Makefile"},{data_dir,DataDir}
+ | Variables]);
+ false ->
+ ok
+ end
+ after
+ timer:sleep(100) %% maybe unnecessary now when we don't do set_cwd anymore
+ end.
diff --git a/lib/test_server/src/ts_make.erl b/lib/test_server/src/ts_make.erl
index 3df66111a3..1d8ef230c7 100644
--- a/lib/test_server/src/ts_make.erl
+++ b/lib/test_server/src/ts_make.erl
@@ -25,12 +25,12 @@
%% Functions to be called from make test cases.
make(Config) when is_list(Config) ->
- DataDir = ?config(data_dir, Config),
- Makefile = ?config(makefile, Config),
- Make = ?config(make_command, Config),
+ DataDir = proplists:get_value(data_dir, Config),
+ Makefile = proplists:get_value(makefile, Config),
+ Make = proplists:get_value(make_command, Config),
case make(Make, DataDir, Makefile) of
ok -> ok;
- {error,Reason} -> ?t:fail({make_failed,Reason})
+ {error,Reason} -> exit({make_failed,Reason})
end.
unmake(Config) when is_list(Config) ->
@@ -85,7 +85,7 @@ run_make_script({win32, _}, Make, Dir, Makefile) ->
{"run_make.bat",
".\\run_make",
["@echo off\r\n",
- "cd ", filename:nativename(Dir), "\r\n",
+ "cd \"", filename:nativename(Dir), "\"\r\n",
Make, " -f ", Makefile, " \r\n",
"if errorlevel 1 echo *error*\r\n",
"if not errorlevel 1 echo *ok*\r\n"]};
@@ -93,7 +93,7 @@ run_make_script({unix, _}, Make, Dir, Makefile) ->
{"run_make",
"/bin/sh ./run_make",
["#!/bin/sh\n",
- "cd ", Dir, "\n",
+ "cd \"", Dir, "\"\n",
Make, " -f ", Makefile, " 2>&1\n",
"case $? in\n",
" 0) echo '*ok*';;\n",
diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl
index 885a3c9b96..a61028e4bc 100644
--- a/lib/test_server/src/ts_run.erl
+++ b/lib/test_server/src/ts_run.erl
@@ -229,7 +229,7 @@ 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",
- " -pz ",Cwd,
+ " -pz \"",Cwd,"\"",
" -ct_test_vars ",TestVars,
" -eval \"file:set_cwd(\\\"",TestDir,"\\\")\" "
" -eval \"ct:run_test(",
diff --git a/lib/test_server/test/Makefile b/lib/test_server/test/Makefile
index 198440bb17..b2ac95afaa 100644
--- a/lib/test_server/test/Makefile
+++ b/lib/test_server/test/Makefile
@@ -83,10 +83,10 @@ include $(ERL_TOP)/make/otp_release_targets.mk
release_spec: opt
release_tests_spec: make_emakefile
- $(INSTALL_DIR) $(RELSYSDIR)
- $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) $(COVERFILE) $(RELSYSDIR)
- $(INSTALL_DATA) test_server_test_lib.hrl test_server.spec test_server.cover $(RELSYSDIR)
- chmod -R u+w $(RELSYSDIR)
- @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -)
+ $(INSTALL_DIR) "$(RELSYSDIR)"
+ $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) $(COVERFILE) "$(RELSYSDIR)"
+ $(INSTALL_DATA) test_server_test_lib.hrl test_server.spec test_server.cover "$(RELSYSDIR)"
+ chmod -R u+w "$(RELSYSDIR)"
+ @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
release_docs_spec:
diff --git a/lib/test_server/vsn.mk b/lib/test_server/vsn.mk
index 88e3856cf4..a1f4559083 100644
--- a/lib/test_server/vsn.mk
+++ b/lib/test_server/vsn.mk
@@ -1 +1 @@
-TEST_SERVER_VSN = 3.5
+TEST_SERVER_VSN = 3.5.1
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-09 22:30:30 +0000