diff options
Diffstat (limited to 'lib/test_server/src')
22 files changed, 1574 insertions, 1930 deletions
diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile index 4bc51873c2..bb0b4e55b8 100644 --- a/lib/test_server/src/Makefile +++ b/lib/test_server/src/Makefile @@ -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,20 +44,18 @@ MODULES= test_server_ctrl \ test_server \ test_server_sup \ test_server_h \ - erl2html2 \ - vxworks_client + erl2html2 TS_MODULES= \ ts \ ts_run \ - ts_reports \ ts_lib \ ts_make \ ts_erl_config \ ts_autoconf_win32 \ - ts_autoconf_vxworks \ ts_install \ - ts_install_cth + ts_install_cth \ + ts_benchmark TARGET_MODULES= $(MODULES:%=$(EBIN)/%) TS_TARGET_MODULES= $(TS_MODULES:%=$(EBIN)/%) @@ -124,22 +122,22 @@ $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/src - $(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR)/src - $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src - $(INSTALL_DIR) $(RELSYSDIR)/include - $(INSTALL_DATA) $(HRL_FILES) $(RELSYSDIR)/include - $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + $(INSTALL_DIR) "$(RELSYSDIR)/src" + $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)/src" + $(INSTALL_DATA) $(INTERNAL_HRL_FILES) "$(RELSYSDIR)/src" + $(INSTALL_DIR) "$(RELSYSDIR)/include" + $(INSTALL_DATA) $(HRL_FILES) "$(RELSYSDIR)/include" + $(INSTALL_DIR) "$(RELSYSDIR)/ebin" + $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" release_tests_spec: opt - $(INSTALL_DIR) $(RELEASE_PATH)/test_server + $(INSTALL_DIR) "$(RELEASE_PATH)/test_server" $(INSTALL_DATA) $(ERL_FILES) $(TS_ERL_FILES) \ $(HRL_FILES) $(INTERNAL_HRL_FILES) $(TS_HRL_FILES) \ $(TS_TARGET_FILES) \ $(AUTOCONF_FILES) $(C_FILES) $(COVER_FILES) $(CONFIG) \ - $(RELEASE_PATH)/test_server - $(INSTALL_SCRIPT) $(PROGRAMS) $(RELEASE_PATH)/test_server + "$(RELEASE_PATH)/test_server" + $(INSTALL_SCRIPT) $(PROGRAMS) "$(RELEASE_PATH)/test_server" release_docs_spec: diff --git a/lib/test_server/src/configure.in b/lib/test_server/src/configure.in index 097853bcfc..785bab395c 100644 --- a/lib/test_server/src/configure.in +++ b/lib/test_server/src/configure.in @@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script for Erlang. dnl dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 1997-2011. All Rights Reserved. +dnl Copyright Ericsson AB 1997-2012. All Rights Reserved. dnl dnl The contents of this file are subject to the Erlang Public License, dnl Version 1.1, (the "License"); you may not use this file except in @@ -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..8beed9bd3e 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -35,6 +35,7 @@ -export([fail/0,fail/1,format/1,format/2,format/3]). -export([capture_start/0,capture_stop/0,capture_get/0]). -export([messages_get/0]). +-export([permit_io/2]). -export([hours/1,minutes/1,seconds/1,sleep/1,adjusted_sleep/1,timecall/3]). -export([timetrap_scale_factor/0,timetrap/1,get_timetrap_info/0, timetrap_cancel/1,timetrap_cancel/0]). @@ -44,12 +45,12 @@ -export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]). -export([app_test/1, app_test/2]). -export([is_native/1]). --export([comment/1]). +-export([comment/1, make_priv_dir/0]). -export([os_type/0]). -export([run_on_shielded_node/2]). -export([is_cover/0,is_debug/0,is_commercial/0]). --export([break/1,continue/0]). +-export([break/1,break/2,break/3,continue/0,continue/1]). %%% DEBUGGER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -export([purify_new_leaks/0, purify_format/2, purify_new_fds_inuse/0, @@ -523,7 +524,7 @@ stick_all_sticky(Node,Sticky) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% run_test_case_apply(Mod,Func,Args,Name,RunInit,TimetrapData) -> +%% run_test_case_apply(Mod,Func,Args,Name,RunInit,TimetrapData,RejectIoReqs) -> %% {Time,Value,Loc,Opts,Comment} | {died,Reason,unknown,Comment} %% %% Time = float() (seconds) @@ -558,8 +559,12 @@ stick_all_sticky(Node,Sticky) -> %% ScaleTimetrap indicates if test_server should attemp to automatically %% compensate timetraps for runtime delays introduced by e.g. tools like %% cover. +%% +%% RejectIoReqs (bool) is information about whether printouts to stdout +%% should be visible in the minor log file or not. -run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,TimetrapData}) -> +run_test_case_apply({CaseNum,Mod,Func,Args,Name, + RunInit,TimetrapData,RejectIoReqs}) -> purify_format("Test case #~w ~w:~w/1", [CaseNum, Mod, Func]), case os:getenv("TS_RUN_VALGRIND") of false -> @@ -570,17 +575,19 @@ run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,TimetrapData}) -> end, test_server_h:testcase({Mod,Func,1}), ProcBef = erlang:system_info(process_count), - Result = run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData), + Result = run_test_case_apply(Mod, Func, Args, Name, RunInit, + TimetrapData, RejectIoReqs), ProcAft = erlang:system_info(process_count), purify_new_leaks(), DetFail = get(test_server_detected_fail), {Result,DetFail,ProcBef,ProcAft}. -run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> +run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData, RejectIoReqs) -> case get(test_server_job_dir) of undefined -> %% i'm a local target - do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData); + do_run_test_case_apply(Mod, Func, Args, Name, RunInit, + TimetrapData, RejectIoReqs); JobDir -> %% i'm a remote target case Args of @@ -595,13 +602,14 @@ run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> Config2 = lists:keyreplace(priv_dir, 1, Config1, {priv_dir,TargetPrivDir}), do_run_test_case_apply(Mod, Func, [Config2], Name, RunInit, - TimetrapData); + TimetrapData, RejectIoReqs); _other -> do_run_test_case_apply(Mod, Func, Args, Name, RunInit, - TimetrapData) + TimetrapData, RejectIoReqs) end end. -do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> +do_run_test_case_apply(Mod, Func, Args, Name, RunInit, + TimetrapData, RejectIoReqs) -> {ok,Cwd} = file:get_cwd(), Args2Print = case Args of [Args1] when is_list(Args1) -> @@ -628,7 +636,8 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> end), group_leader(OldGLeader, self()), put(test_server_detected_fail, []), - run_test_case_msgloop(Ref, Pid, false, false, "", undefined). + run_test_case_msgloop(Ref, Pid, false, RejectIoReqs, false, "", + undefined, starting). %% Ugly bug (pre R5A): %% If this process (group leader of the test case) terminates before @@ -639,19 +648,37 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> %% A test case is known to have failed if it returns {'EXIT', _} tuple, %% or sends a message {failed, File, Line} to it's group_leader %% -run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> +run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, + Comment, CurrConf, Status) -> %% NOTE: Keep job_proxy_msgloop/0 up to date when changes %% are made in this function! {Timeout,ReturnValue} = case Terminate of {true, ReturnVal} -> + %% stop any timetrap timers for the test case + %% that have been started by this process + timetrap_cancel_all(Pid, false), {20, ReturnVal}; false -> {infinity, should_never_appear} end, receive + {test_case_initialized,Pid} -> + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,running); + Abort = {abort_current_testcase,_,_} when Status == starting -> + %% we're in init phase, must must postpone this operation + %% until test case execution is in progress (or FW:init_tc + %% gets killed) + self() ! Abort, + erlang:yield(), + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {abort_current_testcase,Reason,From} -> - Line = get_loc(Pid), + Line = case is_process_alive(Pid) of + true -> get_loc(Pid); + false -> unknown + end, Mon = erlang:monitor(process, Pid), exit(Pid,{testcase_aborted,Reason,Line}), erlang:yield(), @@ -665,76 +692,104 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> exit(Pid, kill), %% here's the only place we know Reason, so we save %% it as a comment, potentially replacing user data - Error = lists:flatten(io_lib:format("Aborted: ~p",[Reason])), + Error = lists:flatten(io_lib:format("Aborted: ~p", + [Reason])), Error1 = lists:flatten([string:strip(S,left) || - S <- string:tokens(Error,[$\n])]), + S <- string:tokens(Error, + [$\n])]), if length(Error1) > 63 -> string:substr(Error1,1,60) ++ "..."; true -> Error1 end end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,NewComment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + NewComment,CurrConf,Status); + {permit_io,FromPid} -> + put({permit_io,FromPid},true), + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}} when is_list(Format) -> Msg = (catch io_lib:Func(Format,Args)), - run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, + Msg,From,Func), + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}} when is_atom(Format) -> Msg = (catch io_lib:Func(Format,Args)), - run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, + Msg,From,Func), + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,Bytes}} -> - run_test_case_msgloop_io( - ReplyAs,CaptureStdout,Bytes,From,put_chars), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, + Bytes,From,put_chars), + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,unicode,io_lib,Func,[Format,Args]}} when is_list(Format) -> Msg = unicode_to_latin1(catch io_lib:Func(Format,Args)), - run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, + Msg,From,Func), + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,latin1,io_lib,Func,[Format,Args]}} when is_list(Format) -> Msg = (catch io_lib:Func(Format,Args)), - run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, + Msg,From,Func), + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,unicode,io_lib,Func,[Format,Args]}} when is_atom(Format) -> Msg = unicode_to_latin1(catch io_lib:Func(Format,Args)), - run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, + Msg,From,Func), + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,latin1,io_lib,Func,[Format,Args]}} when is_atom(Format) -> Msg = (catch io_lib:Func(Format,Args)), - run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, + Msg,From,Func), + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,unicode,Bytes}} -> - run_test_case_msgloop_io( - ReplyAs,CaptureStdout,unicode_to_latin1(Bytes),From,put_chars), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, + unicode_to_latin1(Bytes),From,put_chars), + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,latin1,Bytes}} -> - run_test_case_msgloop_io( - ReplyAs,CaptureStdout,Bytes,From,put_chars), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, + Bytes,From,put_chars), + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); IoReq when element(1, IoReq) == io_request -> %% something else, just pass it on group_leader() ! IoReq, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {structured_io,ClientPid,Msg} -> output(Msg, ClientPid), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {capture,NewCapture} -> - run_test_case_msgloop(Ref,Pid,NewCapture,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,NewCapture,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {sync_apply,From,MFA} -> sync_local_or_remote_apply(false,From,MFA), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {sync_apply_proxy,Proxy,From,MFA} -> sync_local_or_remote_apply(Proxy,From,MFA), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {printout,Detail,Format,Args} -> print(Detail,Format,Args), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {comment,NewComment} -> NewComment1 = test_server_ctrl:to_string(NewComment), NewComment2 = test_server_sup:framework_call(format_comment, @@ -747,16 +802,42 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> Other -> Other end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate1,NewComment2,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate1, + NewComment2,CurrConf,Status); {read_comment,From} -> From ! {self(),read_comment,Comment}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {set_curr_conf,From,NewCurrConf} -> From ! {self(),set_curr_conf,ok}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,NewCurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,NewCurrConf,Status); + {make_priv_dir,From} when CurrConf == undefined -> + From ! {self(),make_priv_dir,{error,no_priv_dir_in_config}}, + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); + {make_priv_dir,From} -> + Result = + case proplists:get_value(priv_dir, element(2, CurrConf)) of + undefined -> + {error,no_priv_dir_in_config}; + PrivDir -> + case file:make_dir(PrivDir) of + ok -> + ok; + {error, eexist} -> + ok; + MkDirError -> + {error,{MkDirError,PrivDir}} + end + end, + From ! {self(),make_priv_dir,Result}, + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + Comment,CurrConf,Status); {'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} -> RetVal = {Time/1000000,Value,mod_loc(Loc),Opts,Comment}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment,undefined); + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + {true,RetVal},Comment,undefined,Status); {'EXIT',Pid,Reason} -> case Reason of {timetrap_timeout,TVal,Loc} -> @@ -766,37 +847,45 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> %% timout during framework call spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, {framework_error,{timetrap,TVal}}, - unknown,self(),Comment), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, - Comment,undefined); + unknown,self()), + run_test_case_msgloop(Ref,Pid, + CaptureStdout,RejectIoReqs, + Terminate,Comment, + undefined,Status); Loc1 -> %% call end_per_testcase on a separate process, - %% only so that the user has a chance to clean up - %% after init_per_testcase, even after a timetrap timeout + %% only so that the user has a chance to + %% clean up after init_per_testcase, even after + %% a timetrap timeout NewCurrConf = case CurrConf of {{Mod,Func},Conf} -> EndConfPid = - call_end_conf(Mod,Func,Pid, - {timetrap_timeout,TVal}, - Loc1,[{tc_status, - {failed, - timetrap_timeout}}|Conf], - TVal), + call_end_conf( + Mod,Func,Pid, + {timetrap_timeout,TVal}, + Loc1,[{tc_status, + {failed, + timetrap_timeout}}|Conf], + TVal), {EndConfPid,{Mod,Func},Conf}; _ -> {Mod,Func} = get_mf(Loc1), - %% The framework functions mustn't execute on this - %% group leader process or io will cause deadlock, - %% so we spawn a dedicated process for the operation - %% and let the group leader go back to handle io. + %% The framework functions mustn't + %% execute on this group leader process + %% or io will cause deadlock, so we + %% spawn a dedicated process for the + %% operation and let the group leader + %% go back to handle io. spawn_fw_call(Mod,Func,CurrConf,Pid, {timetrap_timeout,TVal}, - Loc1,self(),Comment), + Loc1,self()), undefined end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, - Comment,NewCurrConf) + run_test_case_msgloop(Ref,Pid, + CaptureStdout,RejectIoReqs, + Terminate,Comment, + NewCurrConf,Status) end; {timetrap_timeout,TVal,Loc,InitOrEnd} -> case mod_loc(Loc) of @@ -804,14 +893,25 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> %% timout during framework call spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, {framework_error,{timetrap,TVal}}, - unknown,self(),Comment); + unknown,self()); Loc1 -> {Mod,_Func} = get_mf(Loc1), spawn_fw_call(Mod,InitOrEnd,CurrConf,Pid, {timetrap_timeout,TVal}, - Loc1,self(),Comment) + Loc1,self()) end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + Terminate,Comment,CurrConf,Status); + {testcase_aborted,ErrorMsg={user_timetrap_error,_},AbortLoc} -> + %% user timetrap function caused exit + %% during start of test case + {Mod,Func} = get_mf(mod_loc(AbortLoc)), + spawn_fw_call(Mod,Func,CurrConf,Pid, + ErrorMsg,unknown,self()), + run_test_case_msgloop(Ref,Pid, + CaptureStdout,RejectIoReqs, + Terminate,Comment, + undefined,Status); {testcase_aborted,AbortReason,AbortLoc} -> ErrorMsg = {testcase_aborted,AbortReason}, case mod_loc(AbortLoc) of @@ -819,66 +919,108 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> %% abort during framework call spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, {framework_error,ErrorMsg}, - unknown,self(),Comment), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, - Comment,undefined); + unknown,self()), + run_test_case_msgloop(Ref,Pid, + CaptureStdout,RejectIoReqs, + Terminate,Comment, + undefined,Status); Loc1 -> - %% call end_per_testcase on a separate process, only so - %% that the user has a chance to clean up after init_per_testcase, - %% even after abortion + %% call end_per_testcase on a separate process, + %% only so that the user has a chance to clean up + %% after init_per_testcase, even after abortion NewCurrConf = case CurrConf of {{Mod,Func},Conf} -> - TVal = case lists:keysearch(default_timeout,1,Conf) of - {value,{default_timeout,Tmo}} -> Tmo; - _ -> ?DEFAULT_TIMETRAP_SECS*1000 - end, + TVal = + case lists:keysearch(default_timeout, + 1, + Conf) of + {value,{default_timeout,Tmo}} -> + Tmo; + _ -> + ?DEFAULT_TIMETRAP_SECS*1000 + end, EndConfPid = - call_end_conf(Mod,Func,Pid,ErrorMsg, - Loc1, - [{tc_status,{failed,ErrorMsg}}|Conf], - TVal), + call_end_conf( + Mod,Func,Pid, + ErrorMsg,Loc1, + [{tc_status, + {failed,ErrorMsg}}|Conf],TVal), {EndConfPid,{Mod,Func},Conf}; _ -> {Mod,Func} = get_mf(Loc1), - spawn_fw_call(Mod,Func,CurrConf,Pid,ErrorMsg, - Loc1,self(),Comment), + spawn_fw_call(Mod,Func,CurrConf,Pid, + ErrorMsg,Loc1,self()), undefined end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, - Comment,NewCurrConf) + run_test_case_msgloop(Ref,Pid, + CaptureStdout,RejectIoReqs, + Terminate,Comment, + NewCurrConf,Status) end; killed -> %% result of an exit(TestCase,kill) call, which is the %% only way to abort a testcase process that traps exits %% (see abort_current_testcase) - spawn_fw_call(undefined,undefined,CurrConf,Pid, + {Mod,Func} = case CurrConf of + {MF,_} -> MF; + _ -> {undefined,undefined} + end, + spawn_fw_call(Mod,Func,CurrConf,Pid, testcase_aborted_or_killed, - unknown,self(),Comment), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + unknown,self()), + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + Terminate,Comment,CurrConf,Status); {fw_error,{FwMod,FwFunc,FwError}} -> - spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,{framework_error,FwError}, - unknown,self(),Comment), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, + {framework_error,FwError}, + unknown,self()), + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + Terminate,Comment,CurrConf,Status); _Other -> %% the testcase has terminated because of Reason (e.g. an exit %% because a linked process failed) - spawn_fw_call(undefined,undefined,CurrConf,Pid,Reason, - unknown,self(),Comment), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf) + {Mod,Func} = case CurrConf of + {MF,_} -> MF; + _ -> {undefined,undefined} + end, + spawn_fw_call(Mod,Func,CurrConf,Pid, + Reason,unknown,self()), + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + Terminate,Comment,CurrConf,Status) end; {EndConfPid,{call_end_conf,Data,_Result}} -> case CurrConf of {EndConfPid,{Mod,Func},_Conf} -> {_Mod,_Func,TCPid,TCExitReason,Loc} = Data, - spawn_fw_call(Mod,Func,CurrConf,TCPid,TCExitReason,Loc,self(),Comment), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,undefined); + spawn_fw_call(Mod,Func,CurrConf,TCPid, + TCExitReason,Loc,self()), + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + Terminate,Comment,undefined,Status); _ -> - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf) + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + Terminate,Comment,CurrConf,Status) end; - {_FwCallPid,fw_notify_done,RetVal} -> + {_FwCallPid,fw_notify_done,{T,Value,Loc,Opts,AddToComment}} -> %% the framework has been notified, we're finished - run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment,undefined); + RetVal = + case AddToComment of + undefined -> + {T,Value,Loc,Opts,Comment}; + _ -> + Comment1 = + if Comment == "" -> + AddToComment; + true -> + Comment ++ + test_server_ctrl:xhtml("<br>", + "<br />") ++ + AddToComment + end, + {T,Value,Loc,Opts,Comment1} + end, + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + {true,RetVal},Comment,undefined,Status); {'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} -> %% a framework function failed CB = os:getenv("TEST_SERVER_FRAMEWORK"), @@ -889,53 +1031,108 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> {list_to_atom(CB),Func} end, RetVal = {died,{framework_error,Loc,Error},Loc,"Framework error"}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment,undefined); + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + {true,RetVal},Comment,undefined,Status); {failed,File,Line} -> put(test_server_detected_fail, [{File, Line}| get(test_server_detected_fail)]), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + Terminate,Comment,CurrConf,Status); + + {user_timetrap,Pid,_TrapTime,StartTime,E={user_timetrap_error,_},_} -> + case update_user_timetraps(Pid, StartTime) of + proceed -> + self() ! {abort_current_testcase,E,Pid}; + ignore -> + ok + end, + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + Terminate,Comment,CurrConf,Status); + {user_timetrap,Pid,TrapTime,StartTime,ElapsedTime,Scale} -> + %% a user timetrap is triggered, ignore it if new + %% timetrap has been started since + case update_user_timetraps(Pid, StartTime) of + proceed -> + TotalTime = if is_integer(TrapTime) -> + TrapTime + ElapsedTime; + true -> + TrapTime + end, + timetrap(TrapTime, TotalTime, Pid, Scale); + ignore -> + ok + end, + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + Terminate,Comment,CurrConf,Status); + {timetrap_cancel_one,Handle,_From} -> + timetrap_cancel_one(Handle, false), + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + Terminate,Comment,CurrConf,Status); + {timetrap_cancel_all,TCPid,_From} -> + timetrap_cancel_all(TCPid, false), + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + Terminate,Comment,CurrConf,Status); + {get_timetrap_info,TCPid,From} -> + Info = get_timetrap_info(TCPid, false), + From ! {self(),get_timetrap_info,Info}, + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + Terminate,Comment,CurrConf,Status); _Other when not is_tuple(_Other) -> %% ignore anything not generated by test server - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + Terminate,Comment,CurrConf,Status); _Other when element(1, _Other) /= 'EXIT', element(1, _Other) /= started, element(1, _Other) /= finished, element(1, _Other) /= print -> %% ignore anything not generated by test server - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf) + run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + Terminate,Comment,CurrConf,Status) after Timeout -> ReturnValue end. -run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func) -> +run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, + Msg,From,Func) -> case Msg of {'EXIT',_} -> From ! {io_reply,ReplyAs,{error,Func}}; _ -> From ! {io_reply,ReplyAs,ok} end, - if CaptureStdout /= false -> - CaptureStdout ! {captured,Msg}; - true -> + Proceed = if RejectIoReqs -> get({permit_io,From}); + true -> true + end, + if Proceed -> + if CaptureStdout /= false -> + CaptureStdout ! {captured,Msg}; + true -> + ok + end, + output({minor,Msg},From); + true -> ok - end, - output({minor,Msg},From). + end. output(Msg,Sender) -> local_or_remote_apply({test_server_ctrl,output,[Msg,Sender]}). call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) -> + %% Starter is also the group leader process Starter = self(), Data = {Mod,Func,TCPid,TCExitReason,Loc}, EndConfProc = fun() -> + group_leader(Starter, self()), Supervisor = self(), EndConfApply = fun() -> case catch apply(Mod,end_per_testcase,[Func,Conf]) of {'EXIT',Why} -> + timer:sleep(1), group_leader() ! {printout,12, - "ERROR! ~p:end_per_testcase(~p, ~p)" + "WARNING! " + "~p:end_per_testcase(~p, ~p)" " crashed!\n\tReason: ~p\n", [Mod,Func,Conf,Why]}; _ -> @@ -950,15 +1147,23 @@ call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) -> {'EXIT',Pid,Reason} -> Starter ! {self(),{call_end_conf,Data,{error,Reason}}} after TVal -> + exit(Pid, kill), + group_leader() ! {printout,12, + "WARNING! ~p:end_per_testcase(~p, ~p)" + " failed!\n\tReason: timetrap timeout" + " after ~w ms!\n", [Mod,Func,Conf,TVal]}, Starter ! {self(),{call_end_conf,Data,{error,timeout}}} end end, spawn_link(EndConfProc). spawn_fw_call(Mod,{init_per_testcase,Func},_,Pid,{timetrap_timeout,TVal}=Why, - Loc,SendTo,Comment) -> + Loc,SendTo) -> FwCall = fun() -> + %% set group leader so that printouts/comments + %% from the framework get printed in the logs + group_leader(SendTo, self()), Skip = {skip,{failed,{Mod,init_per_testcase,Why}}}, %% if init_per_testcase fails, the test case %% should be skipped @@ -970,12 +1175,12 @@ spawn_fw_call(Mod,{init_per_testcase,Func},_,Pid,{timetrap_timeout,TVal}=Why, end, %% finished, report back SendTo ! {self(),fw_notify_done, - {TVal/1000,Skip,Loc,[],Comment}} + {TVal/1000,Skip,Loc,[],undefined}} end, spawn_link(FwCall); spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid, - {timetrap_timeout,TVal}=Why,_Loc,SendTo,Comment) -> + {timetrap_timeout,TVal}=Why,_Loc,SendTo) -> %%! This is a temporary fix that keeps Test Server alive during %%! execution of a parallel test case group, when sometimes %%! this clause gets called with EndConf == undefined. See OTP-9594 @@ -987,6 +1192,9 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid, end, FwCall = fun() -> + %% set group leader so that printouts/comments + %% from the framework get printed in the logs + group_leader(SendTo, self()), {RetVal,Report} = case proplists:get_value(tc_status, EndConf1) of undefined -> @@ -998,6 +1206,10 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid, E = {failed,{Mod,end_per_testcase,Why}}, {Result,E} end, + group_leader() ! {printout,12, + "WARNING! ~p:end_per_testcase(~p, ~p)" + " failed!\n\tReason: timetrap timeout" + " after ~w ms!\n", [Mod,Func,EndConf,TVal]}, FailLoc = proplists:get_value(tc_fail_loc, EndConf1), case catch do_end_tc_call(Mod,Func, FailLoc, {Pid,Report,[EndConf1]}, Why) of @@ -1006,42 +1218,48 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid, _ -> ok end, - %% if end_per_testcase fails a warning should be - %% printed as comment - Comment1 = if Comment == "" -> - ""; - true -> - Comment ++ test_server_ctrl:xhtml("<br>", - "<br />") - end, - %% finished, report back + Warn = "<font color=\"red\">" + "WARNING: end_per_testcase timed out!</font>", + %% finished, report back (if end_per_testcase fails, a warning + %% should be printed as part of the comment) SendTo ! {self(),fw_notify_done, - {TVal/1000,RetVal,FailLoc,[], - [Comment1,"<font color=\"red\">" - "WARNING: end_per_testcase timed out!" - "</font>"]}} + {TVal/1000,RetVal,FailLoc,[],Warn}} end, spawn_link(FwCall); -spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo,_Comment) -> +spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) -> FwCall = fun() -> + %% set group leader so that printouts/comments + %% from the framework get printed in the logs + group_leader(SendTo, self()), test_server_sup:framework_call(report, [framework_error, - {{FwMod,FwFunc},FwError}]), + {{FwMod,FwFunc}, + FwError}]), Comment = lists:flatten( io_lib:format("<font color=\"red\">" - "WARNING! ~w:~w failed!</font>", [FwMod,FwFunc])), + "WARNING! ~w:~w failed!</font>", + [FwMod,FwFunc])), %% finished, report back SendTo ! {self(),fw_notify_done, - {died,{error,{FwMod,FwFunc,FwError}},{FwMod,FwFunc},[],Comment}} + {died,{error,{FwMod,FwFunc,FwError}}, + {FwMod,FwFunc},[],Comment}} end, spawn_link(FwCall); -spawn_fw_call(Mod,Func,_,Pid,Error,Loc,SendTo,Comment) -> +spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) -> + {Mod1,Func1} = + case {Mod,Func,CurrConf} of + {undefined,undefined,{{M,F},_}} -> {M,F}; + _ -> {Mod,Func} + end, FwCall = fun() -> - case catch fw_error_notify(Mod,Func,[], + %% set group leader so that printouts/comments + %% from the framework get printed in the logs + group_leader(SendTo, self()), + case catch fw_error_notify(Mod1,Func1,[], Error,Loc) of {'EXIT',FwErrorNotifyErr} -> exit({fw_notify_done,error_notification, @@ -1050,7 +1268,7 @@ spawn_fw_call(Mod,Func,_,Pid,Error,Loc,SendTo,Comment) -> ok end, Conf = [{tc_status,{failed,timetrap_timeout}}], - case catch do_end_tc_call(Mod,Func, Loc, + case catch do_end_tc_call(Mod1,Func1, Loc, {Pid,Error,[Conf]},Error) of {'EXIT',FwEndTCErr} -> exit({fw_notify_done,end_tc,FwEndTCErr}); @@ -1058,7 +1276,7 @@ spawn_fw_call(Mod,Func,_,Pid,Error,Loc,SendTo,Comment) -> ok end, %% finished, report back - SendTo ! {self(),fw_notify_done,{died,Error,Loc,Comment}} + SendTo ! {self(),fw_notify_done,{died,Error,Loc,[],undefined}} end, spawn_link(FwCall). @@ -1115,10 +1333,11 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, TimetrapData, LogOpts, TCCallback) -> put(test_server_multiply_timetraps, TimetrapData), put(test_server_logopts, LogOpts), - + FWInitResult = test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0], + {ok,Args0}), + group_leader() ! {test_case_initialized,self()}, {{Time,Value},Loc,Opts} = - case test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0], - {ok,Args0}) of + case FWInitResult of {ok,Args} -> run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback); Error = {error,_Reason} -> @@ -1146,6 +1365,9 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, exit({Ref,Time,Value,Loc,Opts}). run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> + %% save current state in controller loop + sync_send(group_leader(),set_curr_conf,{{Mod,Func},hd(Args)}, + 5000, fun() -> exit(no_answer_from_group_leader) end), case RunInit of run_init -> put(test_server_init_or_end_conf,{init_per_testcase,Func}), @@ -1204,8 +1426,8 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> %% call user callback function if defined EndConf1 = user_callback(TCCallback, Mod, Func, 'end', EndConf), %% update current state in controller loop - sync_send(group_leader(),set_curr_conf,EndConf1, - 5000, fun() -> exit(no_answer_from_group_leader) end), + sync_send(group_leader(),set_curr_conf,EndConf1, 5000, + fun() -> exit(no_answer_from_group_leader) end), {FWReturn1,TSReturn1,EndConf2} = case end_per_testcase(Mod, Func, EndConf1) of SaveCfg1={save_config,_} -> @@ -1530,8 +1752,18 @@ get_loc(Pid) -> lists:foreach(fun({Key,Val}) -> put(Key, Val) end, Dict), Stk = [rewrite_loc_item(Loc) || Loc <- Stk0], case get(test_server_loc) of - undefined -> put(test_server_loc, Stk); - _ -> ok + undefined -> + put(test_server_loc, Stk); + {Suite,Case} -> + %% location info unknown, check if {Suite,Case,Line} + %% is available in stacktrace. and if so, use stacktrace + %% instead of currect test_server_loc + case [match || {S,C,_L} <- Stk, S == Suite, C == Case] of + [match|_] -> put(test_server_loc, Stk); + _ -> ok + end; + _ -> + ok end, get_loc(). @@ -1561,13 +1793,20 @@ mod_loc(Loc) -> %% handle diff line num versions case Loc of [{{_M,_F},_L}|_] -> - [{?pl2a(M),F,L} || {{M,F},L} <- Loc]; + [begin if L /= 0 -> {?pl2a(M),F,L}; + true -> {?pl2a(M),F} end end || {{M,F},L} <- Loc]; [{_M,_F}|_] -> [{?pl2a(M),F} || {M,F} <- Loc]; + {{M,F},0} -> + [{?pl2a(M),F}]; {{M,F},L} -> [{?pl2a(M),F,L}]; {M,ForL} -> [{?pl2a(M),ForL}]; + {M,F,0} -> + [{M,F}]; + [{M,F,0}|Stack] -> + [{M,F}|Stack]; _ -> Loc end. @@ -1760,6 +1999,13 @@ messages_get() -> test_server_sup:messages_get([]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% permit_io(GroupLeader, FromPid) -> ok +%% +%% Make sure proceeding IO from FromPid won't get rejected +permit_io(GroupLeader, FromPid) -> + GroupLeader ! {permit_io,FromPid}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% sleep(Time) -> ok %% Time = integer() | float() | infinity %% @@ -1862,31 +2108,40 @@ fail() -> %% Break a test case so part of the test can be done manually. %% Use continue/0 to continue. break(Comment) -> - case erase(test_server_timetraps) of - undefined -> ok; - List -> lists:foreach(fun({Ref,_,_}) -> - timetrap_cancel(Ref) - end, List) - end, + break(?MODULE, Comment). + +break(CBM, Comment) -> + break(CBM, '', Comment). + +break(CBM, TestCase, Comment) -> + timetrap_cancel(), + {TCName,CntArg,PName} = + if TestCase == '' -> + {"", "", test_server_break_process}; + true -> + Str = atom_to_list(TestCase), + {[32 | Str], Str, + list_to_atom("test_server_break_process_" ++ Str)} + end, io:format(user, "\n\n\n--- SEMIAUTOMATIC TESTING ---" - "\nThe test case executes on process ~w" + "\nThe test case~s executes on process ~w" "\n\n\n~s" "\n\n\n-----------------------------\n\n" - "Continue with --> test_server:continue().\n", - [self(),Comment]), - case whereis(test_server_break_process) of + "Continue with --> ~w:continue(~s).\n", + [TCName,self(),Comment,CBM,CntArg]), + case whereis(PName) of undefined -> - spawn_break_process(self()); + spawn_break_process(self(), PName); OldBreakProcess -> OldBreakProcess ! cancel, - spawn_break_process(self()) + spawn_break_process(self(), PName) end, receive continue -> ok end. -spawn_break_process(Pid) -> +spawn_break_process(Pid, PName) -> spawn(fun() -> - register(test_server_break_process,self()), + register(PName, self()), receive continue -> continue(Pid); cancel -> ok @@ -1895,13 +2150,19 @@ spawn_break_process(Pid) -> continue() -> case whereis(test_server_break_process) of - undefined -> - ok; - BreakProcess -> - BreakProcess ! continue + undefined -> ok; + BreakProcess -> BreakProcess ! continue end. -continue(Pid) -> +continue(TestCase) when is_atom(TestCase) -> + PName = list_to_atom("test_server_break_process_" ++ + atom_to_list(TestCase)), + case whereis(PName) of + undefined -> ok; + BreakProcess -> BreakProcess ! continue + end; + +continue(Pid) when is_pid(Pid) -> Pid ! continue. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1919,14 +2180,10 @@ timetrap_scale_factor() -> {false,true} -> 2 * F0; {false,false} -> F0 end, - F2 = case has_superfluous_schedulers() of + F = case has_superfluous_schedulers() of true -> 3*F1; false -> F1 end, - F = case test_server_sup:get_os_family() of - vxworks -> 5 * F2; - _ -> F2 - end, case test_server:is_cover() of true -> 10 * F; false -> F @@ -1939,26 +2196,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 +2270,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 +2291,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 +2468,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 +2946,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..88d86285d5 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% Copyright Ericsson AB 2002-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -162,8 +162,9 @@ -export([jobs/0, run_test/1, wait_finish/0, idle_notify/1, abort_current_testcase/1, abort/0]). -export([start_get_totals/1, stop_get_totals/0]). --export([get_levels/0, set_levels/3]). +-export([reject_io_reqs/1, get_levels/0, set_levels/3]). -export([multiply_timetraps/1, scale_timetraps/1, get_timetrap_parameters/0]). +-export([create_priv_dir/1]). -export([cover/2, cover/3, cover/7, cross_cover_analyse/1, cross_cover_analyse/2, trc/1, stop_trace/0]). -export([testcase_callback/1]). @@ -217,10 +218,11 @@ -define(auto_skip_color, "#FFA64D"). -define(user_skip_color, "#FF8000"). +-define(sortable_table_name, "SortableTable"). --record(state,{jobs=[],levels={1,19,10}, - multiply_timetraps=1,scale_timetraps=true, - finish=false, +-record(state,{jobs=[], levels={1,19,10}, reject_io_reqs=false, + multiply_timetraps=1, scale_timetraps=true, + create_priv_dir=auto_per_run, finish=false, target_info, trc=false, cover=false, wait_for_node=[], testcase_callback=undefined, idle_notify=[], get_totals=false, random_seed=undefined}). @@ -428,14 +430,6 @@ run_test(CommandLine) -> testcase_callback(TCCB), add_job(Name, {command_line,SpecList}), - %% adding of jobs involves file i/o which may take long time - %% when running a nfs mounted file system (VxWorks). - case controller_call(get_target_info) of - #target_info{os_family=vxworks} -> - receive after 30000 -> ready_to_wait end; - _ -> - wait_now - end, wait_finish(). %% Converted CoverFile to a string unless it is 'none' @@ -497,6 +491,9 @@ get_levels() -> set_levels(Show, Major, Minor) -> controller_call({set_levels,Show,Major,Minor}). +reject_io_reqs(Bool) -> + controller_call({reject_io_reqs,Bool}). + multiply_timetraps(N) -> controller_call({multiply_timetraps,N}). @@ -506,6 +503,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 +646,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 +811,8 @@ handle_call({add_job,Dir,Name,TopCase,Skip}, _From, State) -> [SpecName,{State#state.multiply_timetraps, State#state.scale_timetraps}], LogDir, Name, State#state.levels, + State#state.reject_io_reqs, + State#state.create_priv_dir, State#state.testcase_callback, ExtraTools1), NewJobs = [{Name,Pid}|State#state.jobs], {reply, ok, State#state{jobs=NewJobs}}; @@ -820,6 +822,8 @@ handle_call({add_job,Dir,Name,TopCase,Skip}, _From, State) -> [SpecList,{State#state.multiply_timetraps, State#state.scale_timetraps}], LogDir, Name, State#state.levels, + State#state.reject_io_reqs, + State#state.create_priv_dir, State#state.testcase_callback, ExtraTools1), NewJobs = [{Name,Pid}|State#state.jobs], {reply, ok, State#state{jobs=NewJobs}}; @@ -837,6 +841,8 @@ handle_call({add_job,Dir,Name,TopCase,Skip}, _From, State) -> {State#state.multiply_timetraps, State#state.scale_timetraps}], LogDir, Name, State#state.levels, + State#state.reject_io_reqs, + State#state.create_priv_dir, State#state.testcase_callback, ExtraTools1), NewJobs = [{Name,Pid}|State#state.jobs], {reply, ok, State#state{jobs=NewJobs}} @@ -968,6 +974,15 @@ handle_call({set_levels,Show,Major,Minor}, _From, State) -> {reply,ok,State#state{levels={Show,Major,Minor}}}; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({reject_io_reqs,Bool}, _, State) -> ok +%% Bool = bool() +%% +%% May be used to switch off stdout printouts to the minor log file + +handle_call({reject_io_reqs,Bool}, _From, State) -> + {reply,ok,State#state{reject_io_reqs=Bool}}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% handle_call({multiply_timetraps,N}, _, State) -> ok %% N = integer() | infinity %% @@ -1045,6 +1060,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 +1328,12 @@ terminate(_Reason, State) -> end, kill_all_jobs(State#state.jobs), test_server_node:stop(State#state.target_info), - test_server_h:restore(), + case lists:keysearch(sasl, 1, application:which_applications()) of + {value,_} -> + test_server_h:restore(); + _ -> + ok + end, ok. kill_all_jobs([{_Name,JobPid}|Jobs]) -> @@ -1316,14 +1348,16 @@ kill_all_jobs([]) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% spawn_tester(Mod, Func, Args, Dir, Name, Levels, -%% TestCaseCallback, ExtraTools) -> Pid +%% spawn_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs, +%% CreatePrivDir, TestCaseCallback, ExtraTools) -> Pid %% Mod = atom() %% Func = atom() %% Args = [term(),...] %% Dir = string() %% Name = string() %% Levels = {integer(),integer(),integer()} +%% RejectIoReqs = bool() +%% CreatePrivDir = auto_per_run | manual_per_tc | auto_per_tc %% TestCaseCallback = {CBMod,CBFunc} | undefined %% ExtraTools = [ExtraTool,...] %% ExtraTool = CoverInfo | TraceInfo | RandomSeed @@ -1334,14 +1368,15 @@ kill_all_jobs([]) -> %% When the named function is done executing, a summary of the results %% is printed to the log files. -spawn_tester(Mod, Func, Args, Dir, Name, Levels, TCCallback, ExtraTools) -> +spawn_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs, + CreatePrivDir, TCCallback, ExtraTools) -> spawn_link( - fun() -> init_tester(Mod, Func, Args, Dir, Name, Levels, - TCCallback, ExtraTools) + fun() -> init_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs, + CreatePrivDir, TCCallback, ExtraTools) end). -init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, - TCCallback, ExtraTools) -> +init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, RejectIoReqs, + CreatePrivDir, TCCallback, ExtraTools) -> process_flag(trap_exit, true), put(test_server_name, Name), put(test_server_dir, Dir), @@ -1352,8 +1387,22 @@ init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, put(test_server_summary_level, SumLev), put(test_server_major_level, MajLev), put(test_server_minor_level, MinLev), + put(test_server_reject_io_reqs, RejectIoReqs), + put(test_server_create_priv_dir, CreatePrivDir), put(test_server_random_seed, proplists:get_value(random_seed, ExtraTools)), put(test_server_testcase_callback, TCCallback), + case os:getenv("TEST_SERVER_FRAMEWORK") of + FW when FW =:= false; FW =:= "undefined" -> + put(test_server_framework, '$none'); + FW -> + put(test_server_framework_name, list_to_atom(FW)), + case os:getenv("TEST_SERVER_FRAMEWORK_NAME") of + FWName when FWName =:= false; FWName =:= "undefined" -> + put(test_server_framework_name, '$none'); + FWName -> + put(test_server_framework_name, list_to_atom(FWName)) + end + end, %% before first print, read and set logging options LogOpts = test_server_sup:framework_call(get_logopts, [], []), put(test_server_logopts, LogOpts), @@ -1361,13 +1410,14 @@ init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, StartedExtraTools = start_extra_tools(ExtraTools), {TimeMy,Result} = ts_tc(Mod, Func, Args), put(test_server_common_io_handler, undefined), - stop_extra_tools(StartedExtraTools), + catch stop_extra_tools(StartedExtraTools), case Result of {'EXIT',test_suites_done} -> print(25, "DONE, normal exit", []); {'EXIT',_Pid,Reason} -> print(1, "EXIT, reason ~p", [Reason]); {'EXIT',Reason} -> + report_severe_error(Reason), print(1, "EXIT, reason ~p", [Reason]); _Other -> print(25, "DONE", []) @@ -1385,10 +1435,15 @@ init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, end, OkN = get(test_server_ok), FailedN = get(test_server_failed), - print(html,"<tr><td></td><td><b>TOTAL</b></td><td></td><td></td>" - "<td>~.3fs</td><td><b>~s</b></td><td>~p Ok, ~p Failed~s of ~p</td></tr>\n", + print(html,"\n</tbody>\n<tfoot>\n" + "<tr><td></td><td><b>TOTAL</b></td><td></td><td></td><td></td>" + "<td>~.3fs</td><td><b>~s</b></td><td>~p Ok, ~p Failed~s of ~p</td></tr>\n" + "</tfoot>\n", [Time,SuccessStr,OkN,FailedN,SkipStr,OkN+FailedN+SkippedN]). +report_severe_error(Reason) -> + test_server_sup:framework_call(report, [severe_error,Reason]). + %% timer:tc/3 ts_tc(M, F, A) -> Before = ?now, @@ -1447,7 +1502,7 @@ stop_extra_tools([], _) -> %% Reads the named test suite specification file, and executes it. %% %% This function is meant to be called by a process created by -%% spawn_tester/7, which sets up some necessary dictionary values. +%% spawn_tester/10, which sets up some necessary dictionary values. do_spec(SpecName, TimetrapSpec) when is_list(SpecName) -> case file:consult(SpecName) of @@ -1496,7 +1551,7 @@ do_spec(SpecName, TimetrapSpec) when is_list(SpecName) -> %% should not be used. Use a configuration test case instead. %% %% This function is meant to be called by a process created by -%% spawn_tester/7, which sets up some necessary dictionary values. +%% spawn_tester/10, which sets up some necessary dictionary values. do_spec_list(TermList0, TimetrapSpec) -> Nodes = [], @@ -1663,7 +1718,7 @@ add_mod(Mod, Mods) -> %% configuration information into the log files. %% %% This function is meant to be called by a process created by -%% spawn_tester/7, which sets up some necessary dictionary values. +%% spawn_tester/10, which sets up some necessary dictionary values. do_test_cases(TopCases, SkipCases, Config, MultiplyTimetrap) when is_integer(MultiplyTimetrap); MultiplyTimetrap == infinity -> @@ -1673,11 +1728,7 @@ do_test_cases(TopCases, SkipCases, Config, TimetrapData) when is_list(TopCases), is_tuple(TimetrapData) -> {ok,TestDir} = start_log_file(), - FwMod = - case os:getenv("TEST_SERVER_FRAMEWORK") of - FW when FW =:= false; FW =:= "undefined" -> ?MODULE; - FW -> list_to_atom(FW) - end, + FwMod = get_fw_mod(?MODULE), case collect_all_cases(TopCases, SkipCases) of {error,Why} -> print(1, "Error starting: ~p", [Why]), @@ -1706,7 +1757,8 @@ do_test_cases(TopCases, SkipCases, test_server_sup:framework_call(report, [tests_start,{Test,N}]), {Header,Footer} = case test_server_sup:framework_call(get_html_wrapper, - [TestDescr,true,TestDir], "") of + [TestDescr,true,TestDir, + {[],[2,3,4,7,8],[1,6]}], "") of Empty when (Empty == "") ; (element(2,Empty) == "") -> put(basic_html, true), {["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n", @@ -1768,13 +1820,15 @@ do_test_cases(TopCases, SkipCases, [?suitelog_name,?coverlog_name]), print(html, "<p>~s</p>\n" ++ - xhtml("<table bgcolor=\"white\" border=\"3\" cellpadding=\"5\">", - "<table>") ++ - "<tr><th>Num</th><th>Module</th><th>Case</th><th>Log</th>" - "<th>Time</th><th>Result</th><th>Comment</th></tr>\n", - [print_if_known(N, {"<i>Executing <b>~p</b> test cases...</i>\n",[N]}, + xhtml("<table bgcolor=\"white\" border=\"3\" cellpadding=\"5\">", + ["<table id=\"",?sortable_table_name,"\">\n", + "<thead>\n"]) ++ + "<tr><th>Num</th><th>Module</th><th>Group</th>" ++ + "<th>Case</th><th>Log</th><th>Time</th><th>Result</th>" ++ + "<th>Comment</th></tr>\n</thead>\n<tbody>\n", + [print_if_known(N, {"<i>Executing <b>~p</b> test cases...</i>" ++ + xhtml("\n<br>\n", "\n<br />\n"),[N]}, {"",[]})]), - print(html, xhtml("<br>", "<br />")), print(major, "=cases ~p", [get(test_server_cases)]), print(major, "=user ~s", [TI#target_info.username]), @@ -1812,7 +1866,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() -> @@ -1823,7 +1877,7 @@ start_log_file() -> {error, eexist} -> ok; MkDirError -> - exit({cant_create_log_dir,{MkDirError,Dir}}) + log_file_error(MkDirError, Dir) end, TestDir = timestamp_filename_get(filename:join(Dir, "run.")), TestDir1 = @@ -1838,10 +1892,10 @@ start_log_file() -> ok -> TestDirX; MkDirError2 -> - exit({cant_create_log_dir,{MkDirError2,TestDirX}}) + log_file_error(MkDirError2, TestDirX) end; MkDirError2 -> - exit({cant_create_log_dir,{MkDirError2,TestDir}}) + log_file_error(MkDirError2, TestDir) end, ok = file:write_file(filename:join(Dir, ?last_file), TestDir1 ++ "\n"), ok = file:write_file(?last_file, TestDir1 ++ "\n"), @@ -1868,6 +1922,9 @@ start_log_file() -> test_server_sup:framework_call(report, [loginfo,LogInfo]), {ok,TestDir1}. +log_file_error(Error, Dir) -> + exit({cannot_create_log_dir,{Error,lists:flatten(Dir)}}). + make_html_link(LinkName, Target, Explanation) -> %% if possible use a relative reference to Target. TargetL = filename:split(Target), @@ -1928,7 +1985,8 @@ start_minor_log_file1(Mod, Func, LogDir, AbsName) -> {Header,Footer} = case test_server_sup:framework_call(get_html_wrapper, [TestDescr,false, - filename:dirname(AbsName)], "") of + filename:dirname(AbsName), + undefined], "") of Empty when (Empty == "") ; (element(2,Empty) == "") -> put(basic_html, true), {["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n", @@ -2058,7 +2116,7 @@ html_possibly_convert(Src, SrcInfo, Dest) -> Header = case test_server_sup:framework_call(get_html_wrapper, ["Module "++Src,false, - OutDir], "") of + OutDir,undefined], "") of Empty when (Empty == "") ; (element(2,Empty) == "") -> ["<!DOCTYPE HTML PUBLIC", "\"-//W3C//DTD HTML 3.2 Final//EN\">\n", @@ -2101,17 +2159,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 +2181,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 +2191,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 +2211,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 +2238,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 +2255,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 +2852,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 +2871,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 +3024,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 +3195,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 +3374,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 +3758,14 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, %% if this runs on a parallel test case process, %% copy the dictionary from the main process do_if_parallel(Main, fun() -> process_flag(trap_exit, true) end, ok), - CopyDict = fun() -> lists:foreach(fun({Key,Val}) -> put(Key, Val) end, State) end, + CopyDict = fun() -> lists:foreach(fun({Key,Val}) -> + put(Key, Val) + end, State) + end, do_if_parallel(Main, CopyDict, ok), - do_if_parallel(Main, fun() -> put(test_server_common_io_handler, {tc,Main}) end, ok), + do_if_parallel(Main, fun() -> + put(test_server_common_io_handler, {tc,Main}) + end, ok), %% if io is being buffered, send start io session message %% (no matter if case runs on parallel or main process) case get(test_server_common_io_handler) of @@ -3649,24 +3785,58 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, MinorBase = filename:basename(MinorName), print(major, "=logfile ~s", [filename:basename(MinorName)]), - Args1 = [[{tc_logfile,MinorName} | proplists:delete(tc_logfile,hd(Args))]], - test_server_sup:framework_call(report, [tc_start,{{?pl2a(Mod),Func},MinorName}]), + UpdatedArgs = + %% maybe create unique private directory for test case or config func + case get(test_server_create_priv_dir) of + auto_per_run -> + update_config(hd(Args), [{tc_logfile,MinorName}]); + PrivDirMode -> + RunDir = filename:dirname(MinorName), + Ext = + if Num == 0 -> + {_,S,Us} = now(), + lists:flatten(io_lib:format(".~w.~w", [S,Us])); + true -> + %% create unique private directory for test case + RunDir = filename:dirname(MinorName), + lists:flatten(io_lib:format(".~w", [Num])) + end, + PrivDir = filename:join(RunDir, ?priv_dir) ++ Ext, + if PrivDirMode == auto_per_tc -> + ok = file:make_dir(PrivDir); + PrivDirMode == manual_per_tc -> + ok + end, + update_config(hd(Args), [{priv_dir,PrivDir++"/"}, + {tc_logfile,MinorName}]) + end, + + test_server_sup:framework_call(report, + [tc_start,{{?pl2a(Mod),Func},MinorName}]), print_props((RunInit==skip_init), get_props(Mode)), + GroupName = case get_name(Mode) of + undefined -> ""; + Name -> cast_to_list(Name) + end, print(major, "=started ~s", [lists:flatten(timestamp_get(""))]), {{Col0,Col1},Style} = get_font_style((RunInit==run_init), Mode), TR = xhtml("<tr valign=\"top\">", ["<tr class=\"",odd_or_even(),"\">"]), print(html, TR ++ "<td>" ++ Col0 ++ "~s" ++ Col1 ++ "</td>" "<td>" ++ Col0 ++ "~p" ++ Col1 ++ "</td>" + "<td>" ++ Col0 ++ "~s" ++ Col1 ++ "</td>" "<td><a href=\"~s\">~p</a></td>" "<td><a href=\"~s#top\"><</a> <a href=\"~s#end\">></a></td>", - [num2str(Num),Mod,MinorBase,Func,MinorBase,MinorBase]), + [num2str(Num),fw_name(Mod),GroupName,MinorBase,Func, + MinorBase,MinorBase]), do_if_parallel(Main, ok, fun erlang:yield/0), + + RejectIoReqs = get(test_server_reject_io_reqs), %% run the test case {Result,DetectedFail,ProcsBefore,ProcsAfter} = - run_test_case_apply(Num, Mod, Func, Args1, get_name(Mode), - RunInit, Where, TimetrapData), + run_test_case_apply(Num, Mod, Func, [UpdatedArgs], get_name(Mode), + RunInit, Where, TimetrapData, RejectIoReqs), {Time,RetVal,Loc,Opts,Comment} = case Result of Normal={_Time,_RetVal,_Loc,_Opts,_Comment} -> Normal; @@ -4107,6 +4277,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 +4420,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 +4429,7 @@ format_exception(Reason={_Error,Stack}) when is_list(Stack) -> do_format_exception(Reason) end; FW -> - case application:get_env(list_to_atom(FW), format_exception) of + case application:get_env(FW, format_exception) of {ok,false} -> {"~p",Reason}; _ -> @@ -4245,7 +4455,7 @@ do_format_exception(Reason={Error,Stack}) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, -%% Where, TimetrapData) -> +%% Where, TimetrapData, RejectIoReqs) -> %% {{Time,RetVal,Loc,Opts,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} | %% {{died,Reason,unknown,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} %% Name = atom() @@ -4264,19 +4474,21 @@ do_format_exception(Reason={Error,Stack}) -> %% sent over socket to target, and test_server runs the case and sends the %% result back over the socket. Else test_server runs the case directly on host. -run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, host, TimetrapData) -> +run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, host, + TimetrapData, RejectIoReqs) -> test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit, - TimetrapData}); -run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, target, TimetrapData) -> + TimetrapData,RejectIoReqs}); +run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, target, + TimetrapData, RejectIoReqs) -> case get(test_server_ctrl_job_sock) of undefined -> %% local target test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit, - TimetrapData}); + TimetrapData,RejectIoReqs}); JobSock -> %% remote target request(JobSock, {test_case,{CaseNum,Mod,Func,Args,Name,RunInit, - TimetrapData}}), + TimetrapData,RejectIoReqs}}), read_job_sock_loop(JobSock) end. @@ -4474,21 +4686,16 @@ output_to_fd(stdout, Msg, Sender) -> io:format("Testing ~s: ~s\n", [Name, lists:flatten(Msg)]); output_to_fd(undefined, _Msg, _Sender) -> ok; -output_to_fd(Fd, [$=|Msg], internal) -> - io:put_chars(Fd, [$=]), - io:put_chars(Fd, Msg), - io:put_chars(Fd, "\n"); +output_to_fd(Fd, Msg=[$=|_], internal) -> + io:put_chars(Fd, [Msg,"\n"]); output_to_fd(Fd, Msg, internal) -> - io:put_chars(Fd, [$=,$=,$=,$ ]), - io:put_chars(Fd, Msg), - io:put_chars(Fd, "\n"); + io:put_chars(Fd, [$=,$=,$=,$ , Msg, "\n"]); output_to_fd(Fd, Msg, _Sender) -> - io:put_chars(Fd, Msg), case get(test_server_log_nl) of - false -> ok; - _ -> io:put_chars(Fd, "\n") + false -> io:put_chars(Fd, Msg); + _ -> io:put_chars(Fd, [Msg,"\n"]) end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -4815,8 +5022,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 +5031,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 +5187,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 %% @@ -5618,11 +5829,11 @@ write_default_cross_coverlog(TestDir) -> {ok,CrossCoverLog} = file:open(filename:join(TestDir,?cross_coverlog_name), [write]), write_coverlog_header(CrossCoverLog), - io:fwrite(CrossCoverLog, - ["No cross cover modules exist for this application,", - xhtml("<br>","<br />"), - "or cross cover analysis is not completed.\n" - "</body></html>\n"], []), + io:put_chars(CrossCoverLog, + ["No cross cover modules exist for this application,", + xhtml("<br>","<br />"), + "or cross cover analysis is not completed.\n" + "</body></html>\n"]), file:close(CrossCoverLog). write_cover_result_table(CoverLog,Coverage) -> 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_internal.hrl b/lib/test_server/src/test_server_internal.hrl index c9c52854e3..b58b42805e 100644 --- a/lib/test_server/src/test_server_internal.hrl +++ b/lib/test_server/src/test_server_internal.hrl @@ -25,7 +25,7 @@ %% test_server_ctrl:contact_main_target/2 %% Once initiated, this information will never change!! -record(target_info, {where, % local | Socket - os_family, % atom(); win32 | unix | vxworks | ose + os_family, % atom(); win32 | unix os_type, % result of os:type() host, % string(); the name of the target machine version, % string() diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl index 1fd40d1dd9..17c02dfbe5 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 @@ -35,7 +35,6 @@ -include("test_server_internal.hrl"). -record(slave_info, {name,socket,client}). --define(VXWORKS_ACCEPT_TIMEOUT,?ACCEPT_TIMEOUT). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% @@ -72,14 +71,6 @@ start_remote_main_target(Parameters) -> lists:foreach(fun(T) -> maybe_reboot_target({TargetType,T}) end, [list_to_atom(TargetHost)|SlaveTargets]), - % Must give the targets a chance to reboot... - case TargetType of - vxworks -> - receive after 15000 -> ok end; - _ -> - ok - end, - Cmd0 = get_main_target_start_command(TargetType,TargetHost,Naming, MasterNode,MasterCookie), Cmd = @@ -407,7 +398,7 @@ start_node_peer(SlaveName, OptList, From, TI) -> % Support for erl_crash_dump files.. CrashFile = filename:join([TI#target_info.test_server_dir, "erl_crash_dump."++cast_to_list(SlaveName)]), - CrashArgs = lists:concat([" -env ERL_CRASH_DUMP ",CrashFile," "]), + CrashArgs = lists:concat([" -env ERL_CRASH_DUMP \"",CrashFile,"\" "]), FailOnError = start_node_get_option_value(fail_on_error, OptList, true), Pa = TI#target_info.test_server_dir, Prog0 = start_node_get_option_value(erl, OptList, default), @@ -420,7 +411,7 @@ start_node_peer(SlaveName, OptList, From, TI) -> Cmd = lists:concat([Prog, " -detached ", TI#target_info.naming, " ", SlaveName, - " -pa ", Pa, + " -pa \"", Pa,"\"", NodeStarted, CrashArgs, " ", Args]), @@ -462,9 +453,6 @@ start_node_peer(SlaveName, OptList, From, TI) -> %% %% Slave nodes are started on a remote host if %% - the option remote is given when calling test_server:start_node/3 -%% or -%% - the target type is vxworks, since only one erlang node -%% can be started on each vxworks host. %% start_node_slave(SlaveName, OptList, From, TI) -> SuppliedArgs = start_node_get_option_value(args, OptList, []), @@ -472,9 +460,9 @@ start_node_slave(SlaveName, OptList, From, TI) -> CrashFile = filename:join([TI#target_info.test_server_dir, "erl_crash_dump."++cast_to_list(SlaveName)]), - CrashArgs = lists:concat([" -env ERL_CRASH_DUMP ",CrashFile," "]), + CrashArgs = lists:concat([" -env ERL_CRASH_DUMP \"",CrashFile,"\" "]), Pa = TI#target_info.test_server_dir, - Args = lists:concat([" -pa ", Pa, " ", SuppliedArgs, CrashArgs]), + Args = lists:concat([" -pa \"", Pa, "\" ", SuppliedArgs, CrashArgs]), Prog0 = start_node_get_option_value(erl, OptList, default), Prog = pick_erl_program(Prog0), @@ -787,19 +775,6 @@ kill_node(SI,TI) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Platform specific code -start_target(vxworks,TargetHost,Cmd) -> - case vxworks_client:open(TargetHost) of - {ok,P} -> - case vxworks_client:send_data(P,Cmd,"start_erl called") of - {ok,_} -> - {ok,{vxworks,P},?VXWORKS_ACCEPT_TIMEOUT}; - Error -> - Error - end; - Error -> - Error - end; - start_target(unix,TargetHost,Cmd0) -> Cmd = case test_server_sup:hoststr() of @@ -809,19 +784,9 @@ start_target(unix,TargetHost,Cmd0) -> open_port({spawn, Cmd}, [stream]), {ok,undefined,?ACCEPT_TIMEOUT}. -maybe_reboot_target({vxworks,P}) when is_pid(P) -> - %% Reboot the vxworks card. - %% Client is also closed after this, even if reboot fails - vxworks_client:send_data_wait_for_close(P,"q"); -maybe_reboot_target({vxworks,T}) when is_atom(T) -> - %% Reboot the vxworks card. - %% Client is also closed after this, even if reboot fails - vxworks_client:reboot(T); maybe_reboot_target(_) -> {error, cannot_reboot_target}. -close_target_client({vxworks,P}) -> - vxworks_client:close(P); close_target_client(undefined) -> ok. @@ -830,11 +795,6 @@ close_target_client(undefined) -> %% %% Command for starting main target %% -get_main_target_start_command(vxworks,_TargetHost,Naming, - _MasterNode,_MasterCookie) -> - "e" ++ Naming ++ " test_server -boot start_sasl" - " -sasl errlog_type error" - " -s test_server start " ++ test_server_sup:hoststr(); get_main_target_start_command(unix,_TargetHost,Naming, _MasterNode,_MasterCookie) -> Prog = pick_erl_program(default), @@ -845,9 +805,6 @@ get_main_target_start_command(unix,_TargetHost,Naming, %% %% Command for starting slave nodes %% -get_slave_node_start_command(vxworks, _Prog, _MasterNode) -> - "e"; - %"e-noinput -master " ++ MasterNode; get_slave_node_start_command(unix, Prog, MasterNode) -> cast_to_list(Prog) ++ " -detached -master " ++ MasterNode. @@ -943,12 +900,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..4a27c1ebae 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), @@ -459,10 +473,8 @@ getenv_any([]) -> "". %% %% Returns the OS family get_os_family() -> - case os:type() of - {OsFamily,_OsName} -> OsFamily; - OsFamily -> OsFamily - end. + {OsFamily,_OsName} = os:type(), + OsFamily. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index 729a2b11fc..db16b6ecd2 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 @@ -25,11 +25,12 @@ -module(ts). -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, + bench/0, bench/1, bench/2, benchmarks/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]). @@ -39,20 +40,14 @@ %%% the modules: %%% %%% +-- ts_install --+------ ts_autoconf_win32 -%%% | | -%%% | +------ ts_autoconf_vxworks %%% | %%% ts ---+ +------ ts_erl_config %%% | | ts_lib -%%% | +------ ts_make -%%% | | -%%% +-- ts_run -----+ -%%% | ts_filelib -%%% +------ ts_make_erl -%%% | -%%% +------ ts_reports (indirectly) -%%% -%%% +%%% +-- ts_run -----+------ ts_make +%%% | | ts_filelib +%%% | +------ ts_make_erl +%%% | +%%% +-- ts_benchmark %%% %%% The modules ts_lib and ts_filelib contains utilities used by %%% the other modules. @@ -62,8 +57,7 @@ %%% ts Frontend to the test server framework. Contains all %%% interface functions. %%% ts_install Installs the test suite. On Unix, `autoconf' is -%%% is used; on Windows, ts_autoconf_win32 is used, -%%% on VxWorks, ts_autoconf_vxworks is used. +%%% is used; on Windows, ts_autoconf_win32 is used. %%% The result is written to the file `variables'. %%% ts_run Supervises running of the tests. %%% ts_autconf_win32 An `autoconf' for Windows. @@ -76,10 +70,9 @@ %%% and other platforms. %%% ts_make_erl A corrected version of the standar Erlang module %%% make (used for rebuilding test suites). -%%% ts_reports Generates index pages in HTML, providing a summary -%%% of the tests run. %%% ts_lib Miscellanous utility functions, each used by several %%% other modules. +%%% ts_benchmark Supervises otp benchmarks and collects results. %%%---------------------------------------------------------------------- -include_lib("kernel/include/file.hrl"). @@ -88,35 +81,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() -> @@ -137,7 +120,7 @@ help(installed) -> " ts:run(Spec, Mod) - Run a single test suite.\n", " ts:run(Spec, Mod, Case)\n", " - Run a single test case.\n", - " All above run functions can have the additional Options argument\n", + " All above run functions can have an additional Options argument\n", " which is a list of options.\n", "\n", "Run options supported:\n", @@ -167,13 +150,10 @@ help(installed) -> " {ctp | ctpl, Mod, Func}\n", " {ctp | ctpl, Mod, Func, Arity}\n", "\n", - "Support functions\n", + "Support functions:\n", " ts:tests() - Shows all available families of tests.\n", " ts:tests(Spec) - Shows all available test modules in Spec,\n", " i.e. ../Spec_test/*_SUITE.erl\n", - " ts:index() - Updates local index page.\n", - " ts:clean() - Cleans up all but the last tests run.\n", - " ts:clean(all) - Cleans up all test runs found.\n", " ts:estone() - Run estone_SUITE in kernel application with\n" " no run options\n", " ts:estone(Opts) - Run estone_SUITE in kernel application with\n" @@ -183,53 +163,31 @@ 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" + "Benchmark functions:\n" + " ts:benchmarks() - Get all available families of benchmarks\n" + " ts:bench() - Runs all benchmarks\n" + " ts:bench(Spec) - Runs all benchmarks in the given spec file.\n" + " The spec file is actually ../*_test/Spec_bench.spec\n\n" + " ts:bench can take the same Options argument as ts:run.\n" + "\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. - -index() -> - check_and_run(fun(_Vars) -> ts_reports:make_index(), ok end). - -%% -%% clean(all) -%% Deletes all logfiles. -%% -clean(all) -> - delete_files(filelib:wildcard("*" ++ ?logdir_ext)). - -%% clean/0 -%% -%% Cleans up run logfiles, all but the last run. -clean() -> - clean1(filelib:wildcard("*" ++ ?logdir_ext)). - -clean1([Dir|Dirs]) -> - List0 = filelib:wildcard(filename:join(Dir, "run.*")), - case lists:reverse(lists:sort(List0)) of - [] -> ok; - [_Last|Rest] -> delete_files(Rest) - end, - clean1(Dirs); -clean1([]) -> ok. %% run/0 %% Runs all specs found by ts:tests(), if any, or returns @@ -301,7 +259,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 +298,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) -> @@ -479,6 +460,25 @@ tests(Spec) -> {ok, Cwd} = file:get_cwd(), ts_lib:suites(Cwd, atom_to_list(Spec)). +%% Benchmark related functions + +bench() -> + bench([]). + +bench(Opts) when is_list(Opts) -> + bench(benchmarks(),Opts); +bench(Spec) -> + bench([Spec],[]). + +bench(Spec, Opts) when is_atom(Spec) -> + bench([Spec],Opts); +bench(Specs, Opts) -> + check_and_run(fun(Vars) -> ts_benchmark:run(Specs, Opts, Vars) end). + +benchmarks() -> + ts_benchmark:benchmarks(). + + %% %% estone/0, estone/1 @@ -540,32 +540,6 @@ run_test(File, Args, Options) -> run_test(File, Args, Options, Vars) -> ts_run:run(File, Args, Options, Vars). - -delete_files([]) -> ok; -delete_files([Item|Rest]) -> - case file:delete(Item) of - ok -> - delete_files(Rest); - {error,eperm} -> - file:change_mode(Item, 8#777), - delete_files(filelib:wildcard(filename:join(Item, "*"))), - file:del_dir(Item), - ok; - {error,eacces} -> - %% We'll see about that! - file:change_mode(Item, 8#777), - case file:delete(Item) of - ok -> ok; - {error,_} -> - erlang:yield(), - file:change_mode(Item, 8#777), - file:delete(Item), - ok - end; - {error,_} -> ok - end, - delete_files(Rest). - %% This module provides some convenient shortcuts to running %% the test server from within a started Erlang shell. @@ -705,3 +679,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..5e829f3575 100644 --- a/lib/test_server/src/ts.hrl +++ b/lib/test_server/src/ts.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. 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 @@ -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_vxworks.erl b/lib/test_server/src/ts_autoconf_vxworks.erl deleted file mode 100644 index f4535cd89a..0000000000 --- a/lib/test_server/src/ts_autoconf_vxworks.erl +++ /dev/null @@ -1,191 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%%% Purpose : Autoconf for cross environments. - --module(ts_autoconf_vxworks). --export([configure/1]). -%%% Supported cross platforms: --define(PLATFORMS, ["vxworks_cpu32", "vxworks_ppc860", "vxworks_ppc603", - "vxworks_sparc", "vxworks_ppc750", "vxworks_simso"]). --include("ts.hrl"). - -%% takes an argument {Target_arch, Target_host} (e.g. {vxworks_ppc860, thorin}). -configure({Target_arch, Target_host}) -> - case variables({Target_arch, Target_host}) of - {ok, Vars} -> - ts_lib:subst_file("conf_vars.in", "conf_vars", Vars); - Error -> - Error - end. - -variables(Cross_spec) -> - run_tests(Cross_spec, tests(), []). - -run_tests(Cross_spec, [{Prompt, Tester}|Rest], Vars) -> - io:format("checking ~s... ", [Prompt]), - case catch Tester(Cross_spec, Vars) of - {'EXIT', Reason} -> - io:format("FAILED~nExit status: ~p~n", [Reason]), - {error, auto_conf_failed}; - {Result, NewVars} -> - io:format("~s~n", [lists:concat([Result])]), - run_tests(Cross_spec, Rest, NewVars) - end; -run_tests(_Cross_spec, [], Vars) -> - {ok, Vars}. - - -%%% The tests. - -tests() -> - [{"supported target architecture", fun target_architecture/2}, - {"cross target host to run tests on", fun target_host/2}, - {"CPU type", fun cpu/2}, - {"for cross-compiling gcc", fun find_gcc/2}, - {"for cross-linker", fun find_ld/2}, - {"for object extension", fun find_obj/2}, - {"for shared libraries extension", fun find_dll/2}, - {"for executables extension", fun find_exe/2}, - {"for make", fun find_make/2}]. - -target_architecture({Architecture, _Target_host}, Vars) -> - case lists:member(Architecture, ?PLATFORMS) of - true -> - {Architecture, [{host_os, os_type(Architecture)}, {host, Architecture}|Vars]}; - false -> - {"unsupported_platform", Vars} - end. - -target_host({_Architecture, Target_host}, Vars) -> - {Target_host, [{target_host, Target_host} | Vars]}. - -cpu({Arch, _Target_host}, Vars) -> - Cpu = processor(Arch), - {Cpu, [{host_cpu, Cpu}|Vars]}. - -find_gcc({Arch, _Target_host}, Vars) -> - Gcc = "cc" ++ gnu_suffix(Arch), - case os:find_executable(Gcc) of - false -> - {no, Vars}; - Path when is_list(Path) -> - Cflags = cflags(Arch), - {Path, [{'CC', Gcc}, - {'CFLAGS', Cflags}, - {'EI_CFLAGS', Cflags}, - {'ERTS_CFLAGS', Cflags}, - {'DEFS', ""}, - {'ERTS_LIBS', ""}, - {'LIBS', ""}, - {'SHLIB_CFLAGS', Cflags}, - {test_c_compiler, "{gnuc, undefined}"} | Vars]} - end. - -find_ld({Arch, _Target_host}, Vars) -> - Linker = "ld" ++ gnu_suffix(Arch), - case os:find_executable(Linker) of - false -> - {no, Vars}; - Path when is_list(Path) -> - {Path, [{'LD', Linker}, - {'CROSSLDFLAGS', ldflags(Arch)}, - {'SHLIB_EXTRACT_ALL', ""}, - {'SHLIB_LD', Linker}, - {'SHLIB_LDFLAGS', ""}, - {'SHLIB_LDLIBS', ""} | Vars]} - end. - -find_obj({Arch, _Target_host}, Vars) -> - Obj = obj_ext(Arch), - {Obj, [{obj, Obj}|Vars]}. - -find_dll({Arch, _Target_host}, Vars) -> - Dll = dll_ext(Arch), - {Dll, [{'SHLIB_SUFFIX', Dll}|Vars]}. - -find_exe({Arch, _Target_host}, Vars) -> - Exe = exe_ext(Arch), - {Exe, [{exe, Exe}|Vars]}. - -find_make(_, Vars) -> - {"make", [{make_command, "make"} | Vars]}. - -%%% some utility functions -gnu_suffix(Arch) -> - {_, _, _, _, Suffix, _Cpu, _Cflags, _} = cross_data(Arch), - Suffix. - -processor(Arch) -> - {_, _, _, _, _Suffix, Cpu, _Cflags, _} = cross_data(Arch), - Cpu. - -cflags(Arch) -> - {_, _, _, _, _Suffix, _Cpu, Cflags, _} = cross_data(Arch), - Cflags. - -ldflags(Arch) -> - {_, _, _, _, _Suffix, _Cpu, _Cflags, Ldflags} = cross_data(Arch), - Ldflags. - -os_type(Arch) -> - {Os_type, _, _, _, _, _, _, _} = cross_data(Arch), - Os_type. - -obj_ext(Arch) -> - {_, _, Obj, _, _, _, _, _} = cross_data(Arch), - Obj. - -dll_ext(Arch) -> - {_, _, _, Dll, _, _, _, _} = cross_data(Arch), - Dll. - -exe_ext(Arch) -> - {_, Exe, _, _, _, _, _, _} = cross_data(Arch), - Exe. - -cross_data(Arch) -> - case Arch of - "vxworks_cpu32" -> - {"VxWorks", "", ".o", ".eld", "68k", "cpu32", - "-DCPU=CPU32 -DVXWORKS -I$(WIND_BASE)/target/h -mnobitfield -fno-builtin -nostdinc -fvolatile -msoft-float", - "-r -d"}; - "vxworks_ppc860" -> - {"VxWorks", "", ".o", ".eld", "ppc", "ppc860", - "-DCPU=PPC860 -DVXWORKS -I$(WIND_BASE)/target/h -mcpu=860 -fno-builtin -fno-for-scope -msoft-float -D_GNU_TOOL -nostdinc", - "-r -d"}; - "vxworks_ppc603" -> - {"VxWorks", "", ".o", ".eld", "ppc", "ppc603", - "-DCPU=PPC603 -DVXWORKS -I$(WIND_BASE)/target/h -fno-builtin -fno-for-scope -D_GNU_TOOL -nostdinc", - "-r -d"}; - "vxworks_sparc" -> - %%% The Sparc Architecture is included for private use (i.e. not Tornado 1.0.1 compatible). - {"VxWorks", "", ".o", ".eld", "sparc", "sparc", - "-DCPU=SPARC -DVXWORKS -I/home/gandalf/bsproj/BS.2/UOS/vw/5.2/h -fno-builtin -nostdinc", - "-r -d"}; - "vxworks_ppc750" -> - {"VxWorks", "", ".o", ".eld", "ppc", "ppc604", - "-DCPU=PPC604 -DVXWORKS -DTOOL_FAMILY=gnu -DTOOL=gnu -I$(WIND_BASE)/target/h -fno-builtin -fno-for-scope -D_GNU_TOOL", - "-r -d"}; - "vxworks_simso" -> - {"VxWorks", "", ".o", ".eld", "simso", "simso", - "-DCPU=SIMSPARCSOLARIS -DVXWORKS -DTOOL_FAMILY=gnu -DTOOL=gnu -I$(WIND_BASE)/target/h -I$(WIND_GCC_INCLUDE) -fno-builtin -fno-for-scope -D_GNU_TOOL", - "-r -d"} - - end. diff --git a/lib/test_server/src/ts_autoconf_win32.erl b/lib/test_server/src/ts_autoconf_win32.erl index 9103542fd2..4a5c5c7603 100644 --- a/lib/test_server/src/ts_autoconf_win32.erl +++ b/lib/test_server/src/ts_autoconf_win32.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. 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 @@ -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_benchmark.erl b/lib/test_server/src/ts_benchmark.erl new file mode 100644 index 0000000000..516d22fd2d --- /dev/null +++ b/lib/test_server/src/ts_benchmark.erl @@ -0,0 +1,91 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012-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 +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(ts_benchmark). + +-include_lib("common_test/include/ct_event.hrl"). +-include_lib("kernel/include/file.hrl"). +-include("ts.hrl"). + +-export([benchmarks/0, + run/3]). + +%% gen_event callbacks +-export([init/1, handle_event/2]). + +benchmarks() -> + {ok, Cwd} = file:get_cwd(), + Benches = filelib:wildcard( + filename:join([Cwd,"..","*_test","*_bench.spec"])), + [begin + Base = filename:basename(N), + list_to_atom(string:substr(Base,1,string:rstr(Base,"_")-1)) + end || N <- Benches]. + +run(Specs, Opts, Vars) -> + {ok, Cwd} = file:get_cwd(), + {{YY,MM,DD},{HH,Mi,SS}} = calendar:local_time(), + BName = lists:concat([YY,"_",MM,"_",DD,"T",HH,"_",Mi,"_",SS]), + BDir = filename:join([Cwd,BName]), + file:make_dir(BDir), + [ts_run:run(atom_to_list(Spec), + [{spec, [atom_to_list(Spec)++"_bench.spec"]}], + [{event_handler, {ts_benchmark, [Spec,BDir]}}|Opts],Vars) + || Spec <- Specs], + file:delete(filename:join(Cwd,"latest_benchmark")), + {ok,D} = file:open(filename:join(Cwd,"latest_benchmark"),[write]), + io:format(D,BDir,[]), + file:close(D). + + +%%%=================================================================== +%%% gen_event callbacks +%%%=================================================================== + +-record(state, { spec, suite, tc, stats_dir}). + +init([Spec,Dir]) -> + {ok, #state{ spec = Spec, stats_dir = Dir }}. + +handle_event(#event{name = tc_start, data = {Suite,Tc}}, State) -> + {ok,State#state{ suite = Suite, tc = Tc}}; +handle_event(#event{name = benchmark_data, data = Data}, State) -> + Spec = proplists:get_value(application, Data, State#state.spec), + Suite = proplists:get_value(suite, Data, State#state.suite), + Tc = proplists:get_value(name, Data, State#state.tc), + Value = proplists:get_value(value, Data), + {ok, D} = file:open(filename:join( + [State#state.stats_dir, + lists:concat([e(Spec),"-",e(Suite),"-", + e(Tc),".ebench"])]), + [append]), + io:format(D, "~p~n",[Value]), + file:close(D), + {ok, State}; +handle_event(_Event, State) -> + {ok, State}. + + +e(Atom) when is_atom(Atom) -> + Atom; +e(Str) when is_list(Str) -> + lists:map(fun($/) -> + $\\; + (C) -> + C + end,Str). diff --git a/lib/test_server/src/ts_erl_config.erl b/lib/test_server/src/ts_erl_config.erl index 5585e8ccd3..73abe86e11 100644 --- a/lib/test_server/src/ts_erl_config.erl +++ b/lib/test_server/src/ts_erl_config.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 @@ -128,15 +128,15 @@ erts_lib(Vars,OsType) -> ErtsLibInternal} end, [{erts_lib_include, - filename:nativename(ErtsLibInclude)}, + quote(filename:nativename(ErtsLibInclude))}, {erts_lib_include_generated, - filename:nativename(ErtsLibIncludeGenerated)}, + quote(filename:nativename(ErtsLibIncludeGenerated))}, {erts_lib_include_internal, - filename:nativename(ErtsLibIncludeInternal)}, + quote(filename:nativename(ErtsLibIncludeInternal))}, {erts_lib_include_internal_generated, - filename:nativename(ErtsLibIncludeInternalGenerated)}, - {erts_lib_path, filename:nativename(ErtsLibPath)}, - {erts_lib_internal_path, filename:nativename(ErtsLibInternalPath)}, + quote(filename:nativename(ErtsLibIncludeInternalGenerated))}, + {erts_lib_path, quote(filename:nativename(ErtsLibPath))}, + {erts_lib_internal_path, quote(filename:nativename(ErtsLibInternalPath))}, {erts_lib_multi_threaded, erts_lib_name(multi_threaded, OsType)}, {erts_lib_single_threaded, erts_lib_name(single_threaded, OsType)} | Vars]. @@ -145,13 +145,13 @@ erl_include(Vars) -> Include = case erl_root(Vars) of {installed, Root} -> - filename:join([Root, "usr", "include"]); + quote(filename:join([Root, "usr", "include"])); {srctree, Root, Target} -> - filename:join([Root, "erts", "emulator", "beam"]) - ++ " -I" ++ filename:join([Root, "erts", "emulator"]) + quote(filename:join([Root, "erts", "emulator", "beam"])) + ++ " -I" ++ quote(filename:join([Root, "erts", "emulator"])) ++ system_include(Root, Vars) - ++ " -I" ++ filename:join([Root, "erts", "include"]) - ++ " -I" ++ filename:join([Root, "erts", "include", Target]) + ++ " -I" ++ quote(filename:join([Root, "erts", "include"])) + ++ " -I" ++ quote(filename:join([Root, "erts", "include", Target])) end, [{erl_include, filename:nativename(Include)}|Vars]. @@ -160,10 +160,9 @@ system_include(Root, Vars) -> SysDir = case ts_lib:var(os, Vars) of "Windows" ++ _T -> "sys/win32"; - "VxWorks" -> "sys.vxworks"; _ -> "sys/unix" end, - " -I" ++ filename:nativename(filename:join([Root, "erts", "emulator", SysDir])). + " -I" ++ quote(filename:nativename(filename:join([Root, "erts", "emulator", SysDir]))). erl_interface(Vars,OsType) -> {Incl, {LibPath, MkIncl}} = @@ -176,9 +175,6 @@ erl_interface(Vars,OsType) -> {installed, _Root} -> {filename:join(Dir, "lib"), filename:join(Dir, "src")}; - {srctree, _Root, _Target} when OsType =:= vxworks -> - {filename:join(Dir, "lib"), - filename:join([Dir, "src"])}; {srctree, _Root, Target} -> {filename:join([Dir, "obj", Target]), filename:join([Dir, "src", Target])} @@ -218,22 +214,18 @@ erl_interface(Vars,OsType) -> {unix,_} -> "-lpthread"; _ -> - "" % VxWorks + "" end, - CrossCompile = case OsType of - vxworks -> "true"; - _ -> "false" - end, - [{erl_interface_libpath, filename:nativename(LibPath)}, + [{erl_interface_libpath, quote(filename:nativename(LibPath))}, {erl_interface_sock_libs, sock_libraries(OsType)}, {erl_interface_lib, Lib}, {erl_interface_eilib, Lib1}, {erl_interface_lib_drv, LibDrv}, {erl_interface_eilib_drv, Lib1Drv}, {erl_interface_threadlib, ThreadLib}, - {erl_interface_include, filename:nativename(Incl)}, - {erl_interface_mk_include, filename:nativename(MkIncl)}, - {erl_interface_cross_compile, CrossCompile} | Vars]. + {erl_interface_include, quote(filename:nativename(Incl))}, + {erl_interface_mk_include, quote(filename:nativename(MkIncl))} + | Vars]. ic(Vars, OsType) -> {ClassPath, LibPath, Incl} = @@ -250,10 +242,10 @@ ic(Vars, OsType) -> end, filename:join(Dir, "include")} end, - [{ic_classpath, filename:nativename(ClassPath)}, - {ic_libpath, filename:nativename(LibPath)}, + [{ic_classpath, quote(filename:nativename(ClassPath))}, + {ic_libpath, quote(filename:nativename(LibPath))}, {ic_lib, link_library("ic", OsType)}, - {ic_include_path, filename:nativename(Incl)}|Vars]. + {ic_include_path, quote(filename:nativename(Incl))}|Vars]. jinterface(Vars, _OsType) -> ClassPath = @@ -263,7 +255,7 @@ jinterface(Vars, _OsType) -> Dir -> filename:join([Dir, "priv", "OtpErlang.jar"]) end, - [{jinterface_classpath, filename:nativename(ClassPath)}|Vars]. + [{jinterface_classpath, quote(filename:nativename(ClassPath))}|Vars]. lib_dir(Vars, Lib) -> LibLibDir = case Lib of @@ -276,8 +268,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 +289,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. @@ -326,16 +314,12 @@ get_var(Key, Vars) -> sock_libraries({win32, _}) -> "ws2_32.lib"; sock_libraries({unix, _}) -> - ""; % Included in general libraries if needed. -sock_libraries(vxworks) -> - "". + "". % Included in general libraries if needed. link_library(LibName,{win32, _}) -> LibName ++ ".lib"; link_library(LibName,{unix, _}) -> "lib" ++ LibName ++ ".a"; -link_library(LibName,vxworks) -> - "lib" ++ LibName ++ ".a"; link_library(_LibName,_Other) -> exit({link_library, not_supported}). @@ -362,10 +346,17 @@ ssl(Vars, _OsType) -> {error, bad_name} -> throw({cannot_find_app, ssl}); Dir -> - [{ssl_libdir, filename:nativename(Dir)}| Vars] + [{ssl_libdir, quote(filename:nativename(Dir))}| Vars] end. separators(Vars, {win32,_}) -> [{'DS',"\\"},{'PS',";"}|Vars]; separators(Vars, _) -> [{'DS',"/"},{'PS',":"}|Vars]. + +quote([$ |R]) -> + "\\ "++quote(R); +quote([C|R]) -> + [C|quote(R)]; +quote([]) -> + []. diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl index 9703478f20..ba8952f10f 100644 --- a/lib/test_server/src/ts_install.erl +++ b/lib/test_server/src/ts_install.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 @@ -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); @@ -42,35 +55,42 @@ install(TargetSystem, Options) -> end. os_type({unix,_}=OsType) -> OsType; -os_type({win32,_}=OsType) -> OsType; -os_type(_Other) -> vxworks. +os_type({win32,_}=OsType) -> OsType. -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(_,_) -> + 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 +112,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 +158,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 +197,17 @@ write_terms1(Fd, [Term|Rest]) -> write_terms1(_, []) -> ok. +remove_duplicates(List) -> + lists:reverse( + lists:foldl(fun({Key,Val},Acc) -> + R = make_ref(), + case proplists:get_value(Key,Acc,R) of + R -> [{Key,Val}|Acc]; + _Else -> + Acc + end + end,[],List)). + add_vars(Vars0, Opts0) -> {Opts,LongNames} = case lists:keymember(longnames, 1, Opts0) of @@ -209,12 +276,11 @@ platform(Vars) -> LC = lock_checking(), MT = modified_timing(), AsyncThreads = async_threads(), - HeapType = heap_type_label(), Debug = debug(), CpuBits = word_size(), Common = lists:concat([Hostname,"/",OsType,"/",CpuType,CpuBits,LinuxDist, Schedulers,BindType,KP,IOTHR,LC,MT,AsyncThreads, - HeapType,Debug,ExtraLabel]), + Debug,ExtraLabel]), PlatformId = lists:concat([ErlType, " ", Version, Common]), PlatformLabel = ErlType ++ Common, PlatformFilename = platform_as_filename(PlatformId), @@ -272,12 +338,6 @@ hostname() -> "/localhost" end. -heap_type_label() -> - case catch erlang:system_info(heap_type) of - hybrid -> "/Hybrid"; - _ -> "" %private - end. - async_threads() -> case catch erlang:system_info(threads) of true -> "/A"++integer_to_list(erlang:system_info(thread_pool_size)); diff --git a/lib/test_server/src/ts_install_cth.erl b/lib/test_server/src/ts_install_cth.erl index a41916fd0a..9b6e10e7e2 100644 --- a/lib/test_server/src/ts_install_cth.erl +++ b/lib/test_server/src/ts_install_cth.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -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..d9a699ca9f 100644 --- a/lib/test_server/src/ts_lib.erl +++ b/lib/test_server/src/ts_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. 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 @@ -24,10 +24,11 @@ %% Avoid warning for local function error/1 clashing with autoimported BIF. -compile({no_auto_import,[error/1]}). -export([error/1, var/2, erlang_type/0, - initial_capital/1, interesting_logs/1, - specs/1, suites/2, last_test/1, - force_write_file/2, force_delete/1, + erlang_type/1, + initial_capital/1, + specs/1, suites/2, subst_file/3, subst/2, print_data/1, + make_non_erlang/2, maybe_atom_to_list/1, progress/4 ]). @@ -73,8 +74,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 @@ -87,25 +90,18 @@ initial_capital([C|Rest]) when $a =< C, C =< $z -> initial_capital(String) -> String. -%% Returns a list of the "interesting logs" in a directory, -%% i.e. those that correspond to spec files. - -interesting_logs(Dir) -> - Logs = filelib:wildcard(filename:join(Dir, [$*|?logdir_ext])), - Interesting = - case specs(Dir) of - [] -> - Logs; - Specs0 -> - Specs = ordsets:from_list(Specs0), - [L || L <- Logs, ordsets:is_element(filename_to_atom(L), Specs)] - end, - sort_tests(Interesting). - specs(Dir) -> Specs = filelib:wildcard(filename:join([filename:dirname(Dir), - "*_test", "*.{dyn,}spec"])), - sort_tests([filename_to_atom(Name) || Name <- Specs]). + "*_test", "*.{dyn,}spec"])), + % Filter away all spec which end with _bench.spec + NoBench = fun(SpecName) -> + case lists:reverse(SpecName) of + "ceps.hcneb_"++_ -> false; + _ -> true + end + end, + + sort_tests([filename_to_atom(Name) || Name <- Specs, NoBench(Name)]). suites(Dir, Spec) -> Glob=filename:join([filename:dirname(Dir), Spec++"_test", @@ -153,42 +149,6 @@ suite_order(mnesia) -> 44; suite_order(system) -> 999; %% IMPORTANT: system SHOULD always be last! suite_order(_) -> 200. -last_test(Dir) -> - last_test(filelib:wildcard(filename:join(Dir, "run.[1-2]*")), false). - -last_test([Run|Rest], false) -> - last_test(Rest, Run); -last_test([Run|Rest], Latest) when Run > Latest -> - last_test(Rest, Run); -last_test([_|Rest], Latest) -> - last_test(Rest, Latest); -last_test([], Latest) -> - Latest. - -%% Do the utmost to ensure that the file is written, by deleting or -%% renaming an old file with the same name. - -force_write_file(Name, Contents) -> - force_delete(Name), - file:write_file(Name, Contents). - -force_delete(Name) -> - case file:delete(Name) of - {error, eacces} -> - force_rename(Name, Name ++ ".old.", 0); - Other -> - Other - end. - -force_rename(From, To, Number) -> - Dest = [To|integer_to_list(Number)], - case file:read_file_info(Dest) of - {ok, _} -> - force_rename(From, To, Number+1); - {error, _} -> - file:rename(From, Dest) - end. - %% Substitute all occurrences of @var@ in the In file, using %% the list of variables in Vars, producing the output file Out. %% Returns: ok | {error, Reason} @@ -333,3 +293,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..f3266f5836 100644 --- a/lib/test_server/src/ts_make.erl +++ b/lib/test_server/src/ts_make.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. 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 @@ -25,12 +25,12 @@ %% Functions to be called from make test cases. make(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), - Makefile = ?config(makefile, Config), - Make = ?config(make_command, Config), + DataDir = proplists:get_value(data_dir, Config), + Makefile = proplists:get_value(makefile, Config), + Make = proplists:get_value(make_command, Config), case make(Make, DataDir, Makefile) of ok -> ok; - {error,Reason} -> ?t:fail({make_failed,Reason}) + {error,Reason} -> exit({make_failed,Reason}) end. unmake(Config) when is_list(Config) -> @@ -85,7 +85,7 @@ run_make_script({win32, _}, Make, Dir, Makefile) -> {"run_make.bat", ".\\run_make", ["@echo off\r\n", - "cd ", filename:nativename(Dir), "\r\n", + "cd \"", filename:nativename(Dir), "\"\r\n", Make, " -f ", Makefile, " \r\n", "if errorlevel 1 echo *error*\r\n", "if not errorlevel 1 echo *ok*\r\n"]}; @@ -93,7 +93,7 @@ run_make_script({unix, _}, Make, Dir, Makefile) -> {"run_make", "/bin/sh ./run_make", ["#!/bin/sh\n", - "cd ", Dir, "\n", + "cd \"", Dir, "\"\n", Make, " -f ", Makefile, " 2>&1\n", "case $? in\n", " 0) echo '*ok*';;\n", diff --git a/lib/test_server/src/ts_reports.erl b/lib/test_server/src/ts_reports.erl deleted file mode 100644 index f981a77ae4..0000000000 --- a/lib/test_server/src/ts_reports.erl +++ /dev/null @@ -1,545 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%%% Purpose : Produces reports in HTML from the outcome of test suite runs. - --module(ts_reports). - --export([make_index/0, make_master_index/2, make_progress_index/2]). --export([count_cases/1, year/0, current_time/0]). - --include_lib("kernel/include/file.hrl"). --include("ts.hrl"). - --compile({no_auto_import,[error/1]}). - --import(filename, [basename/1, rootname/1]). --import(ts_lib, [error/1]). - - -%% Make master index page which points out index pages for all platforms. - -make_master_index(Dir, Vars) -> - IndexName = filename:join(Dir, "index.html"), - {ok, Index0} = make_master_index1(directories(Dir), master_header(Vars)), - Index = [Index0|master_footer()], - io:put_chars("Updating " ++ IndexName ++ "... "), - ok = ts_lib:force_write_file(IndexName, Index), - io:put_chars("done\n"). - -make_master_index1([Dir|Rest], Result) -> - NewResult = - case catch read_variables(Dir) of - {'EXIT',{{bad_installation,Reason},_}} -> - io:put_chars("Failed to read " ++ filename:join(Dir,?variables)++ - ": " ++ Reason ++ " - Ignoring this directory\n"), - Result; - Vars -> - Platform = ts_lib:var(platform_label, Vars), - case make_index(Dir, Vars, false) of - {ok, Summary} -> - make_master_index(Platform, Dir, Summary, Result); - {error, _} -> - Result - end - end, - make_master_index1(Rest, NewResult); -make_master_index1([], Result) -> - {ok, Result}. - -make_progress_index(Dir, Vars) -> - IndexName = filename:join(Dir, "index.html"), - io:put_chars("Updating " ++ IndexName ++ "... "), - Index0=progress_header(Vars), - ts_lib:force_delete(IndexName), - Dirs=find_progress_runs(Dir), - Index1=[Index0|make_progress_links(Dirs, [])], - IndexF=[Index1|progress_footer()], - ok = ts_lib:force_write_file(IndexName, IndexF), - io:put_chars("done\n"). - -find_progress_runs(Dir) -> - case file:list_dir(Dir) of - {ok, Dirs0} -> - Dirs1= [filename:join(Dir,X) || X <- Dirs0, - filelib:is_dir(filename:join(Dir,X))], - lists:sort(Dirs1); - _ -> - [] - end. - -name_from_vars(Dir, Platform) -> - VarFile=filename:join([Dir, Platform, "variables"]), - case file:consult(VarFile) of - {ok, Vars} -> - ts_lib:var(platform_id, Vars); - _Other -> - Platform - end. - -make_progress_links([], Acc) -> - Acc; -make_progress_links([RDir|Rest], Acc) -> - Dir=filename:basename(RDir), - Platforms=[filename:basename(X) || - X <- find_progress_runs(RDir)], - PlatformLinks=["<A HREF=\""++filename:join([Dir,X,"index.html"]) - ++"\">"++name_from_vars(RDir, X)++"</A><BR>" || - X <- Platforms], - LinkName=Dir++"/index.html", - Link = - [ - "<TR valign=top>\n", - "<TD><A HREF=\"", LinkName, "\">", Dir, "</A></TD>", "\n", - "<TD>", PlatformLinks, "</TD>", "\n" - ], - make_progress_links(Rest, [Link|Acc]). - -read_variables(Dir) -> - case file:consult(filename:join(Dir, ?variables)) of - {ok, Vars} -> Vars; - {error, Reason} -> - erlang:error({bad_installation,file:format_error(Reason)}, [Dir]) - end. - -make_master_index(Platform, Dirname, {Succ, Fail, UserSkip,AutoSkip}, Result) -> - Link = filename:join(filename:basename(Dirname), "index.html"), - FailStr = - if Fail > 0 -> - ["<FONT color=\"red\">", - integer_to_list(Fail),"</FONT>"]; - true -> - integer_to_list(Fail) - end, - AutoSkipStr = - if AutoSkip > 0 -> - ["<FONT color=\"brown\">", - integer_to_list(AutoSkip),"</FONT>"]; - true -> integer_to_list(AutoSkip) - end, - [Result, - "<TR valign=top>\n", - "<TD><A HREF=\"", Link, "\">", Platform, "</A></TD>", "\n", - make_row(integer_to_list(Succ), false), - make_row(FailStr, false), - make_row(integer_to_list(UserSkip), false), - make_row(AutoSkipStr, false), - "</TR>\n"]. - -%% Make index page which points out individual test suites for a single platform. - -make_index() -> - {ok, Pwd} = file:get_cwd(), - Vars = read_variables(Pwd), - make_index(Pwd, Vars, true). - -make_index(Dir, Vars, IncludeLast) -> - IndexName = filename:absname("index.html", Dir), - io:put_chars("Updating " ++ IndexName ++ "... "), - case catch make_index1(Dir, IndexName, Vars, IncludeLast) of - {'EXIT', Reason} -> - io:put_chars("CRASHED!\n"), - io:format("~p~n", [Reason]), - {error, Reason}; - {error, Reason} -> - io:put_chars("FAILED\n"), - io:format("~p~n", [Reason]), - {error, Reason}; - {ok, Summary} -> - io:put_chars("done\n"), - {ok, Summary}; - Err -> - io:format("Unknown internal error. Please report.\n(Err: ~p, ID: 1)", - [Err]), - {error, Err} - end. - -make_index1(Dir, IndexName, Vars, IncludeLast) -> - Logs0 = ts_lib:interesting_logs(Dir), - Logs = - case IncludeLast of - true -> add_last_name(Logs0); - false -> Logs0 - end, - {ok, {Index0, Summary}} = make_index(Logs, header(Vars), 0, 0, 0, 0, 0), - Index = [Index0|footer()], - case ts_lib:force_write_file(IndexName, Index) of - ok -> - {ok, Summary}; - {error, Reason} -> - error({index_write_error, Reason}) - end. - -make_index([Name|Rest], Result, TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt) -> - case ts_lib:last_test(Name) of - false -> - %% Silently skip. - make_index(Rest, Result, TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt); - Last -> - case count_cases(Last) of - {Succ, Fail, USkip, ASkip} -> - Cov = - case file:read_file(filename:join(Last,?cover_total)) of - {ok,Bin} -> - TotCoverage = binary_to_term(Bin), - io_lib:format("~w %",[TotCoverage]); - _error -> - "" - end, - Link = filename:join(basename(Name), basename(Last)), - JustTheName = rootname(basename(Name)), - NotBuilt = not_built(JustTheName), - NewResult = [Result, make_index1(JustTheName, - Link, Succ, Fail, USkip, ASkip, - NotBuilt, Cov, false)], - make_index(Rest, NewResult, TotSucc+Succ, TotFail+Fail, - UserSkip+USkip, AutoSkip+ASkip, TotNotBuilt+NotBuilt); - error -> - make_index(Rest, Result, TotSucc, TotFail, UserSkip, AutoSkip, - TotNotBuilt) - end - end; -make_index([], Result, TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt) -> - {ok, {[Result|make_index1("Total", no_link, - TotSucc, TotFail, UserSkip, AutoSkip, - TotNotBuilt, "", true)], - {TotSucc, TotFail, UserSkip, AutoSkip}}}. - -make_index1(SuiteName, Link, Success, Fail, UserSkip, AutoSkip, NotBuilt, Coverage, Bold) -> - Name = test_suite_name(SuiteName), - FailStr = - if Fail > 0 -> - ["<FONT color=\"red\">", - integer_to_list(Fail),"</FONT>"]; - true -> - integer_to_list(Fail) - end, - AutoSkipStr = - if AutoSkip > 0 -> - ["<FONT color=\"brown\">", - integer_to_list(AutoSkip),"</FONT>"]; - true -> integer_to_list(AutoSkip) - end, - ["<TR valign=top>\n", - "<TD>", - case Link of - no_link -> - ["<B>", Name|"</B>"]; - _Other -> - CrashDumpName = SuiteName ++ "_erl_crash.dump", - CrashDumpLink = - case filelib:is_file(CrashDumpName) of - true -> - [" <A HREF=\"", CrashDumpName, - "\">(CrashDump)</A>"]; - false -> - "" - end, - LogFile = filename:join(Link, ?suitelog_name ++ ".html"), - ["<A HREF=\"", LogFile, "\">", Name, "</A>\n", CrashDumpLink, - "</TD>\n"] - end, - make_row(integer_to_list(Success), Bold), - make_row(FailStr, Bold), - make_row(integer_to_list(UserSkip), Bold), - make_row(AutoSkipStr, Bold), - make_row(integer_to_list(NotBuilt), Bold), - make_row(Coverage, Bold), - "</TR>\n"]. - -make_row(Row, true) -> - ["<TD ALIGN=right><B>", Row|"</B></TD>"]; -make_row(Row, false) -> - ["<TD ALIGN=right>", Row|"</TD>"]. - -not_built(BaseName) -> - Dir = filename:join("..", BaseName++"_test"), - Erl = length(filelib:wildcard(filename:join(Dir,"*_SUITE.erl"))), - Beam = length(filelib:wildcard(filename:join(Dir,"*_SUITE.beam"))), - Erl-Beam. - - -%% Add the log file directory for the very last test run (according to -%% last_name). - -add_last_name(Logs) -> - case file:read_file("last_name") of - {ok, Bin} -> - Name = filename:dirname(lib:nonl(binary_to_list(Bin))), - case lists:member(Name, Logs) of - true -> Logs; - false -> [Name|Logs] - end; - _ -> - Logs - end. - -term_to_text(Term) -> - lists:flatten(io_lib:format("~p.\n", [Term])). - -test_suite_name(Name) -> - ts_lib:initial_capital(Name) ++ " suite". - -directories(Dir) -> - {ok, Files} = file:list_dir(Dir), - [filename:join(Dir, X) || X <- Files, - filelib:is_dir(filename:join(Dir, X))]. - - -%%% Headers and footers. - -header(Vars) -> - Platform = ts_lib:var(platform_id, Vars), - ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" - "<!-- autogenerated by '"++atom_to_list(?MODULE)++"'. -->\n" - "<HTML>\n", - "<HEAD>\n", - "<TITLE>Test Results for ", Platform, "</TITLE>\n", - "</HEAD>\n", - - body_tag(), - - "<!-- ---- DOCUMENT TITLE ---- -->\n", - - "<CENTER>\n", - "<H1>Test Results for ", Platform, "</H1>\n", - "</CENTER>\n", - - "<!-- ---- CONTENT ---- -->\n", - "<CENTER>\n", - - "<TABLE border=3 cellpadding=5>\n", - "<th><B>Family</B></th>\n", - "<th>Successful</th>\n", - "<th>Failed</th>\n", - "<th>User Skipped</th>\n" - "<th>Auto Skipped</th>\n" - "<th>Missing Suites</th>\n" - "<th>Coverage</th>\n" - "\n"]. - -footer() -> - ["</TABLE>\n" - "</CENTER>\n" - "<P><CENTER>\n" - "<HR>\n" - "<P><FONT SIZE=-1>\n" - "Copyright © ", year(), - " <A HREF=\"http://erlang.ericsson.se\">Open Telecom Platform</A><BR>\n" - "Updated: <!date>", current_time(), "<!/date><BR>\n" - "</FONT>\n" - "</CENTER>\n" - "</body>\n" - "</HTML>\n"]. - -progress_header(Vars) -> - Release = ts_lib:var(erl_release, Vars), - ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" - "<!-- autogenerated by '"++atom_to_list(?MODULE)++"'. -->\n" - "<HTML>\n", - "<HEAD>\n", - "<TITLE>", Release, " Progress Test Results</TITLE>\n", - "</HEAD>\n", - - body_tag(), - - "<!-- ---- DOCUMENT TITLE ---- -->\n", - - "<CENTER>\n", - "<H1>", Release, " Progress Test Results</H1>\n", - "<TABLE border=3 cellpadding=5>\n", - "<th><b>Test Run</b></th><th>Platforms</th>\n"]. - -progress_footer() -> - ["</TABLE>\n", - "</CENTER>\n", - "<P><CENTER>\n", - "<HR>\n", - "<P><FONT SIZE=-1>\n", - "Copyright © ", year(), - " <A HREF=\"http://erlang.ericsson.se\">Open Telecom Platform</A><BR>\n", - "Updated: <!date>", current_time(), "<!/date><BR>\n", - "</FONT>\n", - "</CENTER>\n", - "</body>\n", - "</HTML>\n"]. - -master_header(Vars) -> - Release = ts_lib:var(erl_release, Vars), - Vsn = erlang:system_info(version), - ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" - "<!-- autogenerated by '"++atom_to_list(?MODULE)++"'. -->\n" - "<HTML>\n", - "<HEAD>\n", - "<TITLE>", Release, " Test Results (", Vsn, ")</TITLE>\n", - "</HEAD>\n", - - body_tag(), - - "<!-- ---- DOCUMENT TITLE ---- -->\n", - - "<CENTER>\n", - "<H1>", Release, " Test Results (", Vsn, ")</H1>\n", - "</CENTER>\n", - - "<!-- ---- CONTENT ---- -->\n", - - "<CENTER>\n", - - "<TABLE border=3 cellpadding=5>\n", - "<th><b>Platform</b></th>\n", - "<th>Successful</th>\n", - "<th>Failed</th>\n", - "<th>User Skipped</th>\n" - "<th>Auto Skipped</th>\n" - "\n"]. - -master_footer() -> - ["</TABLE>\n", - "</CENTER>\n", - "<P><CENTER>\n", - "<HR>\n", - "<P><FONT SIZE=-1>\n", - "Copyright © ", year(), - " <A HREF=\"http://erlang.ericsson.se\">Open Telecom Platform</A><BR>\n", - "Updated: <!date>", current_time(), "<!/date><BR>\n", - "</FONT>\n", - "</CENTER>\n", - "</body>\n", - "</HTML>\n"]. - -body_tag() -> - "<body bgcolor=\"#FFFFFF\" text=\"#000000\" link=\"#0000FF\"" - "vlink=\"#800080\" alink=\"#FF0000\">". - -year() -> - {Y, _, _} = date(), - integer_to_list(Y). - -current_time() -> - {{Y, Mon, D}, {H, Min, S}} = calendar:local_time(), - Weekday = weekday(calendar:day_of_the_week(Y, Mon, D)), - lists:flatten(io_lib:format("~s ~s ~p ~2.2.0w:~2.2.0w:~2.2.0w ~w", - [Weekday, month(Mon), D, H, Min, S, Y])). - -weekday(1) -> "Mon"; -weekday(2) -> "Tue"; -weekday(3) -> "Wed"; -weekday(4) -> "Thu"; -weekday(5) -> "Fri"; -weekday(6) -> "Sat"; -weekday(7) -> "Sun". - -month(1) -> "Jan"; -month(2) -> "Feb"; -month(3) -> "Mar"; -month(4) -> "Apr"; -month(5) -> "May"; -month(6) -> "Jun"; -month(7) -> "Jul"; -month(8) -> "Aug"; -month(9) -> "Sep"; -month(10) -> "Oct"; -month(11) -> "Nov"; -month(12) -> "Dec". - -%% Count test cases in the given directory (a directory of the type -%% run.1997-08-04_09.58.52). - -count_cases(Dir) -> - SumFile = filename:join(Dir, ?run_summary), - case read_summary(SumFile, [summary]) of - {ok, [{Succ,Fail,Skip}]} -> - {Succ,Fail,Skip,0}; - {ok, [Summary]} -> - Summary; - {error, _} -> - LogFile = filename:join(Dir, ?suitelog_name), - case file:read_file(LogFile) of - {ok, Bin} -> - Summary = count_cases1(binary_to_list(Bin), {0, 0, 0, 0}), - write_summary(SumFile, Summary), - Summary; - {error, _Reason} -> - io:format("\nFailed to read ~p (skipped)\n", [LogFile]), - error - end - end. - -write_summary(Name, Summary) -> - File = [term_to_text({summary, Summary})], - ts_lib:force_write_file(Name, File). - -% XXX: This function doesn't do what the writer expect. It can't handle -% the case if there are several different keys and I had to add a special -% case for the empty file. The caller also expect just one tuple as -% a result so this function is written way to general for no reason. -% But it works sort of. /kgb - -read_summary(Name, Keys) -> - case file:consult(Name) of - {ok, []} -> - {error, "Empty summary file"}; - {ok, Terms} -> - {ok, lists:map(fun(Key) -> {value, {_, Value}} = - lists:keysearch(Key, 1, Terms), - Value end, - Keys)}; - {error, Reason} -> - {error, Reason} - end. - -count_cases1("=failed" ++ Rest, {Success, _Fail, UserSkip,AutoSkip}) -> - {NextLine, Count} = get_number(Rest), - count_cases1(NextLine, {Success, Count, UserSkip,AutoSkip}); -count_cases1("=successful" ++ Rest, {_Success, Fail, UserSkip,AutoSkip}) -> - {NextLine, Count} = get_number(Rest), - count_cases1(NextLine, {Count, Fail, UserSkip,AutoSkip}); -count_cases1("=skipped" ++ Rest, {Success, Fail, _UserSkip,AutoSkip}) -> - {NextLine, Count} = get_number(Rest), - count_cases1(NextLine, {Success, Fail, Count,AutoSkip}); -count_cases1("=user_skipped" ++ Rest, {Success, Fail, _UserSkip,AutoSkip}) -> - {NextLine, Count} = get_number(Rest), - count_cases1(NextLine, {Success, Fail, Count,AutoSkip}); -count_cases1("=auto_skipped" ++ Rest, {Success, Fail, UserSkip,_AutoSkip}) -> - {NextLine, Count} = get_number(Rest), - count_cases1(NextLine, {Success, Fail, UserSkip,Count}); -count_cases1([], Counters) -> - Counters; -count_cases1(Other, Counters) -> - count_cases1(skip_to_nl(Other), Counters). - -get_number([$\s|Rest]) -> - get_number(Rest); -get_number([Digit|Rest]) when $0 =< Digit, Digit =< $9 -> - get_number(Rest, Digit-$0). - -get_number([Digit|Rest], Acc) when $0 =< Digit, Digit =< $9 -> - get_number(Rest, Acc*10+Digit-$0); -get_number([$\n|Rest], Acc) -> - {Rest, Acc}; -get_number([_|Rest], Acc) -> - get_number(Rest, Acc). - -skip_to_nl([$\n|Rest]) -> - Rest; -skip_to_nl([_|Rest]) -> - skip_to_nl(Rest); -skip_to_nl([]) -> - []. diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl index 885a3c9b96..f4d5b3e3b1 100644 --- a/lib/test_server/src/ts_run.erl +++ b/lib/test_server/src/ts_run.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 @@ -21,7 +21,7 @@ -module(ts_run). --export([run/4]). +-export([run/4,ct_run_test/2]). -define(DEFAULT_MAKE_TIMETRAP_MINUTES, 60). -define(DEFAULT_UNMAKE_TIMETRAP_MINUTES, 15). @@ -87,6 +87,24 @@ execute([Hook|Rest], Vars0, Spec0, St0) -> execute([], Vars, Spec, St) -> {ok, Vars, Spec, St}. +%% Wrapper to run tests using ct:run_test/1 and handle any errors. + +ct_run_test(Dir, CommonTestArgs) -> + try + ok = file:set_cwd(Dir), + case ct:run_test(CommonTestArgs) of + {_,_,_} -> + ok; + {error,Error} -> + io:format("ERROR: ~P\n", [Error,20]); + Other -> + io:format("~P\n", [Other,20]) + end + catch + _:Crash -> + io:format("CRASH: ~P\n", [Crash,20]) + end. + %% %% Deletes File from Files when File is on the form .../<SUITE>_data/<file> %% when all of <SUITE> has been skipped in Spec, i.e. there @@ -157,7 +175,6 @@ get_config_files() -> [TSConfig | case os:type() of {unix,_} -> ["ts.unix.config"]; {win32,_} -> ["ts.win32.config"]; - vxworks -> ["ts.vxworks.config"]; _ -> [] end]. @@ -229,10 +246,9 @@ make_command(Vars, Spec, State) -> %% uncomment the line below to disable exception formatting %% " -test_server_format_exception false", " -boot start_sasl -sasl errlog_type error", - " -pz ",Cwd, + " -pz \"",Cwd,"\"", " -ct_test_vars ",TestVars, - " -eval \"file:set_cwd(\\\"",TestDir,"\\\")\" " - " -eval \"ct:run_test(", + " -eval \"ts_run:ct_run_test(\\\"",TestDir,"\\\", ", backslashify(lists:flatten(State#state.test_server_args)),")\"" " ", ExtraArgs], @@ -329,14 +345,13 @@ start_xterm(Command) -> path_separator() -> case os:type() of {win32, _} -> ";"; - {unix, _} -> ":"; - vxworks -> ":" + {unix, _} -> ":" end. -make_common_test_args(Args0, Options, _Vars) -> +make_common_test_args(Args0, Options0, _Vars) -> Trace = - case lists:keysearch(trace,1,Options) of + case lists:keysearch(trace,1,Options0) of {value,{trace,TI}} when is_tuple(TI); is_tuple(hd(TI)) -> ok = file:write_file(?tracefile,io_lib:format("~p.~n",[TI])), [{ct_trace,?tracefile}]; @@ -348,7 +363,7 @@ make_common_test_args(Args0, Options, _Vars) -> [] end, Cover = - case lists:keysearch(cover,1,Options) of + case lists:keysearch(cover,1,Options0) of {value,{cover, App, none, _Analyse}} -> io:format("No cover file found for ~p~n",[App]), []; @@ -358,7 +373,7 @@ make_common_test_args(Args0, Options, _Vars) -> [] end, - Logdir = case lists:keysearch(logdir, 1, Options) of + Logdir = case lists:keysearch(logdir, 1, Options0) of {value,{logdir, _}} -> []; false -> @@ -373,15 +388,16 @@ make_common_test_args(Args0, Options, _Vars) -> {scale_timetraps, true}] end, - ConfigPath = case {os:getenv("TEST_CONFIG_PATH"), - lists:keysearch(config, 1, Options)} of - {false,{value, {config, Path}}} -> - Path; - {false,false} -> - "../test_server"; - {Path,_} -> - Path - end, + {ConfigPath, + Options} = case {os:getenv("TEST_CONFIG_PATH"), + lists:keysearch(config, 1, Options0)} of + {_,{value, {config, Path}}} -> + {Path,lists:keydelete(config, 1, Options0)}; + {false,false} -> + {"../test_server",Options0}; + {Path,_} -> + {Path,Options0} + end, ConfigFiles = [{config,[filename:join(ConfigPath,File) || File <- get_config_files()]}], io_lib:format("~100000p",[Args0++Trace++Cover++Logdir++ diff --git a/lib/test_server/src/ts_selftest.erl b/lib/test_server/src/ts_selftest.erl deleted file mode 100644 index 655aa4bab3..0000000000 --- a/lib/test_server/src/ts_selftest.erl +++ /dev/null @@ -1,120 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% --module(ts_selftest). --export([selftest/0]). - -selftest() -> - case node() of - nonode@nohost -> - io:format("Sorry, you have to start this node distributed.~n"), - exit({error, node_not_distributed}); - _ -> - ok - end, - case catch ts:tests(test_server) of - {'EXIT', _} -> - io:format("Test Server self test not availiable."); - Other -> - selftest1() - end. - -selftest1() -> - % Batch starts - io:format("Selftest #1: Whole spec, batch mode:~n"), - io:format("------------------------------------~n"), - ts:run(test_server, [batch]), - ok=check_result(1, "test_server.logs", 2), - - io:format("Selftest #2: One module, batch mode:~n"), - io:format("------------------------------------~n"), - ts:run(test_server, test_server_SUITE, [batch]), - ok=check_result(2, "test_server_SUITE.logs", 2), - - io:format("Selftest #3: One testcase, batch mode:~n"), - io:format("--------------------------------------~n"), - ts:run(test_server, test_server_SUITE, msgs, [batch]), - ok=check_result(3, "test_server_SUITE.logs", 0), - - % Interactive starts - io:format("Selftest #4: Whole spec, interactive mode:~n"), - io:format("------------------------------------------~n"), - ts:run(test_server), - kill_test_server(), - ok=check_result(4, "test_server.logs", 2), - - io:format("Selftest #5: One module, interactive mode:~n"), - io:format("------------------------------------------~n"), - ts:run(test_server, test_server_SUITE), - kill_test_server(), - ok=check_result(5, "test_server_SUITE.logs", 2), - - io:format("Selftest #6: One testcase, interactive mode:~n"), - io:format("--------------------------------------------~n"), - ts:run(test_server, test_server_SUITE, msgs), - kill_test_server(), - ok=check_result(6, "test_server_SUITE.logs", 0), - - ok. - -check_result(Test, TDir, ExpSkip) -> - Dir=ts_lib:last_test(TDir), - {Total, Failed, Skipped}=ts_reports:count_cases(Dir), - io:format("Selftest #~p:",[Test]), - case {Total, Failed, Skipped} of - {_, 0, ExpSkip} -> % 2 test cases should be skipped. - io:format("All ok.~n~n"), - ok; - {_, _, _} -> - io:format("Not completely successful.~n~n"), - error - end. - - -%% Wait for test server to get started. -kill_test_server() -> - Node=list_to_atom("test_server@"++atom_to_list(hostname())), - net_adm:ping(Node), - case whereis(test_server_ctrl) of - undefined -> - kill_test_server(); - Pid -> - kill_test_server(0, Pid) - end. - -%% Wait for test server to finish. -kill_test_server(30, Pid) -> - exit(self(), test_server_is_dead); -kill_test_server(Num, Pid) -> - case whereis(test_server_ctrl) of - undefined -> - slave:stop(node(Pid)); - Pid -> - receive - after - 1000 -> - kill_test_server(Num+1, Pid) - end - end. - - -hostname() -> - list_to_atom(from($@, atom_to_list(node()))). -from(H, [H | T]) -> T; -from(H, [_ | T]) -> from(H, T); -from(H, []) -> []. diff --git a/lib/test_server/src/vxworks_client.erl b/lib/test_server/src/vxworks_client.erl deleted file mode 100644 index ca65eca02a..0000000000 --- a/lib/test_server/src/vxworks_client.erl +++ /dev/null @@ -1,243 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% --module(vxworks_client). - --export([open/1, close/1, send_data/2, send_data/3, send_data_wait_for_close/2, reboot/1]). --export([init/2]). - --include("ts.hrl"). - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% This is a client talking to a test server daemon on a VxWorks card. -%%% -%%% User interface: -%%% -%%% open/1 -%%% Start a client and establish the connection with the test server daemon -%%% -%%% send_data/2 -%%% Send data/command to the test server daemon, don't wait for any return -%%% -%%% send_data/3 -%%% Send data/command to the test server daemon and wait for the given -%%% return value. -%%% -%%% send_data_wait_for_close/2 -%%% Send data/command to the test server daemon and wait for the daemon to -%%% close the connection. -%%% -%%% close/1 -%%% Close the client. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - -%% -%% User interface -%% - -reboot(Target) -> - {ok, {_,_,_,_,_,[Addr|_]}} = inet:gethostbyname(Target), - Fun = fun({ok, Socket}) -> - gen_tcp:send(Socket, "q\n"), - receive - {tcp_closed, Socket} -> - gen_tcp:close(Socket), - {ok, socket_closed} - after 5000 -> - exit({timeout, tryagain}) - end - end, - io:format("Stopping (rebooting) ~p ",[Target]), - case fun_target(Addr, Fun) of - {ok, socket_closed} -> - ok; - _Else -> - io:format("No contact with ts daemon - exiting ...~n"), - exit({stop, no_ts_daemon_contact}) - end. - - -%% open(Target) -> {ok,Client} | {error, Reason} -open(Target) -> - {ok, {_,_,_,_,_,[Addr|_]}} = inet:gethostbyname(Target), - Fun = fun({ok, Socket}) -> - P = spawn(?MODULE,init,[Target,Socket]), - inet_tcp:controlling_process(Socket,P), - {ok,P} - end, - case fun_target(Addr,Fun) of - {ok, Pid} -> - {ok, Pid}; - {error,Reason} -> - {error, Reason} - end. - -%% send_data(Client,Data) -> ok -send_data(Pid,Data) -> - Pid ! {send_data,Data++"\n"}, - ok. - -%% send_data(Client,Data,ExpectedReturn) -> {ok,ExpectedReturn} | {error,Reason} -send_data(Pid,Data,Return) -> - Pid ! {send_data,Data++"\n",Return,self()}, - receive {Pid,Result} -> Result end. - -%% send_data_wait_for_close(Client,Data) -> ok | {error,Reason} -send_data_wait_for_close(Pid,Data) -> - send_data(Pid,Data,tcp_closed). - -%% close(Client) -> ok -close(Pid) -> - Pid ! close, - ok. - - -%% -%% Internal -%% - -init(Target,Socket) -> - process_flag(trap_exit,true), - loop(Target,Socket). - -loop(Target,Socket) -> - receive - {send_data,Data} -> - %% io:format("vx client sending: ~p~n", [Data]), - gen_tcp:send(Socket, Data), - loop(Socket,Target); - {send_data,Data,tcp_closed,From} -> - %% io:format("vx client sending: ~p~n", [Data]), - gen_tcp:send(Socket, Data), - receive - {tcp_closed, Socket} -> - From ! {self(),ok} - after 5000 -> - From ! {self(),{error,timeout}} - end, - closed(Socket,normal); - {send_data,Data,Return,From} -> - %% io:format("vx client sending: ~p~n", [Data]), - gen_tcp:send(Socket, Data), - case receive_line(Socket,[],Return,200) of - {tcp_closed, Socket} -> - From ! {self(),{error,{socket_closed,Target}}}, - closed(Socket,{socket_closed,Target}); - {tcp,Socket,_Rest} -> - From ! {self(),{ok,Data}}, - got_data(Target,Socket,Data); - error -> - From ! {self(),{error,{catatonic,Target}}} - end; - close -> - closed(Socket,normal); - {tcp_closed, Socket} -> - closed(Socket,{socket_closed,Target}); - {tcp,Socket,Data} -> - got_data(Target,Socket,Data) - end. - - - -closed(Socket,Reason) -> - gen_tcp:close(Socket), - exit(Reason). - -got_data(Target,Socket,Data) -> - if is_atom(Target) -> - io:format("~w: ~s",[Target,uncr(Data)]); - true -> - io:format("~s: ~s",[Target,uncr(Data)]) - end, - loop(Target,Socket). - -uncr([]) -> - []; -uncr([$\r | T]) -> - uncr(T); -uncr([H | T]) -> - [H | uncr(T)]. - -strip_line(Line) -> - RPos = string:rchr(Line, $\n), - string:substr(Line,RPos+1). - -maybe_done_receive(Socket,Ack,Match,C) -> - case string:str(Ack,Match) of - 0 -> - receive_line(Socket,strip_line(Ack),Match,C); - _ -> - {tcp,Socket,strip_line(Ack)} - end. - - -receive_line(_Socket,_Ack,_Match,0) -> - error; -receive_line(Socket,Ack,Match,Counter) -> - receive - {tcp_closed, Socket} -> - {tcp_closed, Socket}; - {tcp,Socket,Data} -> - NewAck = Ack ++ Data, - case {string:str(NewAck,"\r") > 0, - string:str(NewAck,"\n") > 0} of - {true,_} -> - maybe_done_receive(Socket,NewAck,Match,Counter-1); - {_,true} -> - maybe_done_receive(Socket,NewAck,Match,Counter-1); - _ -> - receive_line(Socket,NewAck,Match,Counter) - end - after 20000 -> - error - end. - - -%% Misc functions -fun_target(Addr, Fun) -> - io:format("["), - fun_target(Addr, Fun, 60). %Vx-cards need plenty of time. - -fun_target(_Addr, _Fun, 0) -> - io:format(" no contact with ts daemon]~n"), - {error,failed_to_connect}; -fun_target(Addr, Fun, Tries_left) -> - receive after 1 -> ok end, - case do_connect(Addr, Fun) of - {ok, Value} -> - io:format(" ok]~n"), - {ok, Value}; - _Error -> % typical {error, econnrefused} - io:format("."), - receive after 10000 -> ok end, - fun_target(Addr, Fun, Tries_left-1) - end. - -do_connect(Addr, Fun) -> - case gen_tcp:connect(Addr, ?TS_PORT, [{reuseaddr, true}], 60000) of - {ok, Socket} -> - Fun({ok, Socket}); - Error -> - Error - end. - - - |