diff options
Diffstat (limited to 'lib/test_server')
-rw-r--r-- | lib/test_server/doc/src/notes.xml | 149 | ||||
-rw-r--r-- | lib/test_server/src/configure.in | 34 | ||||
-rw-r--r-- | lib/test_server/src/test_server.erl | 772 | ||||
-rw-r--r-- | lib/test_server/src/test_server_ctrl.erl | 306 | ||||
-rw-r--r-- | lib/test_server/src/test_server_h.erl | 46 | ||||
-rw-r--r-- | lib/test_server/src/test_server_node.erl | 25 | ||||
-rw-r--r-- | lib/test_server/src/test_server_sup.erl | 70 | ||||
-rw-r--r-- | lib/test_server/src/ts.erl | 100 | ||||
-rw-r--r-- | lib/test_server/src/ts.hrl | 1 | ||||
-rw-r--r-- | lib/test_server/src/ts_autoconf_win32.erl | 1 | ||||
-rw-r--r-- | lib/test_server/src/ts_erl_config.erl | 24 | ||||
-rw-r--r-- | lib/test_server/src/ts_install.erl | 133 | ||||
-rw-r--r-- | lib/test_server/src/ts_install_cth.erl | 48 | ||||
-rw-r--r-- | lib/test_server/src/ts_lib.erl | 48 | ||||
-rw-r--r-- | lib/test_server/src/ts_make.erl | 8 | ||||
-rw-r--r-- | lib/test_server/vsn.mk | 2 |
16 files changed, 1307 insertions, 460 deletions
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/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..6e94e4861a 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 @@ -44,7 +44,7 @@ -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]). @@ -628,7 +628,7 @@ 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, false, "", undefined, starting). %% Ugly bug (pre R5A): %% If this process (group leader of the test case) terminates before @@ -639,19 +639,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, 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,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,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 +683,94 @@ 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,Terminate, + NewComment,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(Ref,Pid,CaptureStdout,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(Ref,Pid,CaptureStdout,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(Ref,Pid,CaptureStdout,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(Ref,Pid,CaptureStdout,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(Ref,Pid,CaptureStdout,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(Ref,Pid,CaptureStdout,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(Ref,Pid,CaptureStdout,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(Ref,Pid,CaptureStdout,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(Ref,Pid,CaptureStdout,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,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,Terminate, + Comment,CurrConf,Status); {capture,NewCapture} -> - run_test_case_msgloop(Ref,Pid,NewCapture,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,NewCapture,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,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,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,Terminate, + Comment,CurrConf,Status); {comment,NewComment} -> NewComment1 = test_server_ctrl:to_string(NewComment), NewComment2 = test_server_sup:framework_call(format_comment, @@ -747,16 +783,40 @@ 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,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,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,Terminate, + Comment,NewCurrConf,Status); + {make_priv_dir,From} when CurrConf == undefined -> + From ! {self(),make_priv_dir,{error,no_priv_dir_in_config}}; + {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,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,{true,RetVal}, + Comment,undefined,Status); {'EXIT',Pid,Reason} -> case Reason of {timetrap_timeout,TVal,Loc} -> @@ -766,37 +826,43 @@ 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, + 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, + Terminate,Comment, + NewCurrConf,Status) end; {timetrap_timeout,TVal,Loc,InitOrEnd} -> case mod_loc(Loc) of @@ -804,14 +870,24 @@ 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,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, + Terminate,Comment, + undefined,Status); {testcase_aborted,AbortReason,AbortLoc} -> ErrorMsg = {testcase_aborted,AbortReason}, case mod_loc(AbortLoc) of @@ -819,66 +895,106 @@ 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, + 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, + 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,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,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,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,Terminate, + Comment,undefined,Status); _ -> - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf) + run_test_case_msgloop(Ref,Pid,CaptureStdout,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,{true,RetVal}, + Comment,undefined,Status); {'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} -> %% a framework function failed CB = os:getenv("TEST_SERVER_FRAMEWORK"), @@ -889,20 +1005,63 @@ 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,{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,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,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,Terminate, + Comment,CurrConf,Status); + {timetrap_cancel_one,Handle,_From} -> + timetrap_cancel_one(Handle, false), + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); + {timetrap_cancel_all,TCPid,_From} -> + timetrap_cancel_all(TCPid, false), + run_test_case_msgloop(Ref,Pid,CaptureStdout,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,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,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,Terminate, + Comment,CurrConf,Status) after Timeout -> ReturnValue end. @@ -925,17 +1084,20 @@ 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 +1112,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 +1140,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 +1157,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 +1171,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,41 +1183,42 @@ 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,_,Pid,Error,Loc,SendTo) -> FwCall = fun() -> + %% set group leader so that printouts/comments + %% from the framework get printed in the logs + group_leader(SendTo, self()), case catch fw_error_notify(Mod,Func,[], Error,Loc) of {'EXIT',FwErrorNotifyErr} -> @@ -1058,7 +1236,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 +1293,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 +1325,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 +1386,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 +1712,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 +1753,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. @@ -1939,26 +2138,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 +2212,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 +2233,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 +2410,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 +2888,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..5ed296d215 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 @@ -164,6 +164,7 @@ -export([start_get_totals/1, stop_get_totals/0]). -export([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]). @@ -219,8 +220,8 @@ -define(user_skip_color, "#FF8000"). -record(state,{jobs=[],levels={1,19,10}, - multiply_timetraps=1,scale_timetraps=true, - finish=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}). @@ -506,6 +507,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 +650,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 +815,7 @@ 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.create_priv_dir, State#state.testcase_callback, ExtraTools1), NewJobs = [{Name,Pid}|State#state.jobs], {reply, ok, State#state{jobs=NewJobs}}; @@ -820,6 +825,7 @@ 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.create_priv_dir, State#state.testcase_callback, ExtraTools1), NewJobs = [{Name,Pid}|State#state.jobs], {reply, ok, State#state{jobs=NewJobs}}; @@ -837,6 +843,7 @@ 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.create_priv_dir, State#state.testcase_callback, ExtraTools1), NewJobs = [{Name,Pid}|State#state.jobs], {reply, ok, State#state{jobs=NewJobs}} @@ -1045,6 +1052,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 +1320,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,7 +1340,7 @@ kill_all_jobs([]) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% spawn_tester(Mod, Func, Args, Dir, Name, Levels, +%% spawn_tester(Mod, Func, Args, Dir, Name, Levels, CreatePrivDir, %% TestCaseCallback, ExtraTools) -> Pid %% Mod = atom() %% Func = atom() @@ -1324,6 +1348,7 @@ kill_all_jobs([]) -> %% Dir = string() %% Name = string() %% Levels = {integer(),integer(),integer()} +%% CreatePrivDir = auto_per_run | manual_per_tc | auto_per_tc %% TestCaseCallback = {CBMod,CBFunc} | undefined %% ExtraTools = [ExtraTool,...] %% ExtraTool = CoverInfo | TraceInfo | RandomSeed @@ -1334,14 +1359,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, + CreatePrivDir, TCCallback, ExtraTools) -> spawn_link( fun() -> init_tester(Mod, Func, Args, Dir, Name, Levels, - TCCallback, ExtraTools) + CreatePrivDir, TCCallback, ExtraTools) end). init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, - TCCallback, ExtraTools) -> + CreatePrivDir, TCCallback, ExtraTools) -> process_flag(trap_exit, true), put(test_server_name, Name), put(test_server_dir, Dir), @@ -1352,8 +1378,21 @@ 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_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,7 +1424,7 @@ 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>" + print(html,"<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", [Time,SuccessStr,OkN,FailedN,SkipStr,OkN+FailedN+SkippedN]). @@ -1673,11 +1712,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]), @@ -1770,8 +1805,9 @@ do_test_cases(TopCases, SkipCases, "<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", + "<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", [print_if_known(N, {"<i>Executing <b>~p</b> test cases...</i>\n",[N]}, {"",[]})]), print(html, xhtml("<br>", "<br />")), @@ -1812,7 +1848,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() -> @@ -2101,17 +2137,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 +2159,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 +2169,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 +2189,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 +2216,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 +2233,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 +2830,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 +2849,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 +3002,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 +3173,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 +3352,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 +3736,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,23 +3763,55 @@ 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), %% run the test case {Result,DetectedFail,ProcsBefore,ProcsAfter} = - run_test_case_apply(Num, Mod, Func, Args1, get_name(Mode), + run_test_case_apply(Num, Mod, Func, [UpdatedArgs], get_name(Mode), RunInit, Where, TimetrapData), {Time,RetVal,Loc,Opts,Comment} = case Result of @@ -4107,6 +4253,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 +4396,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 +4405,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}; _ -> @@ -4815,8 +5001,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 +5010,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 +5166,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..e8498a43f2 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 @@ -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..ed26156180 100644 --- a/lib/test_server/src/ts_erl_config.erl +++ b/lib/test_server/src/ts_erl_config.erl @@ -220,10 +220,6 @@ erl_interface(Vars,OsType) -> _ -> "" % VxWorks end, - CrossCompile = case OsType of - vxworks -> "true"; - _ -> "false" - end, [{erl_interface_libpath, filename:nativename(LibPath)}, {erl_interface_sock_libs, sock_libraries(OsType)}, {erl_interface_lib, Lib}, @@ -232,8 +228,8 @@ erl_interface(Vars,OsType) -> {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_mk_include, filename:nativename(MkIncl)} + | Vars]. ic(Vars, OsType) -> {ClassPath, LibPath, Incl} = @@ -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. diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl index 9703478f20..c70a41be4b 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 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..f0db60013a 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) -> 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 |