aboutsummaryrefslogtreecommitdiffstats
path: root/lib/test_server/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/test_server/src')
-rw-r--r--lib/test_server/src/Makefile10
-rw-r--r--lib/test_server/src/test_server.app.src1
-rw-r--r--lib/test_server/src/test_server.erl1257
-rw-r--r--lib/test_server/src/test_server_ctrl.erl1156
-rw-r--r--lib/test_server/src/test_server_gl.erl293
-rw-r--r--lib/test_server/src/test_server_internal.hrl4
-rw-r--r--lib/test_server/src/test_server_io.erl317
-rw-r--r--lib/test_server/src/test_server_node.erl305
-rw-r--r--lib/test_server/src/test_server_sup.erl38
-rw-r--r--lib/test_server/src/ts.erl185
-rw-r--r--lib/test_server/src/ts_autoconf_vxworks.erl191
-rw-r--r--lib/test_server/src/ts_benchmark.erl91
-rw-r--r--lib/test_server/src/ts_erl_config.erl12
-rw-r--r--lib/test_server/src/ts_install.erl6
-rw-r--r--lib/test_server/src/ts_lib.erl68
-rw-r--r--lib/test_server/src/ts_reports.erl545
-rw-r--r--lib/test_server/src/ts_run.erl37
-rw-r--r--lib/test_server/src/ts_selftest.erl120
-rw-r--r--lib/test_server/src/vxworks_client.erl243
19 files changed, 1535 insertions, 3344 deletions
diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile
index 513720dc04..20e7a5942c 100644
--- a/lib/test_server/src/Makefile
+++ b/lib/test_server/src/Makefile
@@ -40,24 +40,24 @@ RELSYSDIR = $(RELEASE_PATH)/lib/test_server-$(VSN)
# ----------------------------------------------------
MODULES= test_server_ctrl \
+ test_server_gl \
+ test_server_io \
test_server_node \
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)/%)
diff --git a/lib/test_server/src/test_server.app.src b/lib/test_server/src/test_server.app.src
index faf7db835e..26330f9695 100644
--- a/lib/test_server/src/test_server.app.src
+++ b/lib/test_server/src/test_server.app.src
@@ -24,6 +24,7 @@
test_server_ctrl,
test_server,
test_server_h,
+ test_server_io,
test_server_node,
test_server_sup
]},
diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl
index 17c5f5b253..1d3394e0ca 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/test_server/src/test_server.erl
@@ -20,15 +20,12 @@
-define(DEFAULT_TIMETRAP_SECS, 60).
-%%% START %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--export([start/1,start/2]).
-
%%% TEST_SERVER_CTRL INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([run_test_case_apply/1,init_target_info/0,init_purify/0]).
--export([cover_compile/1,cover_analyse/2]).
+-export([cover_compile/1,cover_analyse/3]).
%%% TEST_SERVER_SUP INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--export([get_loc/1]).
+-export([get_loc/1,set_tc_state/1]).
%%% TEST SUITE INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([lookup_config/2]).
@@ -60,49 +57,11 @@
-export([]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--record(state,{controller,jobs=[]}).
-
-include("test_server_internal.hrl").
-include_lib("kernel/include/file.hrl").
-define(pl2a(M), test_server_sup:package_atom(M)).
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% **** START *** CODE FOR REMOTE TARGET ONLY ***
-%%
-%% test_server
-%% This process is started only if the test is to be run on a remote target
-%% The process is then started on target
-%% A socket connection is established with the test_server_ctrl process
-%% on host, and information about target is sent to host.
-start([ControllerHost]) when is_atom(ControllerHost) ->
- start(atom_to_list(ControllerHost));
-start(ControllerHost) when is_list(ControllerHost) ->
- start(ControllerHost,?MAIN_PORT).
-start(ControllerHost,ControllerPort) ->
- S = self(),
- Pid = spawn(fun() -> init(ControllerHost,ControllerPort,S) end),
- receive {Pid,started} -> {ok,Pid};
- {Pid,Error} -> Error
- end.
-
-init(Host,Port,Starter) ->
- global:register_name(?MODULE,self()),
- process_flag(trap_exit,true),
- test_server_sup:cleanup_crash_dumps(),
- case gen_tcp:connect(Host,Port, [binary,
- {reuseaddr,true},
- {packet,2}]) of
- {ok,MainSock} ->
- Starter ! {self(),started},
- request(MainSock,{target_info,init_target_info()}),
- loop(#state{controller={Host,MainSock}});
- Error ->
- Starter ! {self(),{error,
- {could_not_contact_controller,Error}}}
- end.
-
init_target_info() ->
[$.|Emu] = code:objfile_extension(),
{_, OTPRel} = init:script_id(),
@@ -118,171 +77,10 @@ init_target_info() ->
username=test_server_sup:get_username(),
cookie=atom_to_list(erlang:get_cookie())}.
-
-loop(#state{controller={_,MainSock}} = State) ->
- receive
- {tcp, MainSock, <<1,Request/binary>>} ->
- State1 = decode_main(binary_to_term(Request),State),
- loop(State1);
- {tcp_closed, MainSock} ->
- gen_tcp:close(MainSock),
- halt();
- {'EXIT',Pid,Reason} ->
- case lists:keysearch(Pid,1,State#state.jobs) of
- {value,{Pid,Name}} ->
- case Reason of
- normal -> ignore;
- _other -> request(MainSock,{job_proc_killed,Name,Reason})
- end,
- NewJobs = lists:keydelete(Pid,1,State#state.jobs),
- loop(State#state{jobs = NewJobs});
- false ->
- loop(State)
- end
- end.
-
-%% Decode request on main socket
-decode_main({job,Port,Name},#state{controller={Host,_},jobs=Jobs}=State) ->
- S = self(),
- NewJob = spawn_link(fun() -> job(Host,Port,S) end),
- receive {NewJob,started} -> State#state{jobs=[{NewJob,Name}|Jobs]};
- {NewJob,_Error} -> State
- end.
-
init_purify() ->
purify_new_leaks().
-%% Temporary job process on target
-%% This process will live while all test cases in the job are executed.
-%% A socket connection is established with the job process on host.
-job(Host,Port,Starter) ->
- process_flag(trap_exit,true),
- init_purify(),
- case gen_tcp:connect(Host,Port, [binary,
- {reuseaddr,true},
- {packet,4},
- {active,false}]) of
- {ok,JobSock} ->
- Starter ! {self(),started},
- job(JobSock);
- Error ->
- Starter ! {self(),{error,
- {could_not_contact_controller,Error}}}
- end.
-
-job(JobSock) ->
- JobDir = get_jobdir(),
- ok = file:make_dir(JobDir),
- ok = file:make_dir(filename:join(JobDir,?priv_dir)),
- put(test_server_job_sock,JobSock),
- put(test_server_job_dir,JobDir),
- {ok,Cwd} = file:get_cwd(),
- job_loop(JobSock),
- ok = file:set_cwd(Cwd),
- send_privdir(JobDir,JobSock), % also recursively removes jobdir
- ok.
-
-
-get_jobdir() ->
- Now = now(),
- {{Y,M,D},{H,Mi,S}} = calendar:now_to_local_time(Now),
- Basename = io_lib:format("~w-~2.2.0w-~2.2.0w_~2.2.0w.~2.2.0w.~2.2.0w_~w",
- [Y,M,D,H,Mi,S,element(3,Now)]),
- %% if target has a file master, don't use prim_file to look up cwd
- case lists:keymember(master,1,init:get_arguments()) of
- true ->
- {ok,Cwd} = file:get_cwd(),
- Cwd ++ "/" ++ Basename;
- false ->
- filename:absname(Basename)
- end.
-
-send_privdir(JobDir,JobSock) ->
- LocalPrivDir = filename:join(JobDir,?priv_dir),
- case file:list_dir(LocalPrivDir) of
- {ok,List} when List/=[] ->
- Tarfile0 = ?priv_dir ++ ".tar.gz",
- Tarfile = filename:join(JobDir,Tarfile0),
- {ok,Tar} = erl_tar:open(Tarfile,[write,compressed,cooked]),
- ok = erl_tar:add(Tar,LocalPrivDir,?priv_dir,[]),
- ok = erl_tar:close(Tar),
- {ok,TarBin} = file:read_file(Tarfile),
- file:delete(Tarfile),
- ok = del_dir(JobDir),
- request(JobSock,{{privdir,Tarfile0},TarBin});
- _ ->
- ok = del_dir(JobDir),
- request(JobSock,{privdir,empty_priv_dir})
- end.
-
-del_dir(Dir) ->
- case file:read_file_info(Dir) of
- {ok,#file_info{type=directory}} ->
- {ok,Cont} = file:list_dir(Dir),
- lists:foreach(fun(F) -> del_dir(filename:join(Dir,F)) end, Cont),
- ok = file:del_dir(Dir);
- {ok,#file_info{}} ->
- ok = file:delete(Dir);
- _r ->
- %% This might be a symlink - let's try to delete it!
- catch file:delete(Dir),
- ok
- end.
-
-%%
-%% Receive and decode request on job socket
-%%
-job_loop(JobSock) ->
- Request = recv(JobSock),
- case decode_job(Request) of
- ok -> job_loop(JobSock);
- {stop,R} -> R
- end.
-
-decode_job({{beam,Mod,Which},Beam}) ->
- % FIXME, shared directory structure on host and target required,
- % "Library beams" are not loaded from HOST... /Patrik
- code:add_patha(filename:dirname(Which)),
- % End of Patriks uglyness...
- {module,Mod} = code:load_binary(Mod,Which,Beam),
- ok;
-decode_job({{datadir,Tarfile0},Archive}) ->
- JobDir = get(test_server_job_dir),
- Tarfile = filename:join(JobDir,Tarfile0),
- ok = file:write_file(Tarfile,Archive),
- % Cooked is temporary removed/broken
- % ok = erl_tar:extract(Tarfile,[compressed,{cwd,JobDir},cooked]),
- ok = erl_tar:extract(Tarfile,[compressed,{cwd,JobDir}]),
- ok = file:delete(Tarfile),
- ok;
-decode_job({test_case,Case}) ->
- Result = run_test_case_apply(Case),
- JobSock = get(test_server_job_sock),
- request(JobSock,{test_case_result,Result}),
- case test_server_sup:tar_crash_dumps() of
- {error,no_crash_dumps} -> request(JobSock,{crash_dumps,no_crash_dumps});
- {ok,TarFile} ->
- {ok,TarBin} = file:read_file(TarFile),
- file:delete(TarFile),
- request(JobSock,{{crash_dumps,filename:basename(TarFile)},TarBin})
- end,
- ok;
-decode_job({sync_apply,{M,F,A}}) ->
- R = apply(M,F,A),
- request(get(test_server_job_sock),{sync_result,R}),
- ok;
-decode_job(job_done) ->
- {stop,stopped}.
-
-%%
-%% **** STOP *** CODE FOR REMOTE TARGET ONLY ***
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
-
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% cover_compile({App,Include,Exclude,Cross}) ->
%% {ok,AnalyseModules} | {error,Reason}
@@ -377,9 +175,7 @@ module_names(Beams) ->
do_cover_compile(Modules) ->
do_cover_compile1(lists:usort(Modules)). % remove duplicates
-do_cover_compile1([Dont|Rest]) when Dont=:=cover;
- Dont=:=test_server;
- Dont=:=test_server_ctrl ->
+do_cover_compile1([Dont|Rest]) when Dont=:=cover ->
do_cover_compile1(Rest);
do_cover_compile1([M|Rest]) ->
case {code:is_sticky(M),code:is_loaded(M)} of
@@ -416,7 +212,7 @@ do_cover_compile1([]) ->
ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% cover_analyse(Analyse,Modules) -> [{M,{Cov,NotCov,Details}}]
+%% cover_analyse(Analyse,Modules,Stop) -> [{M,{Cov,NotCov,Details}}]
%%
%% Analyse = {details,Dir} | details | {overview,void()} | overview
%% Modules = [atom()], the modules to analyse
@@ -432,8 +228,19 @@ do_cover_compile1([]) ->
%%
%% Also, if a Dir exists, cover data will be exported to a file called
%% all.coverdata in that directory.
-cover_analyse(Analyse,Modules) ->
- io:fwrite("Cover analysing...\n",[]),
+%%
+%% Finally, if Stop==true, then cover will be stopped after the
+%% analysis is completed. Stopping cover causes the original (non
+%% cover compiled) modules to be loaded back in. If a process at this
+%% point is still running old code of any of the cover compiled
+%% modules, meaning that is has not done any fully qualified function
+%% call after the cover compilation, the process will now be
+%% killed. To avoid this scenario, it is possible to set Stop=false,
+%% which means that the modules will stay cover compiled. Note that
+%% this is only recommended if the erlang node is being terminated
+%% after the test is completed.
+cover_analyse(Analyse,Modules,Stop) ->
+ print(stdout, "Cover analysing...\n", []),
DetailsFun =
case Analyse of
{details,Dir} ->
@@ -483,9 +290,15 @@ cover_analyse(Analyse,Modules) ->
{M,Err}
end
end, Modules),
- Sticky = unstick_all_sticky(node()),
- cover:stop(),
- stick_all_sticky(node(),Sticky),
+
+ case Stop of
+ true ->
+ Sticky = unstick_all_sticky(node()),
+ cover:stop(),
+ stick_all_sticky(node(),Sticky);
+ false ->
+ ok
+ end,
R.
pmap(Fun,List) ->
@@ -502,7 +315,20 @@ pmap(Fun,List) ->
end
end, Pids).
+
+do_cover_for_node(Node,CoverFunc) ->
+ %% In case a slave node is starting another slave node! I.e. this
+ %% function is executed on a slave node - then the cover function
+ %% must be executed on the master node. This is for instance the
+ %% case in test_server's own tests.
+ MainCoverNode = cover:get_main_node(),
+ Sticky = unstick_all_sticky(MainCoverNode,Node),
+ rpc:call(MainCoverNode,cover,CoverFunc,[Node]),
+ stick_all_sticky(Node,Sticky).
+
unstick_all_sticky(Node) ->
+ unstick_all_sticky(node(),Node).
+unstick_all_sticky(MainCoverNode,Node) ->
lists:filter(
fun(M) ->
case code:is_sticky(M) of
@@ -513,7 +339,7 @@ unstick_all_sticky(Node) ->
false
end
end,
- cover:modules()).
+ rpc:call(MainCoverNode,cover,modules,[])).
stick_all_sticky(Node,Sticky) ->
lists:foreach(
@@ -524,7 +350,7 @@ stick_all_sticky(Node,Sticky) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% run_test_case_apply(Mod,Func,Args,Name,RunInit,TimetrapData,RejectIoReqs) ->
+%% run_test_case_apply(Mod,Func,Args,Name,RunInit,TimetrapData) ->
%% {Time,Value,Loc,Opts,Comment} | {died,Reason,unknown,Comment}
%%
%% Time = float() (seconds)
@@ -538,7 +364,6 @@ stick_all_sticky(Node,Sticky) ->
%% it possible to capture all it's output from io:format/2, etc.
%%
%% The job process then sits down and waits for news from the case process.
-%% This might be io requests (which are redirected to the log files).
%%
%% Returns a tuple with the time spent (in seconds) in the test case,
%% the return value from the test case or an {'EXIT',Reason} if the case
@@ -559,12 +384,9 @@ 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,RejectIoReqs}) ->
+ RunInit,TimetrapData}) ->
purify_format("Test case #~w ~w:~w/1", [CaseNum, Mod, Func]),
case os:getenv("TS_RUN_VALGRIND") of
false ->
@@ -576,40 +398,29 @@ run_test_case_apply({CaseNum,Mod,Func,Args,Name,
test_server_h:testcase({Mod,Func,1}),
ProcBef = erlang:system_info(process_count),
Result = run_test_case_apply(Mod, Func, Args, Name, RunInit,
- TimetrapData, RejectIoReqs),
+ TimetrapData),
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, 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, RejectIoReqs);
- JobDir ->
- %% i'm a remote target
- case Args of
- [Config] when is_list(Config) ->
- {value,{data_dir,HostDataDir}} =
- lists:keysearch(data_dir, 1, Config),
- DataBase = filename:basename(HostDataDir),
- TargetDataDir = filename:join(JobDir, DataBase),
- Config1 = lists:keyreplace(data_dir, 1, Config,
- {data_dir,TargetDataDir}),
- TargetPrivDir = filename:join(JobDir, ?priv_dir),
- Config2 = lists:keyreplace(priv_dir, 1, Config1,
- {priv_dir,TargetPrivDir}),
- do_run_test_case_apply(Mod, Func, [Config2], Name, RunInit,
- TimetrapData, RejectIoReqs);
- _other ->
- do_run_test_case_apply(Mod, Func, Args, Name, RunInit,
- TimetrapData, RejectIoReqs)
- end
- end.
-do_run_test_case_apply(Mod, Func, Args, Name, RunInit,
- TimetrapData, RejectIoReqs) ->
+-type tc_status() :: 'starting' | 'running' | 'init_per_testcase' |
+ 'end_per_testcase' | {'framework',atom(),atom()} |
+ 'tc'.
+-record(st,
+ {
+ ref :: reference(),
+ pid :: pid(),
+ mf :: {atom(),atom()},
+ status :: tc_status() | 'undefined',
+ ret_val :: term(),
+ comment :: list(char()),
+ timeout :: non_neg_integer() | 'infinity',
+ config :: list() | 'undefined',
+ end_conf_pid :: pid() | 'undefined'
+ }).
+
+run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
{ok,Cwd} = file:get_cwd(),
Args2Print = case Args of
[Args1] when is_list(Args1) ->
@@ -624,9 +435,6 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit,
TCCallback = get(test_server_testcase_callback),
LogOpts = get(test_server_logopts),
Ref = make_ref(),
- OldGLeader = group_leader(),
- %% Set ourself to group leader for the spawned process
- group_leader(self(),self()),
Pid =
spawn_link(
fun() ->
@@ -634,10 +442,10 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit,
RunInit, TimetrapData,
LogOpts, TCCallback)
end),
- group_leader(OldGLeader, self()),
put(test_server_detected_fail, []),
- run_test_case_msgloop(Ref, Pid, false, RejectIoReqs, false, "",
- undefined, starting).
+ St = #st{ref=Ref,pid=Pid,mf={Mod,Func},status=starting,ret_val=[],
+ comment="",timeout=infinity,config=hd(Args)},
+ run_test_case_msgloop(St).
%% Ugly bug (pre R5A):
%% If this process (group leader of the test case) terminates before
@@ -648,32 +456,23 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit,
%% 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, 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,
+run_test_case_msgloop(#st{ref=Ref,pid=Pid,end_conf_pid=EndConfPid0}=St0) ->
receive
- {test_case_initialized,Pid} ->
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
- Comment,CurrConf,running);
- Abort = {abort_current_testcase,_,_} when Status == starting ->
+ {set_tc_state=Tag,From,{Status,Config0}} ->
+ Config = case Config0 of
+ unknown -> St0#st.config;
+ _ -> Config0
+ end,
+ St = St0#st{status=Status,config=Config},
+ From ! {self(),Tag,ok},
+ run_test_case_msgloop(St);
+ {abort_current_testcase,_,_}=Abort when St0#st.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);
+ run_test_case_msgloop(St0);
{abort_current_testcase,Reason,From} ->
Line = case is_process_alive(Pid) of
true -> get_loc(Pid);
@@ -683,142 +482,49 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
exit(Pid,{testcase_aborted,Reason,Line}),
erlang:yield(),
From ! {self(),abort_current_testcase,ok},
- NewComment =
- receive
- {'DOWN', Mon, process, Pid, _} ->
- Comment
- after 10000 ->
- %% Pid is probably trapping exits, hit it harder...
- 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])),
- Error1 = lists:flatten([string:strip(S,left) ||
+ St = receive
+ {'DOWN', Mon, process, Pid, _} ->
+ St0
+ after 10000 ->
+ %% Pid is probably trapping exits, hit it harder...
+ 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])),
+ Error1 = lists:flatten([string:strip(S,left) ||
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,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(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(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(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(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(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(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(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(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(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,RejectIoReqs,Terminate,
- Comment,CurrConf,Status);
- {structured_io,ClientPid,Msg} ->
- output(Msg, ClientPid),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
- Comment,CurrConf,Status);
- {capture,NewCapture} ->
- run_test_case_msgloop(Ref,Pid,NewCapture,RejectIoReqs,Terminate,
- Comment,CurrConf,Status);
+ Comment = if length(Error1) > 63 ->
+ string:substr(Error1,1,60) ++ "...";
+ true ->
+ Error1
+ end,
+ St0#st{comment=Comment}
+ end,
+ run_test_case_msgloop(St);
{sync_apply,From,MFA} ->
sync_local_or_remote_apply(false,From,MFA),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
- Comment,CurrConf,Status);
+ run_test_case_msgloop(St0);
{sync_apply_proxy,Proxy,From,MFA} ->
sync_local_or_remote_apply(Proxy,From,MFA),
- 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,RejectIoReqs,Terminate,
- Comment,CurrConf,Status);
- {comment,NewComment} ->
- NewComment1 = test_server_ctrl:to_string(NewComment),
- NewComment2 = test_server_sup:framework_call(format_comment,
- [NewComment1],
- NewComment1),
- Terminate1 =
- case Terminate of
- {true,{Time,Value,Loc,Opts,_OldComment}} ->
- {true,{Time,Value,mod_loc(Loc),Opts,NewComment2}};
- Other ->
- Other
- end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate1,
- NewComment2,CurrConf,Status);
+ run_test_case_msgloop(St0);
+ {comment,NewComment0} ->
+ NewComment1 = test_server_ctrl:to_string(NewComment0),
+ NewComment = test_server_sup:framework_call(format_comment,
+ [NewComment1],
+ NewComment1),
+ run_test_case_msgloop(St0#st{comment=NewComment});
{read_comment,From} ->
- From ! {self(),read_comment,Comment},
- 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,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);
+ From ! {self(),read_comment,St0#st.comment},
+ run_test_case_msgloop(St0);
{make_priv_dir,From} ->
+ Config = case St0#st.config of
+ undefined -> [];
+ Config0 -> Config0
+ end,
Result =
- case proplists:get_value(priv_dir, element(2, CurrConf)) of
+ case proplists:get_value(priv_dir, Config) of
undefined ->
{error,no_priv_dir_in_config};
PrivDir ->
@@ -832,212 +538,63 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
end
end,
From ! {self(),make_priv_dir,Result},
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
- Comment,CurrConf,Status);
+ run_test_case_msgloop(St0);
{'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} ->
- RetVal = {Time/1000000,Value,mod_loc(Loc),Opts,Comment},
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
- {true,RetVal},Comment,undefined,Status);
+ RetVal = {Time/1000000,Value,Loc,Opts},
+ St = setup_termination(RetVal, St0#st{config=undefined}),
+ run_test_case_msgloop(St);
{'EXIT',Pid,Reason} ->
- case Reason of
- {timetrap_timeout,TVal,Loc} ->
- %% convert Loc to form that can be formatted
- case mod_loc(Loc) of
- {FwMod,FwFunc,framework} ->
- %% timout during framework call
- spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
- {framework_error,{timetrap,TVal}},
- 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
- 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),
- {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.
- spawn_fw_call(Mod,Func,CurrConf,Pid,
- {timetrap_timeout,TVal},
- Loc1,self()),
- undefined
- end,
- run_test_case_msgloop(Ref,Pid,
- CaptureStdout,RejectIoReqs,
- Terminate,Comment,
- NewCurrConf,Status)
- end;
- {timetrap_timeout,TVal,Loc,InitOrEnd} ->
- case mod_loc(Loc) of
- {FwMod,FwFunc,framework} ->
- %% timout during framework call
- spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
- {framework_error,{timetrap,TVal}},
- unknown,self());
- Loc1 ->
- {Mod,_Func} = get_mf(Loc1),
- spawn_fw_call(Mod,InitOrEnd,CurrConf,Pid,
- {timetrap_timeout,TVal},
- Loc1,self())
- end,
- 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
- {FwMod,FwFunc,framework} ->
- %% abort during framework call
- spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
- {framework_error,ErrorMsg},
- 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
- 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,
- EndConfPid =
- 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()),
- undefined
- end,
- 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)
- {Mod,Func} = case CurrConf of
- {MF,_} -> MF;
- _ -> {undefined,undefined}
- end,
- spawn_fw_call(Mod,Func,CurrConf,Pid,
- testcase_aborted_or_killed,
- 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()),
- 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)
- {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}} ->
+ St = handle_tc_exit(Reason, St0),
+ run_test_case_msgloop(St);
+ {EndConfPid0,{call_end_conf,Data,_Result}} ->
+ #st{mf={Mod,Func},config=CurrConf} = St0,
case CurrConf of
- {EndConfPid,{Mod,Func},_Conf} ->
+ _ when is_list(CurrConf) ->
{_Mod,_Func,TCPid,TCExitReason,Loc} = Data,
spawn_fw_call(Mod,Func,CurrConf,TCPid,
TCExitReason,Loc,self()),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
- Terminate,Comment,undefined,Status);
+ St = St0#st{config=undefined,end_conf_pid=undefined},
+ run_test_case_msgloop(St);
_ ->
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
- Terminate,Comment,CurrConf,Status)
+ run_test_case_msgloop(St0)
end;
{_FwCallPid,fw_notify_done,{T,Value,Loc,Opts,AddToComment}} ->
%% the framework has been notified, we're finished
- 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);
+ RetVal = {T,Value,Loc,Opts},
+ Comment0 = St0#st.comment,
+ Comment = case AddToComment of
+ undefined ->
+ Comment0;
+ _ ->
+ if Comment0 =:= "" ->
+ AddToComment;
+ true ->
+ Comment0 ++
+ test_server_ctrl:xhtml("<br>",
+ "<br />") ++
+ AddToComment
+ end
+ end,
+ St = setup_termination(RetVal, St0#st{comment=Comment,
+ config=undefined}),
+ run_test_case_msgloop(St);
{'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} ->
%% a framework function failed
CB = os:getenv("TEST_SERVER_FRAMEWORK"),
Loc = case CB of
FW when FW =:= false; FW =:= "undefined" ->
- {test_server,Func};
+ [{test_server,Func}];
_ ->
- {list_to_atom(CB),Func}
+ [{list_to_atom(CB),Func}]
end,
- RetVal = {died,{framework_error,Loc,Error},Loc,"Framework error"},
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
- {true,RetVal},Comment,undefined,Status);
+ RetVal = {died,{framework_error,Loc,Error},Loc},
+ St = setup_termination(RetVal, St0#st{comment="Framework error",
+ config=undefined}),
+ run_test_case_msgloop(St);
{failed,File,Line} ->
put(test_server_detected_fail,
[{File, Line}| get(test_server_detected_fail)]),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
- Terminate,Comment,CurrConf,Status);
+ run_test_case_msgloop(St0);
{user_timetrap,Pid,_TrapTime,StartTime,E={user_timetrap_error,_},_} ->
case update_user_timetraps(Pid, StartTime) of
@@ -1046,8 +603,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
ignore ->
ok
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
- Terminate,Comment,CurrConf,Status);
+ run_test_case_msgloop(St0);
{user_timetrap,Pid,TrapTime,StartTime,ElapsedTime,Scale} ->
%% a user timetrap is triggered, ignore it if new
%% timetrap has been started since
@@ -1062,68 +618,112 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
ignore ->
ok
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
- Terminate,Comment,CurrConf,Status);
+ run_test_case_msgloop(St0);
{timetrap_cancel_one,Handle,_From} ->
timetrap_cancel_one(Handle, false),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
- Terminate,Comment,CurrConf,Status);
+ run_test_case_msgloop(St0);
{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} ->
+ run_test_case_msgloop(St0);
+ {get_timetrap_info,From,TCPid} ->
Info = get_timetrap_info(TCPid, false),
From ! {self(),get_timetrap_info,Info},
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
- Terminate,Comment,CurrConf,Status);
+ run_test_case_msgloop(St0);
_Other when not is_tuple(_Other) ->
%% ignore anything not generated by test server
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
- Terminate,Comment,CurrConf,Status);
+ run_test_case_msgloop(St0);
_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,RejectIoReqs,
- Terminate,Comment,CurrConf,Status)
- after Timeout ->
- ReturnValue
+ run_test_case_msgloop(St0)
+ after St0#st.timeout ->
+ #st{ret_val=RetVal,comment=Comment} = St0,
+ erlang:append_element(RetVal, Comment)
end.
-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,
- 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.
+setup_termination(RetVal, #st{pid=Pid}=St) ->
+ timetrap_cancel_all(Pid, false),
+ St#st{ret_val=RetVal,timeout=20}.
+
+set_tc_state(State) ->
+ set_tc_state(State,unknown).
+set_tc_state(State, Config) ->
+ tc_supervisor_req(set_tc_state, {State,Config}).
+
+handle_tc_exit(killed, St) ->
+ %% probably the result of an exit(TestCase,kill) call, which is the
+ %% only way to abort a testcase process that traps exits
+ %% (see abort_current_testcase).
+ #st{config=Config,mf={Mod,Func},pid=Pid} = St,
+ Msg = testcase_aborted_or_killed,
+ spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()),
+ St;
+handle_tc_exit({testcase_aborted,{user_timetrap_error,_}=Msg,_}, St) ->
+ #st{config=Config,mf={Mod,Func},pid=Pid} = St,
+ spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()),
+ St;
+handle_tc_exit(Reason, #st{status={framework,FwMod,FwFunc},
+ config=Config,pid=Pid}=St) ->
+ R = case Reason of
+ {timetrap_timeout,TVal,_} ->
+ {timetrap,TVal};
+ {testcase_aborted=E,AbortReason,_} ->
+ {E,AbortReason};
+ {fw_error,{FwMod,FwFunc,FwError}} ->
+ FwError;
+ Other ->
+ Other
+ end,
+ Error = {framework_error,R},
+ spawn_fw_call(FwMod, FwFunc, Config, Pid, Error, unknown, self()),
+ St;
+handle_tc_exit(Reason, #st{status=tc,config=Config0,mf={Mod,Func},pid=Pid}=St)
+ when is_list(Config0) ->
+ {R,Loc1,F} = case Reason of
+ {timetrap_timeout=E,TVal,Loc0} ->
+ {{E,TVal},Loc0,E};
+ {testcase_aborted=E,AbortReason,Loc0} ->
+ Msg = {E,AbortReason},
+ {Msg,Loc0,Msg};
+ Other ->
+ {Other,unknown,Other}
+ end,
+ Timeout = end_conf_timeout(Reason, St),
+ Config = [{tc_status,{failed,F}}|Config0],
+ EndConfPid = call_end_conf(Mod, Func, Pid, R, Loc1, Config, Timeout),
+ St#st{end_conf_pid=EndConfPid};
+handle_tc_exit(Reason, #st{config=Config,mf={Mod,Func0},pid=Pid,
+ status=Status}=St) ->
+ {R,Loc1} = case Reason of
+ {timetrap_timeout=E,TVal,Loc0} ->
+ {{E,TVal},Loc0};
+ {testcase_aborted=E,AbortReason,Loc0} ->
+ {{E,AbortReason},Loc0};
+ Other ->
+ {Other,unknown}
+ end,
+ Func = case Status of
+ init_per_testcase=F -> {F,Func0};
+ end_per_testcase=F -> {F,Func0};
+ _ -> Func0
+ end,
+ spawn_fw_call(Mod, Func, Config, Pid, R, Loc1, self()),
+ St.
-output(Msg,Sender) ->
- local_or_remote_apply({test_server_ctrl,output,[Msg,Sender]}).
+end_conf_timeout({timetrap_timeout,Timeout,_}, _) ->
+ Timeout;
+end_conf_timeout(_, #st{config=Config}) when is_list(Config) ->
+ proplists:get_value(default_timeout, Config, ?DEFAULT_TIMETRAP_SECS*1000);
+end_conf_timeout(_, _) ->
+ ?DEFAULT_TIMETRAP_SECS*1000.
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() ->
@@ -1157,17 +757,14 @@ call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) ->
end,
spawn_link(EndConfProc).
-spawn_fw_call(Mod,{init_per_testcase,Func},_,Pid,{timetrap_timeout,TVal}=Why,
+spawn_fw_call(Mod,{init_per_testcase,Func},CurrConf,Pid,{timetrap_timeout,TVal}=Why,
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
- case catch do_end_tc_call(Mod,Func, Loc, {Pid,Skip,[[]]}, Why) of
+ case catch do_end_tc_call(Mod,Func, {Pid,Skip,[CurrConf]}, Why) of
{'EXIT',FwEndTCErr} ->
exit({fw_notify_done,end_tc,FwEndTCErr});
_ ->
@@ -1181,22 +778,10 @@ spawn_fw_call(Mod,{init_per_testcase,Func},_,Pid,{timetrap_timeout,TVal}=Why,
spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid,
{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
- %%! for more info.
- EndConf1 = if EndConf == undefined ->
- [{tc_status,{failed,{Mod,end_per_testcase,Why}}}];
- true ->
- EndConf
- 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
+ case proplists:get_value(tc_status, EndConf) of
undefined ->
E = {failed,{Mod,end_per_testcase,Why}},
{E,E};
@@ -1210,9 +795,9 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid,
"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
+ FailLoc = proplists:get_value(tc_fail_loc, EndConf),
+ case catch do_end_tc_call(Mod,Func,
+ {Pid,Report,[EndConf]}, Why) of
{'EXIT',FwEndTCErr} ->
exit({fw_notify_done,end_tc,FwEndTCErr});
_ ->
@@ -1230,9 +815,6 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid,
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}]),
@@ -1249,17 +831,9 @@ spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) ->
spawn_link(FwCall);
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() ->
- %% 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,[],
+ case catch fw_error_notify(Mod,Func,[],
Error,Loc) of
{'EXIT',FwErrorNotifyErr} ->
exit({fw_notify_done,error_notification,
@@ -1267,8 +841,8 @@ spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) ->
_ ->
ok
end,
- Conf = [{tc_status,{failed,timetrap_timeout}}],
- case catch do_end_tc_call(Mod1,Func1, Loc,
+ Conf = [{tc_status,{failed,timetrap_timeout}}|CurrConf],
+ case catch do_end_tc_call(Mod,Func,
{Pid,Error,[Conf]},Error) of
{'EXIT',FwEndTCErr} ->
exit({fw_notify_done,end_tc,FwEndTCErr});
@@ -1333,83 +907,73 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit,
TimetrapData, LogOpts, TCCallback) ->
put(test_server_multiply_timetraps, TimetrapData),
put(test_server_logopts, LogOpts),
+ Where = [{Mod,Func}],
+ put(test_server_loc, Where),
FWInitResult = test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0],
{ok,Args0}),
- group_leader() ! {test_case_initialized,self()},
+ set_tc_state(running),
{{Time,Value},Loc,Opts} =
case FWInitResult of
{ok,Args} ->
run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback);
Error = {error,_Reason} ->
- Where = {Mod,Func},
- NewResult = do_end_tc_call(Mod,Func, Where, {Error,Args0},
+ NewResult = do_end_tc_call(Mod,Func, {Error,Args0},
{skip,{failed,Error}}),
{{0,NewResult},Where,[]};
{fail,Reason} ->
Conf = [{tc_status,{failed,Reason}} | hd(Args0)],
- Where = {Mod,Func},
fw_error_notify(Mod, Func, Conf, Reason),
- NewResult = do_end_tc_call(Mod,Func, Where, {{error,Reason},[Conf]},
+ NewResult = do_end_tc_call(Mod,Func, {{error,Reason},[Conf]},
{fail,Reason}),
{{0,NewResult},Where,[]};
Skip = {skip,_Reason} ->
- Where = {Mod,Func},
- NewResult = do_end_tc_call(Mod,Func, Where, {Skip,Args0}, Skip),
+ NewResult = do_end_tc_call(Mod,Func, {Skip,Args0}, Skip),
{{0,NewResult},Where,[]};
{auto_skip,Reason} ->
- Where = {Mod,Func},
- NewResult = do_end_tc_call(Mod,Func, Where, {{skip,Reason},Args0},
+ NewResult = do_end_tc_call(Mod,Func, {{skip,Reason},Args0},
{skip,Reason}),
{{0,NewResult},Where,[]}
end,
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}),
- put(test_server_loc, {Mod,{init_per_testcase,Func}}),
+ set_tc_state(init_per_testcase, hd(Args)),
ensure_timetrap(Args),
case init_per_testcase(Mod, Func, Args) of
Skip = {skip,Reason} ->
Line = get_loc(),
- Conf = [{tc_status,{skipped,Reason}}],
- NewRes = do_end_tc_call(Mod,Func, Line, {Skip,[Conf]}, Skip),
+ Conf = [{tc_status,{skipped,Reason}}|hd(Args)],
+ NewRes = do_end_tc_call(Mod,Func, {Skip,[Conf]}, Skip),
{{0,NewRes},Line,[]};
{skip_and_save,Reason,SaveCfg} ->
Line = get_loc(),
- Conf = [{tc_status,{skipped,Reason}},{save_config,SaveCfg}],
- NewRes = do_end_tc_call(Mod,Func, Line, {{skip,Reason},[Conf]},
+ Conf = [{tc_status,{skipped,Reason}},{save_config,SaveCfg}|hd(Args)],
+ NewRes = do_end_tc_call(Mod,Func, {{skip,Reason},[Conf]},
{skip,Reason}),
{{0,NewRes},Line,[]};
FailTC = {fail,Reason} -> % user fails the testcase
EndConf = [{tc_status,{failed,Reason}} | hd(Args)],
fw_error_notify(Mod, Func, EndConf, Reason),
- NewRes = do_end_tc_call(Mod,Func, {Mod,Func},
+ NewRes = do_end_tc_call(Mod,Func,
{{error,Reason},[EndConf]},
FailTC),
- {{0,NewRes},{Mod,Func},[]};
+ {{0,NewRes},[{Mod,Func}],[]};
{ok,NewConf} ->
- put(test_server_init_or_end_conf,undefined),
%% call user callback function if defined
NewConf1 = user_callback(TCCallback, Mod, Func, init, NewConf),
%% save current state in controller loop
- sync_send(group_leader(),set_curr_conf,{{Mod,Func},NewConf1},
- 5000, fun() -> exit(no_answer_from_group_leader) end),
- put(test_server_loc, {Mod,Func}),
+ set_tc_state(tc, NewConf1),
%% execute the test case
{{T,Return},Loc} = {ts_tc(Mod, Func, [NewConf1]),get_loc()},
{EndConf,TSReturn,FWReturn} =
case Return of
{E,TCError} when E=='EXIT' ; E==failed ->
- ModLoc = mod_loc(Loc),
fw_error_notify(Mod, Func, NewConf1,
- TCError, ModLoc),
+ TCError, Loc),
{[{tc_status,{failed,TCError}},
- {tc_fail_loc,ModLoc}|NewConf1],
+ {tc_fail_loc,Loc}|NewConf1],
Return,{error,TCError}};
SaveCfg={save_config,_} ->
{[{tc_status,ok},SaveCfg|NewConf1],Return,ok};
@@ -1426,8 +990,6 @@ 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),
{FWReturn1,TSReturn1,EndConf2} =
case end_per_testcase(Mod, Func, EndConf1) of
SaveCfg1={save_config,_} ->
@@ -1447,24 +1009,21 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) ->
{FWReturn,TSReturn,EndConf1}
end,
%% clear current state in controller loop
- sync_send(group_leader(),set_curr_conf,undefined,
- 5000, fun() -> exit(no_answer_from_group_leader) end),
- put(test_server_init_or_end_conf,undefined),
- case do_end_tc_call(Mod,Func, Loc,
+ case do_end_tc_call(Mod,Func,
{FWReturn1,[EndConf2]}, TSReturn1) of
{failed,Reason} = NewReturn ->
fw_error_notify(Mod,Func,EndConf2, Reason),
- {{T,NewReturn},{Mod,Func},[]};
+ {{T,NewReturn},[{Mod,Func}],[]};
NewReturn ->
{{T,NewReturn},Loc,[]}
end
end;
skip_init ->
+ set_tc_state(running, hd(Args)),
%% call user callback function if defined
Args1 = user_callback(TCCallback, Mod, Func, init, Args),
ensure_timetrap(Args1),
%% ts_tc does a catch
- put(test_server_loc, {Mod,Func}),
%% if this is a named conf group, the test case (init or end conf)
%% should be called with the name as the first argument
Args2 = if Name == undefined -> Args1;
@@ -1475,43 +1034,12 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) ->
%% call user callback function if defined
Return1 = user_callback(TCCallback, Mod, Func, 'end', Return),
{Return2,Opts} = process_return_val([Return1], Mod, Func,
- Args1, {Mod,Func}, Return1),
+ Args1, [{Mod,Func}], Return1),
{{T,Return2},Loc,Opts}
end.
-do_end_tc_call(M,F, Loc, Res, Return) ->
- IsSuite = case lists:reverse(atom_to_list(M)) of
- [$E,$T,$I,$U,$S,$_|_] -> true;
- _ -> false
- end,
+do_end_tc_call(Mod, Func, Res, Return) ->
FwMod = os:getenv("TEST_SERVER_FRAMEWORK"),
- {Mod,Func} =
- if FwMod == M ; FwMod == "undefined"; FwMod == false ->
- {M,F};
- (not IsSuite) and is_list(Loc) and (length(Loc)>1) ->
- %% If failure in other module (M) than suite, try locate
- %% suite name in Loc list and call end_tc with Suite:TestCase
- %% instead of M:F.
- GetSuite = fun(S,TC) ->
- case lists:reverse(atom_to_list(S)) of
- [$E,$T,$I,$U,$S,$_|_] -> [{S,TC}];
- _ -> []
- end
- end,
- case lists:flatmap(fun({S,TC,_}) -> GetSuite(S,TC);
- ({{S,TC},_}) -> GetSuite(S,TC);
- ({S,TC}) -> GetSuite(S,TC);
- (_) -> []
- end, Loc) of
- [] ->
- {M,F};
- [FoundSuite|_] ->
- FoundSuite
- end;
- true ->
- {M,F}
- end,
-
Ref = make_ref(),
if FwMod == "ct_framework" ; FwMod == "undefined"; FwMod == false ->
case test_server_sup:framework_call(
@@ -1553,7 +1081,7 @@ process_return_val([Return], M,F,A, Loc, Final) when is_list(Return) ->
true -> % must be return value from end conf case
process_return_val1(Return, M,F,A, Loc, Final, []);
false -> % must be Config value from init conf case
- case do_end_tc_call(M, F, Loc, {ok,A}, Return) of
+ case do_end_tc_call(M, F, {ok,A}, Return) of
{failed, FWReason} = Failed ->
fw_error_notify(M,F,A, FWReason),
{Failed, []};
@@ -1569,9 +1097,9 @@ process_return_val(Return, M,F,A, Loc, Final) ->
process_return_val1([Failed={E,TCError}|_], M,F,A=[Args], Loc, _, SaveOpts)
when E=='EXIT';
E==failed ->
- fw_error_notify(M,F,A, TCError, mod_loc(Loc)),
- case do_end_tc_call(M,F, Loc, {{error,TCError},
- [[{tc_status,{failed,TCError}}|Args]]},
+ fw_error_notify(M,F,A, TCError, Loc),
+ case do_end_tc_call(M,F, {{error,TCError},
+ [[{tc_status,{failed,TCError}}|Args]]},
Failed) of
{failed,FWReason} ->
{{failed,FWReason},SaveOpts};
@@ -1589,8 +1117,8 @@ process_return_val1([RetVal={Tag,_}|Opts], M,F,A, Loc, _, SaveOpts) when Tag==sk
process_return_val1(Opts, M,F,A, Loc, RetVal, SaveOpts);
process_return_val1([_|Opts], M,F,A, Loc, Final, SaveOpts) ->
process_return_val1(Opts, M,F,A, Loc, Final, SaveOpts);
-process_return_val1([], M,F,A, Loc, Final, SaveOpts) ->
- case do_end_tc_call(M,F, Loc, {Final,A}, Final) of
+process_return_val1([], M,F,A, _Loc, Final, SaveOpts) ->
+ case do_end_tc_call(M,F, {Final,A}, Final) of
{failed,FWReason} ->
{{failed,FWReason},SaveOpts};
NewReturn ->
@@ -1656,7 +1184,7 @@ do_init_per_testcase(Mod, Args) ->
throw:Other ->
set_loc(erlang:get_stacktrace()),
Line = get_loc(),
- FormattedLoc = test_server_sup:format_loc(mod_loc(Line)),
+ FormattedLoc = test_server_sup:format_loc(Line),
group_leader() ! {printout,12,
"ERROR! init_per_testcase thrown!\n"
"\tLocation: ~s\n\tReason: ~p\n",
@@ -1667,7 +1195,7 @@ do_init_per_testcase(Mod, Args) ->
Reason = {Reason0,Stk},
set_loc(Stk),
Line = get_loc(),
- FormattedLoc = test_server_sup:format_loc(mod_loc(Line)),
+ FormattedLoc = test_server_sup:format_loc(Line),
group_leader() ! {printout,12,
"ERROR! init_per_testcase crashed!\n"
"\tLocation: ~s\n\tReason: ~p\n",
@@ -1690,8 +1218,7 @@ end_per_testcase(Mod, Func, Conf) ->
end.
do_end_per_testcase(Mod,EndFunc,Func,Conf) ->
- put(test_server_init_or_end_conf,{EndFunc,Func}),
- put(test_server_loc, {Mod,{EndFunc,Func}}),
+ set_tc_state(end_per_testcase, Conf),
try Mod:EndFunc(Func, Conf) of
{save_config,_}=SaveCfg ->
SaveCfg;
@@ -1715,8 +1242,7 @@ do_end_per_testcase(Mod,EndFunc,Func,Conf) ->
"Reason: ~p\n"
"Line: ~s\n",
[EndFunc, Other,
- test_server_sup:format_loc(
- mod_loc(get_loc()))]},
+ test_server_sup:format_loc(get_loc())]},
{failed,{Mod,end_per_testcase,Other}};
Class:Reason ->
Stk = erlang:get_stacktrace(),
@@ -1738,8 +1264,7 @@ do_end_per_testcase(Mod,EndFunc,Func,Conf) ->
"Reason: ~p\n"
"Line: ~s\n",
[EndFunc, Reason,
- test_server_sup:format_loc(
- mod_loc(get_loc()))]},
+ test_server_sup:format_loc(get_loc())]},
{failed,{Mod,end_per_testcase,Why}}
end.
@@ -1752,66 +1277,19 @@ 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);
- {Suite,Case} ->
+ [{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
+ %% instead of current test_server_loc
case [match || {S,C,_L} <- Stk, S == Suite, C == Case] of
[match|_] -> put(test_server_loc, Stk);
_ -> ok
end;
_ ->
- ok
+ put(test_server_loc, Stk)
end,
get_loc().
-%% find the latest known Suite:Testcase
-get_mf(MFs) ->
- get_mf(MFs, {undefined,undefined}).
-
-get_mf([MF|MFs], _Found) when is_tuple(MF) ->
- ModFunc = {Mod,_} = case MF of
- {M,F,_} -> {M,F};
- MF -> MF
- end,
- case is_suite(Mod) of
- true -> ModFunc;
- false -> get_mf(MFs, ModFunc)
- end;
-get_mf(_, Found) ->
- Found.
-
-is_suite(Mod) ->
- case lists:reverse(atom_to_list(Mod)) of
- "ETIUS" ++ _ -> true;
- _ -> false
- end.
-
-mod_loc(Loc) ->
- %% handle diff line num versions
- case Loc of
- [{{_M,_F},_L}|_] ->
- [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.
-
-
fw_error_notify(Mod, Func, Args, Error) ->
test_server_sup:framework_call(error_notification,
[?pl2a(Mod),Func,[Args],
@@ -1833,10 +1311,10 @@ fw_error_notify(Mod, Func, Args, Error, Loc) ->
%% is directed to console, major and/or minor log files.
print(Detail,Format,Args) ->
- local_or_remote_apply({test_server_ctrl,print,[Detail,Format,Args]}).
+ test_server_ctrl:print(Detail, Format, Args).
print(Detail,Format,Args,Printer) ->
- local_or_remote_apply({test_server_ctrl,print,[Detail,Format,Args,Printer]}).
+ test_server_ctrl:print(Detail, Format, Args, Printer).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% print_timsteamp(Detail,Leader) -> ok
@@ -1846,7 +1324,7 @@ print(Detail,Format,Args,Printer) ->
%% log files.
print_timestamp(Detail,Leader) ->
- local_or_remote_apply({test_server_ctrl,print_timestamp,[Detail,Leader]}).
+ test_server_ctrl:print_timestamp(Detail, Leader).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1894,7 +1372,12 @@ ts_tc(M, F, A) ->
{Elapsed, Result}.
set_loc(Stk) ->
- Loc = [rewrite_loc_item(I) || {_,_,_,_}=I <- Stk],
+ Loc = case [rewrite_loc_item(I) || {_,_,_,_}=I <- Stk] of
+ [{M,F,0}|Stack] ->
+ [{M,F}|Stack];
+ Other ->
+ Other
+ end,
put(test_server_loc, Loc).
rewrite_loc_item({M,F,_,Loc}) ->
@@ -1908,16 +1391,6 @@ rewrite_loc_item({M,F,_,Loc}) ->
%% Note: Some of these functions have been moved to test_server_sup %%
%% in an attempt to keep this modules small (yeah, right!) %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-unicode_to_latin1(Chars) when is_list(Chars); is_binary(Chars) ->
- lists:flatten(
- [ case X of
- High when High > 255 ->
- io_lib:format("\\{~.8B}",[X]);
- Low ->
- Low
- end || X <- unicode:characters_to_list(Chars,unicode) ]);
-unicode_to_latin1(Garbage) ->
- Garbage.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% format(Format) -> IoLibReturn
@@ -2170,28 +1643,19 @@ continue(Pid) when is_pid(Pid) ->
%%
%% Returns the amount to scale timetraps with.
+%% {X, fun() -> check() end} <- multiply scale with X if Fun() is true
timetrap_scale_factor() ->
- F0 = case test_server:purify_is_running() of
- true -> 5;
- false -> 1
- end,
- F1 = case {is_debug(), has_lock_checking()} of
- {true,_} -> 6 * F0;
- {false,true} -> 2 * F0;
- {false,false} -> F0
- end,
- F2 = 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
- end.
+ timetrap_scale_factor([
+ { 2, fun() -> has_lock_checking() end},
+ { 3, fun() -> has_superfluous_schedulers() end},
+ { 5, fun() -> purify_is_running() end},
+ { 6, fun() -> is_debug() end},
+ {10, fun() -> is_cover() end}
+ ]).
+
+timetrap_scale_factor(Scales) ->
+ %% The fun in {S, Fun} a filter input to the list comprehension
+ lists:foldl(fun(S,O) -> O*S end, 1, [ S || {S,F} <- Scales, F()]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -2519,11 +1983,7 @@ get_timetrap_info(TCPid, SendToServer) ->
[I|_] ->
I;
[] when SendToServer == true ->
- MsgLooper = group_leader(),
- MsgLooper ! {get_timetrap_info,TCPid,self()},
- receive
- {MsgLooper,get_timetrap_info,I} -> I
- end;
+ tc_supervisor_req({get_timetrap_info,TCPid});
[] ->
undefined
end
@@ -2542,17 +2002,29 @@ hours(N) -> trunc(N * 1000 * 60 * 60).
minutes(N) -> trunc(N * 1000 * 60).
seconds(N) -> trunc(N * 1000).
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% sync_send(Pid,Tag,Msg,Timeout,DoAfter) -> Result
+%% tc_supervisor_req(Tag) -> Result
+%% tc_supervisor_req(Tag, Msg) -> Result
%%
-sync_send(Pid,Tag,Msg,Timeout,DoAfter) ->
+
+tc_supervisor_req(Tag) ->
+ Pid = test_server_gl:get_tc_supervisor(group_leader()),
+ Pid ! {Tag,self()},
+ receive
+ {Pid,Tag,Result} ->
+ Result
+ after 5000 ->
+ error(no_answer_from_tc_supervisor)
+ end.
+
+tc_supervisor_req(Tag, Msg) ->
+ Pid = test_server_gl:get_tc_supervisor(group_leader()),
Pid ! {Tag,self(),Msg},
receive
{Pid,Tag,Result} ->
Result
- after Timeout ->
- DoAfter()
+ after 5000 ->
+ error(no_answer_from_tc_supervisor)
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -2714,7 +2186,10 @@ start_node(Name, Type, Options) ->
%% by a shielded node.
Cover = case is_cover() of
true ->
- not is_shielded(Name) andalso same_version(Node);
+ not is_shielded(Name)
+ andalso same_version(Node)
+ andalso proplists:get_value(start_cover,Options,
+ true);
false ->
false
end,
@@ -2722,9 +2197,7 @@ start_node(Name, Type, Options) ->
net_adm:ping(Node),
case Cover of
true ->
- Sticky = unstick_all_sticky(Node),
- cover:start(Node),
- stick_all_sticky(Node,Sticky);
+ do_cover_for_node(Node,start);
_ ->
ok
end,
@@ -2752,7 +2225,27 @@ wait_for_node(Slave) ->
group_leader() ! {sync_apply,
self(),
{test_server_ctrl,wait_for_node,[Slave]}},
- receive {sync_result,R} -> R end.
+ Result = receive {sync_result,R} -> R end,
+ case Result of
+ ok ->
+ Cover = case is_cover() of
+ true ->
+ not is_shielded(Slave) andalso same_version(Slave);
+ false ->
+ false
+ end,
+
+ net_adm:ping(Slave),
+ case Cover of
+ true ->
+ do_cover_for_node(Slave,start);
+ _ ->
+ ok
+ end;
+ _ ->
+ ok
+ end,
+ Result.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -2764,9 +2257,7 @@ stop_node(Slave) ->
Nocover = is_shielded(Slave) orelse not same_version(Slave),
case is_cover() of
true when not Nocover ->
- Sticky = unstick_all_sticky(Slave),
- cover:stop(Slave),
- stick_all_sticky(Slave,Sticky);
+ do_cover_for_node(Slave,flush);
_ ->
ok
end,
@@ -2947,13 +2438,7 @@ comment(String) ->
%% Read the current comment string stored in
%% state during test case execution.
read_comment() ->
- MsgLooper = group_leader(),
- MsgLooper ! {read_comment,self()},
- receive
- {MsgLooper,read_comment,Comment} -> Comment
- after
- 5000 -> ""
- end.
+ tc_supervisor_req(read_comment).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% make_priv_dir() -> ok
@@ -2961,13 +2446,7 @@ read_comment() ->
%% 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 -> error
- end.
+ tc_supervisor_req(make_priv_dir).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% os_type() -> OsType
@@ -2975,7 +2454,7 @@ make_priv_dir() ->
%% Returns the OsType of the target node. OsType is
%% the same as returned from os:type()
os_type() ->
- test_server_ctrl:get_target_os_type().
+ os:type().
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -3094,47 +2573,9 @@ purify_format(Format, Args) ->
%%
%% Generic send functions for communication with host
%%
-sync_local_or_remote_apply(Proxy,From,{M,F,A} = MFA) ->
- case get(test_server_job_sock) of
- undefined ->
- %% i'm a local target
- Result = apply(M,F,A),
- if is_pid(Proxy) -> Proxy ! {sync_result_proxy,From,Result};
- true -> From ! {sync_result,Result}
- end;
- JobSock ->
- %% i'm a remote target
- request(JobSock,{sync_apply,MFA}),
- {sync_result,Result} = recv(JobSock),
- if is_pid(Proxy) -> Proxy ! {sync_result_proxy,From,Result};
- true -> From ! {sync_result,Result}
- end
- end.
-local_or_remote_apply({M,F,A} = MFA) ->
- case get(test_server_job_sock) of
- undefined ->
- %% i'm a local target
- apply(M,F,A),
- ok;
- JobSock ->
- %% i'm a remote target
- request(JobSock,{apply,MFA}),
- ok
- end.
-
-request(Sock,Request) ->
- gen_tcp:send(Sock,<<1,(term_to_binary(Request))/binary>>).
-
-%%
-%% Generic receive function for communication with host
-%%
-recv(Sock) ->
- case gen_tcp:recv(Sock,0) of
- {error,closed} ->
- gen_tcp:close(Sock),
- exit(connection_lost);
- {ok,<<1,Request/binary>>} ->
- binary_to_term(Request);
- {ok,<<0,B/binary>>} ->
- B
+sync_local_or_remote_apply(Proxy, From, {M,F,A}) ->
+ %% i'm a local target
+ Result = apply(M, F, A),
+ if is_pid(Proxy) -> Proxy ! {sync_result_proxy,From,Result};
+ true -> From ! {sync_result,Result}
end.
diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl
index df2187bc04..7b2ebcefc0 100644
--- a/lib/test_server/src/test_server_ctrl.erl
+++ b/lib/test_server/src/test_server_ctrl.erl
@@ -34,118 +34,6 @@
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% ARCHITECTURE
-%%
-%% The Erlang Test Server can be run on the target machine (local target)
-%% or towards a remote target. The execution flow is mainly the same in
-%% both cases, but with a remote target the test cases are (obviously)
-%% executed on the target machine. Host and target communicates over
-%% socket connections because the host should not be introduced as an
-%% additional node in the distributed erlang system in which the test
-%% cases are run.
-%%
-%%
-%% Local Target:
-%% =============
-%%
-%% -----
-%% | | test_server_ctrl ({global,test_server})
-%% ----- (test_server_ctrl.erl)
-%% |
-%% |
-%% -----
-%% | | JobProc
-%% ----- (test_server_ctrl.erl and test_server.erl)
-%% |
-%% |
-%% -----
-%% | | CaseProc
-%% ----- (test_server.erl)
-%%
-%%
-%%
-%% test_server_ctrl is the main process in the system. It is a registered
-%% process, and it will always be alive when testing is ongoing.
-%% test_server_ctrl initiates testing and monitors JobProc(s).
-%%
-%% When target is local, and Test Server is *not* being used by a framework
-%% application (where it might cause duplicate name problems in a distributed
-%% test environment), the process is globally registered as 'test_server'
-%% to be able to simulate the {global,test_server} process on a remote target.
-%%
-%% JobProc is spawned for each 'job' added to the test_server_ctrl.
-%% A job can mean one test case, one test suite or one spec.
-%% JobProc creates and writes logs and presents results from testing.
-%% JobProc is the group leader for CaseProc.
-%%
-%% CaseProc is spawned for each test case. It runs the test case and
-%% sends results and any other information to its group leader - JobProc.
-%%
-%%
-%%
-%% Remote Target:
-%% ==============
-%%
-%% HOST TARGET
-%%
-%% ----- MainSock -----
-%% test_server_ctrl | |- - - - - - -| | {global,test_server}
-%% (test_server_ctrl.erl) ----- ----- (test_server.erl)
-%% | |
-%% | |
-%% ----- JobSock -----
-%% JobProcH | |- - - - - - -| | JobProcT
-%% (test_server_ctrl.erl) ----- ----- (test_server.erl)
-%% |
-%% |
-%% -----
-%% | | CaseProc
-%% ----- (test_server.erl)
-%%
-%%
-%%
-%%
-%% A separate test_server process only exists when target is remote. It
-%% is then the main process on target. It is started when test_server_ctrl
-%% is started, and a socket connection is established between
-%% test_server_ctrl and test_server. The following information can be sent
-%% over MainSock:
-%%
-%% HOST TARGET
-%% -> {target_info, TargetInfo} (during initiation)
-%% <- {job_proc_killed,Name,Reason} (if a JobProcT dies unexpectedly)
-%% -> {job,Port,Name} (to start a new JobProcT)
-%%
-%%
-%% When target is remote, JobProc is split into to processes: JobProcH
-%% executing on Host and JobProcT executing on Target. (The two processes
-%% execute the same code as JobProc does when target is local.) JobProcH
-%% and JobProcT communicates over a socket connection. The following
-%% information can be sent over JobSock:
-%%
-%% HOST TARGET
-%% -> {test_case, Case} To start a new test case
-%% -> {beam,Mod} .beam file as binary to be loaded
-%% on target, e.g. a test suite
-%% -> {datadir,Tarfile} Content of the datadir for a test suite
-%% <- {apply,MFA} MFA to be applied on host, ignore return;
-%% (apply is used for printing information in
-%% log or console)
-%% <- {sync_apply,MFA} MFA to be applied on host, wait for return
-%% (used for starting and stopping slave nodes)
-%% -> {sync_apply,MFA} MFA to be applied on target, wait for return
-%% (used for cover compiling and analysing)
-%% <-> {sync_result,Result} Return value from sync_apply
-%% <- {test_case_result,Result} When a test case is finished
-%% <- {crash_dumps,Tarfile} When a test case is finished
-%% -> job_done When a job is finished
-%% <- {privdir,Privdir} When a job is finished
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
-
%%% SUPERVISOR INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([start/0, start/1, start_link/1, stop/0]).
@@ -165,19 +53,18 @@
-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([cover/2, cover/3, cover/8,
+ cross_cover_analyse/2, cross_cover_analyse/3, trc/1, stop_trace/0]).
-export([testcase_callback/1]).
-export([set_random_seed/1]).
-export([kill_slavenodes/0]).
%%% TEST_SERVER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--export([output/2, print/2, print/3, print/4, print_timestamp/2]).
+-export([print/2, print/3, print/4, print_timestamp/2]).
-export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]).
-export([format/1, format/2, format/3, to_string/1]).
-export([get_target_info/0]).
-export([get_hosts/0]).
--export([get_target_os_type/0]).
-export([node_started/1]).
%%% DEBUGGER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -203,6 +90,7 @@
-define(coverlog_name, "cover.html").
-define(cross_coverlog_name, "cross_cover.html").
-define(cover_total, "total_cover.log").
+-define(unexpected_io_log, "unexpected_io.log").
-define(last_file, "last_name").
-define(last_link, "last_link").
-define(last_test, "last_test").
@@ -430,14 +318,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'
@@ -470,8 +350,7 @@ wait_finish() ->
ok.
abort_current_testcase(Reason) ->
- controller_call({abort_current_testcase,Reason}),
- ok.
+ controller_call({abort_current_testcase,Reason}).
abort() ->
OldTrap = process_flag(trap_exit, true),
@@ -528,9 +407,9 @@ cover(App, Analyse) when is_atom(App) ->
cover(CoverFile, Analyse) ->
cover(none, CoverFile, Analyse).
cover(App, CoverFile, Analyse) ->
- controller_call({cover,{App,CoverFile},Analyse}).
-cover(App, CoverFile, Exclude, Include, Cross, Export, Analyse) ->
- controller_call({cover,{App,{CoverFile,Exclude,Include,Cross,Export}},Analyse}).
+ controller_call({cover,{App,CoverFile},Analyse,true}).
+cover(App, CoverFile, Exclude, Include, Cross, Export, Analyse, Stop) ->
+ controller_call({cover,{App,{CoverFile,Exclude,Include,Cross,Export}},Analyse,Stop}).
testcase_callback(ModFunc) ->
controller_call({testcase_callback,ModFunc}).
@@ -544,20 +423,6 @@ kill_slavenodes() ->
get_hosts() ->
get(test_server_hosts).
-get_target_os_type() ->
- case whereis(?MODULE) of
- undefined ->
- %% This is probably called on the target node
- os:type();
- Pid when Pid =:= self() ->
- os:type();
- _pid ->
- %% This is called on the controller, e.g. from a
- %% specification clause of a test case
- #target_info{os_type=OsType} = controller_call(get_target_info),
- OsType
- end.
-
%%--------------------------------------------------------------------
add_job(Name, TopCase) ->
@@ -613,7 +478,7 @@ controller_call(Arg, Timeout) ->
%% Mode 'lazy' ignores (and resets to []) any jobs in the state file
%%
-init([Param]) ->
+init([_]) ->
case os:getenv("TEST_SERVER_CALL_TRACE") of
false ->
ok;
@@ -639,104 +504,14 @@ init([Param]) ->
test_server_sup:cleanup_crash_dumps(),
State = #state{jobs=[],finish=false},
put(test_server_free_targets,[]),
- case contact_main_target(Param) of
- {ok,TI} ->
- ets:new(slave_tab, [named_table,set,public,{keypos,2}]),
- set_hosts([TI#target_info.host]),
- {ok,State#state{target_info=TI}};
- {error,Reason} ->
- {stop,Reason}
- end.
-
-
-%% If the test is to be run at a remote target, this function sets up
-%% a socket communication with the target.
-contact_main_target(local) ->
- %% When used by a general framework, global registration of
- %% test_server should not be required.
- 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.
- global:sync(),
- case global:whereis_name(test_server) of
- undefined ->
- global:register_name(test_server, self());
- Pid ->
- case node() of
- N when N == node(Pid) ->
- io:format(user, "Warning: test_server already running!\n", []),
- global:re_register_name(test_server,self());
- _ ->
- ok
- end
- end;
- _ ->
- ok
- end,
- TI = test_server:init_target_info(),
+ TI0 = test_server:init_target_info(),
TargetHost = test_server_sup:hoststr(),
- {ok,TI#target_info{where=local,
- host=TargetHost,
- naming=naming(),
- master=TargetHost}};
-
-contact_main_target(ParameterFile) ->
- case read_parameters(ParameterFile) of
- {ok,Par} ->
- case test_server_node:start_remote_main_target(Par) of
- {ok,TI} ->
- {ok,TI};
- {error,Error} ->
- {error,{could_not_start_main_target,Error}}
- end;
- {error,Error} ->
- {error,{could_not_read_parameterfile,Error}}
- end.
-
-read_parameters(File) ->
- case file:consult(File) of
- {ok,Data} ->
- read_parameters(lists:flatten(Data), #par{naming=naming()});
- Error ->
- Error
- end.
-read_parameters([{type,Type}|Data], Par) -> % mandatory
- read_parameters(Data, Par#par{type=Type});
-read_parameters([{target,Target}|Data], Par) -> % mandatory
- read_parameters(Data, Par#par{target=cast_to_list(Target)});
-read_parameters([{slavetargets,SlaveTargets}|Data], Par) ->
- read_parameters(Data, Par#par{slave_targets=SlaveTargets});
-read_parameters([{longnames,Bool}|Data], Par) ->
- Naming = if Bool->"-name"; true->"-sname" end,
- read_parameters(Data, Par#par{naming=Naming});
-read_parameters([{master,{Node,Cookie}}|Data], Par) ->
- read_parameters(Data, Par#par{master=cast_to_list(Node),
- cookie=cast_to_list(Cookie)});
-read_parameters([Other|_Data], _Par) ->
- {error,{illegal_parameter,Other}};
-read_parameters([], Par) when Par#par.type==undefined ->
- {error, {missing_mandatory_parameter,type}};
-read_parameters([], Par) when Par#par.target==undefined ->
- {error, {missing_mandatory_parameter,target}};
-read_parameters([], Par0) ->
- Par =
- case {Par0#par.type, Par0#par.master} of
- {ose, undefined} ->
- %% Use this node as master and bootserver for target
- %% and slave nodes
- Par0#par{master = atom_to_list(node()),
- cookie = atom_to_list(erlang:get_cookie())};
- {ose, _Master} ->
- %% Master for target and slave nodes was defined in parameterfile
- Par0;
- _ ->
- %% Use target as master for slave nodes,
- %% (No master is used for target)
- Par0#par{master="test_server@" ++ Par0#par.target}
- end,
- {ok,Par}.
+ TI = TI0#target_info{host=TargetHost,
+ naming=naming(),
+ master=TargetHost},
+ ets:new(slave_tab, [named_table,set,public,{keypos,2}]),
+ set_hosts([TI#target_info.host]),
+ {ok,State#state{target_info=TI}}.
naming() ->
case lists:member($., test_server_sup:hoststr()) of
@@ -803,7 +578,7 @@ handle_call({add_job,Dir,Name,TopCase,Skip}, _From, State) ->
ExtraTools =
case State#state.cover of
false -> [];
- {App,Analyse} -> [{cover,App,Analyse}]
+ {App,Analyse,Stop} -> [{cover,App,Analyse,Stop}]
end,
ExtraTools1 =
case State#state.random_seed of
@@ -1059,13 +834,13 @@ handle_call(stop_trace, _From, State) ->
{reply,R,State#state{trc=false}};
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({cover,App,Analyse}, _, State) -> ok | {error,Reason}
+%% handle_call({cover,App,Analyse,Stop}, _, State) -> ok | {error,Reason}
%%
%% All modules inn application App are cover compiled
%% Analyse indicates on which level the coverage should be analysed
-handle_call({cover,App,Analyse}, _From, State) ->
- {reply,ok,State#state{cover={App,Analyse}}};
+handle_call({cover,App,Analyse,Stop}, _From, State) ->
+ {reply,ok,State#state{cover={App,Analyse,Stop}}};
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({create_priv_dir,Value}, _, State) -> ok | {error,Reason}
@@ -1217,25 +992,17 @@ handle_cast({node_started,Node}, State) ->
%% Pid = pid()
%% Reason = term()
%%
-%% Handles exit messages from linked processes. Only test suites and
-%% possibly a target client are expected to be linked.
-%% When a test suite terminates, it is removed from the job queue.
-%% If a target client terminates it means that we lost contact with
-%% target. The test_server_ctrl process is terminated, and teminate/2
-%% will do the cleanup
+%% Handles exit messages from linked processes. Only test suites are
+%% expected to be linked. When a test suite terminates, it is removed
+%% from the job queue. If a target client terminates it means that we
+%% lost contact with target. The test_server_ctrl process is
+%% terminated, and teminate/2 will do the cleanup
handle_info({'EXIT',Pid,Reason}, State) ->
case lists:keysearch(Pid,2,State#state.jobs) of
false ->
- TI = State#state.target_info,
- case TI#target_info.target_client of
- Pid ->
- %% The target client died - lost contact with target
- {stop,{lost_contact_with_target,Reason},State};
- _other ->
- %% not our problem
- {noreply,State}
- end;
+ %% not our problem
+ {noreply,State};
{value,{Name,_}} ->
NewJobs = lists:keydelete(Pid, 2, State#state.jobs),
case Reason of
@@ -1310,14 +1077,8 @@ handle_info({tcp_closed,Sock}, State=#state{trc=Sock}) ->
%%! Maybe print something???
{noreply,State#state{trc=false}};
handle_info({tcp_closed,Sock}, State) ->
- case test_server_node:nodedown(Sock,State#state.target_info) of
- target_died ->
- %% terminate/2 will do the cleanup
- {stop,target_died,State};
- _ ->
- {noreply,State}
- end;
-
+ test_server_node:nodedown(Sock, State#state.target_info),
+ {noreply,State};
handle_info(_, State) ->
%% dummy; accept all, do nothing.
{noreply, State}.
@@ -1378,24 +1139,22 @@ kill_all_jobs([]) ->
spawn_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs,
CreatePrivDir, TCCallback, ExtraTools) ->
- spawn_link(
- fun() -> init_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs,
+ spawn_link(fun() ->
+ init_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs,
CreatePrivDir, TCCallback, ExtraTools)
end).
-init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, RejectIoReqs,
- CreatePrivDir, TCCallback, ExtraTools) ->
+init_tester(Mod, Func, Args, Dir, Name, {_,_,MinLev}=Levels,
+ RejectIoReqs, CreatePrivDir, TCCallback, ExtraTools) ->
process_flag(trap_exit, true),
+ test_server_io:start_link(),
put(test_server_name, Name),
put(test_server_dir, Dir),
put(test_server_total_time, 0),
put(test_server_ok, 0),
put(test_server_failed, 0),
put(test_server_skipped, {0,0}),
- 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),
@@ -1411,23 +1170,30 @@ init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, RejectIoReqs,
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),
- put(test_server_log_nl, not lists:member(no_nl, LogOpts)),
+
StartedExtraTools = start_extra_tools(ExtraTools),
+
+ test_server_io:set_job_name(Name),
+ test_server_io:set_gl_props([{levels,Levels},
+ {auto_nl,not lists:member(no_nl, LogOpts)},
+ {reject_io_reqs,RejectIoReqs}]),
+ group_leader(test_server_io:get_gl(true), self()),
{TimeMy,Result} = ts_tc(Mod, Func, Args),
- put(test_server_common_io_handler, undefined),
- stop_extra_tools(StartedExtraTools),
+ set_io_buffering(undefined),
+ test_server_io:set_job_name(undefined),
+ catch stop_extra_tools(StartedExtraTools),
case Result of
{'EXIT',test_suites_done} ->
- print(25, "DONE, normal exit", []);
+ ok;
{'EXIT',_Pid,Reason} ->
print(1, "EXIT, reason ~p", [Reason]);
{'EXIT',Reason} ->
- print(1, "EXIT, reason ~p", [Reason]);
- _Other ->
- print(25, "DONE", [])
+ report_severe_error(Reason),
+ print(1, "EXIT, reason ~p", [Reason])
end,
Time = TimeMy/1000000,
SuccessStr =
@@ -1446,7 +1212,11 @@ init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, RejectIoReqs,
"<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]).
+ [Time,SuccessStr,OkN,FailedN,SkipStr,OkN+FailedN+SkippedN]),
+ test_server_io:stop().
+
+report_severe_error(Reason) ->
+ test_server_sup:framework_call(report, [severe_error,Reason]).
%% timer:tc/3
ts_tc(M, F, A) ->
@@ -1464,11 +1234,11 @@ elapsed_time(Before, After) ->
start_extra_tools(ExtraTools) ->
start_extra_tools(ExtraTools, []).
-start_extra_tools([{cover,App,Analyse} | ExtraTools], Started) ->
+start_extra_tools([{cover,App,Analyse,Stop} | ExtraTools], Started) ->
case cover_compile(App) of
{ok,AnalyseMods} ->
start_extra_tools(ExtraTools,
- [{cover,App,Analyse,AnalyseMods}|Started]);
+ [{cover,App,Analyse,AnalyseMods,Stop}|Started]);
{error,_} ->
start_extra_tools(ExtraTools, Started)
end;
@@ -1487,8 +1257,8 @@ stop_extra_tools(ExtraTools) ->
end,
stop_extra_tools(ExtraTools, TestDir).
-stop_extra_tools([{cover,App,Analyse,AnalyseMods}|ExtraTools], TestDir) ->
- cover_analyse(App, Analyse, AnalyseMods, TestDir),
+stop_extra_tools([{cover,App,Analyse,AnalyseMods,Stop}|ExtraTools], TestDir) ->
+ cover_analyse(App, Analyse, AnalyseMods, Stop, TestDir),
stop_extra_tools(ExtraTools, TestDir);
%%stop_extra_tools([_ | ExtraTools], TestDir) ->
%% stop_extra_tools(ExtraTools, TestDir);
@@ -1820,8 +1590,9 @@ do_test_cases(TopCases, SkipCases,
print(html,
"<p><ul>\n"
"<li><a href=\"~s\">Full textual log</a></li>\n"
- "<li><a href=\"~s\">Coverage log</a></li>\n</ul></p>\n",
- [?suitelog_name,?coverlog_name]),
+ "<li><a href=\"~s\">Coverage log</a></li>\n"
+ "<li><a href=\"~s\">Unexpected I/O log</a></li>\n</ul></p>\n",
+ [?suitelog_name,?coverlog_name,?unexpected_io_log]),
print(html,
"<p>~s</p>\n" ++
xhtml("<table bgcolor=\"white\" border=\"3\" cellpadding=\"5\">",
@@ -1881,7 +1652,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 =
@@ -1896,20 +1667,26 @@ 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"),
put(test_server_log_dir_base,TestDir1),
MajorName = filename:join(TestDir1, ?suitelog_name),
HtmlName = MajorName ++ ?html_ext,
+ UnexpectedName = filename:join(TestDir1, ?unexpected_io_log),
{ok,Major} = file:open(MajorName, [write]),
{ok,Html} = file:open(HtmlName, [write]),
+ {ok,Unexpected} = file:open(UnexpectedName, [write]),
+ test_server_io:set_fd(major, Major),
+ test_server_io:set_fd(html, Html),
+ test_server_io:set_fd(unexpected_io, Unexpected),
put(test_server_major_fd,Major),
put(test_server_html_fd,Html),
+ put(test_server_unexpected_io, Unexpected),
make_html_link(filename:absname(?last_test ++ ?html_ext),
HtmlName, filename:basename(Dir)),
@@ -1920,12 +1697,15 @@ start_log_file() ->
PrivDir = filename:join(TestDir1, ?priv_dir),
ok = file:make_dir(PrivDir),
put(test_server_priv_dir,PrivDir++"/"),
- print_timestamp(13,"Suite started at "),
+ print_timestamp(major, "Suite started at "),
LogInfo = [{topdir,Dir},{rundir,lists:flatten(TestDir1)}],
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),
@@ -1959,13 +1739,14 @@ make_html_link(LinkName, Target, Explanation) ->
%% Some header info will also be inserted into the log file.
start_minor_log_file(Mod, Func) ->
+ MFA = {Mod,Func,1},
LogDir = get(test_server_log_dir_base),
Name0 = lists:flatten(io_lib:format("~s.~s~s", [Mod,Func,?html_ext])),
Name = downcase(Name0),
AbsName = filename:join(LogDir, Name),
case file:read_file_info(AbsName) of
{error,_} -> %% normal case, unique name
- start_minor_log_file1(Mod, Func, LogDir, AbsName);
+ start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA);
{ok,_} -> %% special case, duplicate names
{_,S,Us} = now(),
Name1_0 =
@@ -1974,14 +1755,15 @@ start_minor_log_file(Mod, Func) ->
?html_ext])),
Name1 = downcase(Name1_0),
AbsName1 = filename:join(LogDir, Name1),
- start_minor_log_file1(Mod, Func, LogDir, AbsName1)
+ start_minor_log_file1(Mod, Func, LogDir, AbsName1, MFA)
end.
-start_minor_log_file1(Mod, Func, LogDir, AbsName) ->
+start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA) ->
{ok,Fd} = file:open(AbsName, [write]),
Lev = get(test_server_minor_level)+1000, %% far down in the minor levels
put(test_server_minor_fd, Fd),
-
+ test_server_gl:set_minor_fd(group_leader(), Fd, MFA),
+
TestDescr = io_lib:format("Test ~p:~p result", [Mod,Func]),
{Header,Footer} =
case test_server_sup:framework_call(get_html_wrapper,
@@ -2029,6 +1811,7 @@ start_minor_log_file1(Mod, Func, LogDir, AbsName) ->
AbsName.
stop_minor_log_file() ->
+ test_server_gl:unset_minor_fd(group_leader()),
Fd = get(test_server_minor_fd),
Footer = get(test_server_minor_footer),
io:fwrite(Fd, "</pre>\n" ++ Footer, []),
@@ -2304,9 +2087,7 @@ do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) ->
%% Runs the specified tests, then displays/logs the summary.
run_test_cases(TestSpec, Config, TimetrapData) ->
-
- maybe_open_job_sock(),
-
+ test_server:init_purify(),
case lists:member(no_src, get(test_server_logopts)) of
true ->
ok;
@@ -2316,8 +2097,6 @@ run_test_cases(TestSpec, Config, TimetrapData) ->
run_test_cases_loop(TestSpec, [Config], TimetrapData, [], []),
- maybe_get_privdir(),
-
{AllSkippedN,UserSkipN,AutoSkipN,SkipStr} =
case get(test_server_skipped) of
{0,0} -> {0,0,0,""};
@@ -2336,41 +2115,6 @@ run_test_cases(TestSpec, Config, TimetrapData) ->
print(major, "=auto_skipped ~p", [AutoSkipN]),
exit(test_suites_done).
-%% If the test is run at a remote target, this function sets up a socket
-%% communication with the target for handling this particular job.
-maybe_open_job_sock() ->
- TI = get_target_info(),
- case TI#target_info.where of
- local ->
- %% local target
- test_server:init_purify();
- MainSock ->
- %% remote target
- {ok,LSock} = gen_tcp:listen(0, [binary,
- {reuseaddr,true},
- {packet,4},
- {active,false}]),
- {ok,Port} = inet:port(LSock),
- request(MainSock, {job,Port,get(test_server_name)}),
- case gen_tcp:accept(LSock, ?ACCEPT_TIMEOUT) of
- {ok,Sock} -> put(test_server_ctrl_job_sock, Sock);
- {error,Reason} -> exit({no_contact,Reason})
- end
- end.
-
-%% If the test is run at a remote target, this function waits for a
-%% tar packet containing the privdir created by the test case.
-maybe_get_privdir() ->
- case get(test_server_ctrl_job_sock) of
- undefined ->
- %% local target
- ok;
- Sock ->
- %% remote target
- request(Sock, job_done),
- gen_tcp:close(Sock)
- end.
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% run_test_cases_loop(TestCases, Config, TimetrapData, Mode, Status) -> ok
@@ -2449,27 +2193,38 @@ maybe_get_privdir() ->
%% reason, the Mode argument specifies if a parallel group is currently
%% being executed.
%%
-%% A parallel test case process will always set the dictionary value
-%% 'test_server_common_io_handler' to the pid of the main (starting)
-%% process. With this value set, the print/3 function will send print
-%% messages to the main process instead of writing the data to file
-%% (only true for printouts to common log files).
+%% The low-level mechanism for buffering IO for the common log files
+%% is handled by the test_server_io module. Buffering is turned on by
+%% test_server_io:start_transaction/0 and off by calling
+%% test_server_io:end_transaction/0. The buffered data for the transaction
+%% can printed by calling test_server_io:print_buffered/1.
+%%
+%% This module is responsible for turning on IO buffering and to later
+%% test_server_io:print_buffered/1 to print the data. To help with this,
+%% two variables in the process dictionary are used:
+%% 'test_server_common_io_handler' and 'test_server_queued_io'. The values
+%% are set to as follwing:
+%%
+%% Value Meaning
+%% ----- -------
+%% undefined No parallel test cases running
+%% {tc,Pid} Running test cases in a top-level parallel group
+%% {Ref,Pid} Running sequential test case inside a parallel group
+%%
+%% FIXME: The Pid is no longer used.
%%
%% If a conf group nested under a parallel group in the test
%% specification should be started, the 'test_server_common_io_handler'
-%% value gets set also on the main process. This causes all printouts
-%% to common files - both from parallel test cases and from cases
-%% executed by the main process - to all end up as messages in the
-%% inbox of the main process.
+%% value gets set also on the main process.
%%
%% During execution of a parallel group (or of a group nested under a
%% parallel group), *any* new test case being started gets registered
%% in a list saved in the dictionary with 'test_server_queued_io' as key.
%% When the top level parallel group is finished (only then can we be
%% sure all parallel test cases have finished and "reported in"), the
-%% list of test cases is traversed in order and printout messages from
-%% each process - including the main process - are handled in turn. See
-%% handle_test_case_io_and_status/0 for details.
+%% list of test cases is traversed in order and test_server_io:print_buffered/1
+%% can be called for each test case. See handle_test_case_io_and_status/0
+%% for details.
%%
%% To be able to handle nested conf groups with different properties,
%% the Mode argument specifies a list of {Ref,Properties} tuples.
@@ -2612,16 +2367,15 @@ run_test_cases_loop([{auto_skip_case,{Type,Ref,Case,Comment},SkipMode}|Cases],
run_test_cases_loop([{auto_skip_case,{Case,Comment},SkipMode}|Cases],
Config, TimetrapData, Mode, Status) ->
- {Mod,Func} = skip_case(auto, undefined, get(test_server_case_num)+1, Case, Comment,
- (undefined /= get(test_server_common_io_handler)), SkipMode),
+ {Mod,Func} = skip_case(auto, undefined, get(test_server_case_num)+1,
+ Case, Comment, is_io_buffered(), SkipMode),
test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]),
run_test_cases_loop(Cases, Config, TimetrapData, Mode,
update_status(skipped, Mod, Func, Status));
run_test_cases_loop([{skip_case,{conf,Ref,Case,Comment}}|Cases0],
Config, TimetrapData, Mode, Status) ->
- {Mod,Func} = skip_case(user, Ref, 0, Case, Comment,
- (undefined /= get(test_server_common_io_handler))),
+ {Mod,Func} = skip_case(user, Ref, 0, Case, Comment, is_io_buffered()),
{Cases,Config1} =
case curr_ref(Mode) of
Ref ->
@@ -2637,8 +2391,8 @@ run_test_cases_loop([{skip_case,{conf,Ref,Case,Comment}}|Cases0],
run_test_cases_loop([{skip_case,{Case,Comment}}|Cases],
Config, TimetrapData, Mode, Status) ->
- {Mod,Func} = skip_case(user, undefined, get(test_server_case_num)+1, Case, Comment,
- (undefined /= get(test_server_common_io_handler))),
+ {Mod,Func} = skip_case(user, undefined, get(test_server_case_num)+1,
+ Case, Comment, is_io_buffered()),
test_server_sup:framework_call(report, [tc_user_skip,{?pl2a(Mod),Func,Comment}]),
run_test_cases_loop(Cases, Config, TimetrapData, Mode,
update_status(skipped, Mod, Func, Status));
@@ -2875,7 +2629,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
end,
CurrMode = curr_mode(Ref, Mode0, Mode),
- ConfCaseResult = run_test_case(Ref, 0, Mod, Func, [ActualCfg], skip_init, target,
+ ConfCaseResult = run_test_case(Ref, 0, Mod, Func, [ActualCfg], skip_init,
TimetrapData, CurrMode),
case ConfCaseResult of
@@ -2909,6 +2663,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
exit(framework_error);
{_,Fail,_} when element(1,Fail) == 'EXIT';
element(1,Fail) == timetrap_timeout;
+ element(1,Fail) == user_timetrap_error;
element(1,Fail) == failed ->
{Cases2,Config1,Status3} =
if StartConf ->
@@ -2928,14 +2683,6 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
set_io_buffering(IOHandler),
stop_minor_log_file(),
run_test_cases_loop(Cases2, Config1, TimetrapData, Mode, Status3);
- {died,Why,_} when Func == init_per_suite ->
- print(minor, "~n*** Unexpected exit during init_per_suite.~n", []),
- Reason = {failed,{Mod,init_per_suite,Why}},
- Cases2 = skip_cases_upto(Ref, Cases, Reason, conf, CurrMode),
- set_io_buffering(IOHandler),
- stop_minor_log_file(),
- run_test_cases_loop(Cases2, Config, TimetrapData, Mode,
- delete_status(Ref, Status2));
{_,{Skip,Reason},_} when StartConf and ((Skip==skip) or (Skip==skipped)) ->
ReportAbortRepeat(skipped),
print(minor, "~n*** ~p skipped.~n"
@@ -3006,7 +2753,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
end;
run_test_cases_loop([{make,Ref,{Mod,Func,Args}}|Cases0], Config, TimetrapData, Mode, Status) ->
- case run_test_case(Ref, 0, Mod, Func, Args, skip_init, host, TimetrapData) of
+ case run_test_case(Ref, 0, Mod, Func, Args, skip_init, TimetrapData) of
{_,Why={'EXIT',_},_} ->
print(minor, "~n*** ~p failed.~n"
" Skipping all cases.", [Func]),
@@ -3037,23 +2784,21 @@ run_test_cases_loop([{Mod,Case}|Cases], Config, TimetrapData, Mode, Status) ->
run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) ->
Num = put(test_server_case_num, get(test_server_case_num)+1),
+
%% check the current execution mode and save info about the case if
%% detected that printouts to common log files is handled later
- case check_prop(parallel, Mode) of
+
+ case check_prop(parallel, Mode) =:= false andalso is_io_buffered() of
+ true ->
+ %% sequential test case nested in a parallel group;
+ %% io is buffered, so we must queue this test case
+ queue_test_case_io(undefined, self(), Num+1, Mod, Func);
false ->
- case get(test_server_common_io_handler) of
- undefined ->
- %% io printouts are written to straight to file
- ok;
- _ ->
- %% io messages are buffered, put test case in queue
- queue_test_case_io(undefined, self(), Num+1, Mod, Func)
- end;
- _ ->
ok
end,
+
case run_test_case(undefined, Num+1, Mod, Func, Args,
- run_init, target, TimetrapData, Mode) of
+ run_init, TimetrapData, Mode) of
%% callback to framework module failed, exit immediately
{_,{framework_error,{FwMod,FwFunc},Reason},_} ->
print(minor, "~n*** ~p failed in ~p. Reason: ~p~n", [FwMod,FwFunc,Reason]),
@@ -3100,8 +2845,8 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status)
%% the test case is being executed in parallel with the main process (and
%% other test cases) and Pid is the dedicated process executing the case
Pid ->
- %% io from Pid will be buffered in the main process inbox and handled
- %% later, so we have to save info about the case
+ %% io from Pid will be buffered by the test_server_io process and
+ %% handled later, so we have to save info about the case
queue_test_case_io(undefined, Pid, Num+1, Mod, Func),
run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status)
end;
@@ -3208,11 +2953,17 @@ get_data_dir(Mod, Suite) ->
non_existing ->
print(12, "The module ~p is not loaded", [Mod]),
[];
+ cover_compiled ->
+ MainCoverNode = cover:get_main_node(),
+ {file,File} = rpc:call(MainCoverNode,cover,is_compiled,[UseMod]),
+ do_get_data_dir(UseMod,File);
FullPath ->
- filename:dirname(FullPath) ++ "/" ++ cast_to_list(UseMod) ++
- ?data_dir_suffix
+ do_get_data_dir(UseMod,FullPath)
end.
+do_get_data_dir(Mod,File) ->
+ filename:dirname(File) ++ "/" ++ cast_to_list(Mod) ++ ?data_dir_suffix.
+
print_conf_time(0) ->
ok;
print_conf_time(ConfTime) ->
@@ -3356,7 +3107,9 @@ skip_case(Type, Ref, CaseNum, Case, Comment, SendSync, Mode) ->
if SendSync ->
queue_test_case_io(Ref, self(), CaseNum, Mod, Func),
self() ! {started,Ref,self(),CaseNum,Mod,Func},
+ test_server_io:start_transaction(),
skip_case1(Type, CaseNum, Mod, Func, Comment, Mode),
+ test_server_io:end_transaction(),
self() ! {finished,Ref,self(),CaseNum,Mod,Func,skipped,{0,skipped,[]}};
not SendSync ->
skip_case1(Type, CaseNum, Mod, Func, Comment, Mode)
@@ -3497,13 +3250,20 @@ modify_cases_upto1(Ref, CopyOp, [C|T], Orig, Alt) ->
%%
%% Save info about current process (always the main process) buffering
%% io printout messages from parallel test case processes (*and* possibly
-%% also the main process). If the value is the default 'undefined',
-%% io is not buffered but printed directly to file (see print/3).
+%% also the main process).
set_io_buffering(IOHandler) ->
put(test_server_common_io_handler, IOHandler).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% is_io_buffered() -> true|false
+%%
+%% Test whether is being buffered.
+
+is_io_buffered() ->
+ get(test_server_common_io_handler) =/= undefined.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% queue_test_case_io(Pid, Num, Mod, Func) -> ok
%%
%% Save info about test case that gets its io buffered. This can
@@ -3550,7 +3310,7 @@ wait_and_resend(Ref, [{_,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) ->
receive
{finished,_Ref,CurrPid,CaseNum,Mod,Func,Result,_RetVal} = Msg ->
%% resend message to main process so that it can be used
- %% to handle buffered io messages later
+ %% to test_server_io:print_buffered/1 later
self() ! Msg,
MF = {Mod,Func},
{Ok1,Skip1,Fail1} =
@@ -3581,16 +3341,18 @@ rm_cases_upto(Ref, [_|Ps]) ->
%%
%% Each parallel test case process prints to its own minor log file during
%% execution. The common log files (major, html etc) must however be
-%% written to sequentially. The test case processes send print requests
-%% to the main (starting) process (the same process executing
-%% run_test_cases_loop/4), which handles these requests in the same
-%% order that the test case processes were started.
-%%
-%% An io session is always started with a {started,Ref,Pid,Num,Mod,Func}
-%% message and terminated with {finished,Ref,Pid,Num,Mod,Func,Result,RetVal}.
-%% The result shipped with the finished message from a parallel process
-%% is used to update status data of the current test run. An 'EXIT'
-%% message from each parallel test case process (after finishing and
+%% written to sequentially. This is handled by calling
+%% test_server_io:start_transaction/0 to tell the test_server_io process
+%% to buffer all print requests.
+%%
+%% An io session is always started with a
+%% {started,Ref,Pid,Num,Mod,Func} message (and
+%% test_server_io:start_transaction/0 will be called) and terminated
+%% with {finished,Ref,Pid,Num,Mod,Func,Result,RetVal} (and
+%% test_server_io:end_transaction/0 will be called). The result
+%% shipped with the finished message from a parallel process is used
+%% to update status data of the current test run. An 'EXIT' message
+%% from each parallel test case process (after finishing and
%% terminating) is also received and handled here.
%%
%% During execution of a parallel group, any cases (conf or normal)
@@ -3599,13 +3361,13 @@ rm_cases_upto(Ref, [_|Ps]) ->
%% correct sequence. This function handles also the print messages
%% generated by nested group cases that have been executed sequentially
%% by the main process (note that these cases do not generate 'EXIT'
-%% messages, only 'start', 'print' and 'finished' messages).
+%% messages, only 'start' and 'finished' messages).
%%
%% See the header comment for run_test_cases_loop/4 for more
%% info about IO handling.
%%
%% Note: It is important that the type of messages handled here
-%% do not get consumated by test_server:run_test_case_msgloop/5
+%% do not get consumed by test_server:run_test_case_msgloop/5
%% during the test case execution (e.g. in the catch clause of
%% the receive)!
@@ -3632,7 +3394,7 @@ handle_test_case_io_and_status() ->
%% Handle cases (without Ref) that belong to the top parallel group (i.e. when Refs = [])
handle_io_and_exit_loop([], [{undefined,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) ->
- %% retreive the start message for the current io session (= testcase)
+ %% retrieve the start message for the current io session (= testcase)
receive
{started,_,CurrPid,CaseNum,Mod,Func} ->
{Ok1,Skip1,Fail1} =
@@ -3672,11 +3434,18 @@ handle_io_and_exit_loop(_, [], Ok,Skip,Fail) ->
handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) ->
receive
+ {abort_current_testcase=Tag,_Reason,From} ->
+ %% If a parallel group is executing, there is no unique
+ %% current test case, so we must generate an error.
+ From ! {self(),Tag,{error,parallel_group}},
+ handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases);
%% end of io session from test case executed by main process
{finished,_,Main,CaseNum,Mod,Func,Result,_RetVal} ->
+ test_server_io:print_buffered(CurrPid),
{Result,{Mod,Func}};
%% end of io session from test case executed by parallel process
{finished,_,CurrPid,CaseNum,Mod,Func,Result,RetVal} ->
+ test_server_io:print_buffered(CurrPid),
case Result of
ok ->
put(test_server_ok, get(test_server_ok)+1);
@@ -3689,13 +3458,9 @@ handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) ->
end,
{Result,{Mod,Func}};
- %% print to common log file
- {print,CurrPid,Detail,Msg} ->
- output({Detail,Msg}, internal),
- handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases);
-
%% unexpected termination of test case process
{'EXIT',TCPid,Reason} when Reason /= normal ->
+ test_server_io:print_buffered(CurrPid),
{value,{_,_,Num,M,F}} = lists:keysearch(TCPid, 2, Cases),
print(1, "Error! Process for test case #~p (~p:~p) died! Reason: ~p",
[Num, M, F, Reason]),
@@ -3727,59 +3492,52 @@ handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) ->
%% RetVal is the result of executing the test case. It contains info
%% about the execution time and the return value of the test case function.
-run_test_case(Ref, Num, Mod, Func, Args, RunInit, Where, TimetrapData) ->
+run_test_case(Ref, Num, Mod, Func, Args, RunInit, TimetrapData) ->
file:set_cwd(filename:dirname(get(test_server_dir))),
- run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where,
- TimetrapData, [], [], self()).
+ run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
+ TimetrapData, [], self()).
-run_test_case(Ref, Num, Mod, Func, Args, skip_init, Where, TimetrapData, Mode) ->
+run_test_case(Ref, Num, Mod, Func, Args, skip_init, TimetrapData, Mode) ->
%% a conf case is always executed by the main process
- run_test_case1(Ref, Num, Mod, Func, Args, skip_init, Where,
- TimetrapData, [], Mode, self());
+ run_test_case1(Ref, Num, Mod, Func, Args, skip_init,
+ TimetrapData, Mode, self());
-run_test_case(Ref, Num, Mod, Func, Args, RunInit, Where, TimetrapData, Mode) ->
+run_test_case(Ref, Num, Mod, Func, Args, RunInit, TimetrapData, Mode) ->
file:set_cwd(filename:dirname(get(test_server_dir))),
+ Main = self(),
case check_prop(parallel, Mode) of
false ->
%% this is a sequential test case
- run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where,
- TimetrapData, [], Mode, self());
+ run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
+ TimetrapData, Mode, Main);
_Ref ->
%% this a parallel test case, spawn the new process
- Main = self(),
- {dictionary,State} = process_info(self(), dictionary),
- spawn_link(fun() ->
- run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where,
- TimetrapData, State, Mode, Main)
- end)
+ Dictionary = get(),
+ {dictionary,Dictionary} = process_info(self(), dictionary),
+ spawn_link(
+ fun() ->
+ process_flag(trap_exit, true),
+ [put(Key, Val) || {Key,Val} <- Dictionary],
+ set_io_buffering({tc,Main}),
+ run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
+ TimetrapData, Mode, Main)
+ end)
end.
-run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where,
- TimetrapData, State, Mode, Main) ->
- %% 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,
- do_if_parallel(Main, CopyDict, ok),
- do_if_parallel(Main, fun() ->
- put(test_server_common_io_handler, {tc,Main})
- end, ok),
+run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
+ TimetrapData, Mode, Main) ->
+ group_leader(test_server_io:get_gl(Main == self()), self()),
+
%% 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
- undefined -> ok;
- _ -> Main ! {started,Ref,self(),Num,Mod,Func}
+ case is_io_buffered() of
+ false -> ok;
+ true ->
+ test_server_io:start_transaction(),
+ Main ! {started,Ref,self(),Num,Mod,Func}
end,
TSDir = get(test_server_dir),
- case Where of
- target ->
- maybe_send_beam_and_datadir(Mod);
- host ->
- ok
- end,
+
print(major, "=case ~p:~p", [Mod, Func]),
MinorName = start_minor_log_file(Mod, Func),
print(minor, "<a name=\"top\"></a>", [], internal_raw),
@@ -3831,13 +3589,12 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where,
[num2str(Num),fw_name(Mod),GroupName,MinorBase,Func,
MinorBase,MinorBase]),
- do_if_parallel(Main, ok, fun erlang:yield/0),
+ do_unless_parallel(Main, 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, [UpdatedArgs], get_name(Mode),
- RunInit, Where, TimetrapData, RejectIoReqs),
+ RunInit, TimetrapData),
{Time,RetVal,Loc,Opts,Comment} =
case Result of
Normal={_Time,_RetVal,_Loc,_Opts,_Comment} -> Normal;
@@ -3849,7 +3606,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where,
print_timestamp(minor, "Ended at "),
print(major, "=ended ~s", [lists:flatten(timestamp_get(""))]),
- do_if_parallel(Main, ok, fun() -> file:set_cwd(filename:dirname(TSDir)) end),
+ do_unless_parallel(Main, fun() -> file:set_cwd(filename:dirname(TSDir)) end),
%% call the appropriate progress function clause to print the results to log
Status =
@@ -3954,14 +3711,17 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where,
true ->
ok
end,
- check_new_crash_dumps(Where),
+ test_server_sup:check_new_crash_dumps(),
%% if io is being buffered, send finished message
%% (no matter if case runs on parallel or main process)
- case get(test_server_common_io_handler) of
- undefined -> ok;
- _ -> Main ! {finished,Ref,self(),Num,Mod,Func,
- ?mod_result(Status),{Time,RetVal,Opts}}
+ case is_io_buffered() of
+ false ->
+ ok;
+ true ->
+ test_server_io:end_transaction(),
+ Main ! {finished,Ref,self(),Num,Mod,Func,
+ ?mod_result(Status),{Time,RetVal,Opts}}
end,
{Time,RetVal,Opts}.
@@ -3969,126 +3729,16 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where,
%%--------------------------------------------------------------------
%% various help functions
-%% Call If() if we're on parallel process, or
-%% call Else() if we're on main process
-do_if_parallel(Pid, If, Else) ->
+%% Call Action if we are running on the main process (not parallel).
+do_unless_parallel(Main, Action) when is_function(Action, 0) ->
case self() of
- Pid ->
- if is_function(Else) -> Else();
- true -> Else
- end;
- _ ->
- if is_function(If) -> If();
- true -> If
- end
+ Main -> Action();
+ _ -> ok
end.
num2str(0) -> "";
num2str(N) -> integer_to_list(N).
-%% If remote target, this function sends the test suite (if not already sent)
-%% and the content of datadir til target.
-maybe_send_beam_and_datadir(Mod) ->
- case get(test_server_ctrl_job_sock) of
- undefined ->
- %% local target
- ok;
- JobSock ->
- %% remote target
- case get(test_server_downloaded_suites) of
- undefined ->
- send_beam_and_datadir(Mod, JobSock),
- put(test_server_downloaded_suites, [Mod]);
- Suites ->
- case lists:member(Mod, Suites) of
- false ->
- send_beam_and_datadir(Mod, JobSock),
- put(test_server_downloaded_suites, [Mod|Suites]);
- true ->
- ok
- end
- end
- end.
-
-send_beam_and_datadir(Mod, JobSock) ->
- case code:which(Mod) of
- non_existing ->
- io:format("** WARNING: Suite ~w could not be found on host\n",
- [Mod]);
- BeamFile ->
- send_beam(JobSock, Mod, BeamFile)
- end,
- DataDir = get_data_dir(Mod),
- case file:read_file_info(DataDir) of
- {ok,_I} ->
- {ok,All} = file:list_dir(DataDir),
- AddTarFiles =
- case controller_call(get_target_info) of
- #target_info{os_family=ose} ->
- ObjExt = code:objfile_extension(),
- Wc = filename:join(DataDir, "*" ++ ObjExt),
- ModsInDatadir = filelib:wildcard(Wc),
- SendBeamFun = fun(X) -> send_beam(JobSock, X) end,
- lists:foreach(SendBeamFun, ModsInDatadir),
- %% No need to send C code or makefiles since
- %% no compilation can be done on target anyway.
- %% Compiled C code must exist on target.
- %% Beam files are already sent as binaries.
- %% Erlang source are sent in case the test case
- %% is to compile it.
- Filter = fun("Makefile") -> false;
- ("Makefile.src") -> false;
- (Y) ->
- case filename:extension(Y) of
- ".c" -> false;
- ObjExt -> false;
- _ -> true
- end
- end,
- lists:filter(Filter, All);
- _ ->
- All
- end,
- Tarfile = "data_dir.tar.gz",
- {ok,Tar} = erl_tar:open(Tarfile, [write,compressed]),
- ShortDataDir = filename:basename(DataDir),
- AddTarFun =
- fun(File) ->
- Long = filename:join(DataDir, File),
- Short = filename:join(ShortDataDir, File),
- ok = erl_tar:add(Tar, Long, Short, [])
- end,
- lists:foreach(AddTarFun, AddTarFiles),
- ok = erl_tar:close(Tar),
- {ok,TarBin} = file:read_file(Tarfile),
- file:delete(Tarfile),
- request(JobSock, {{datadir,Tarfile}, TarBin});
- {error,_R} ->
- ok
- end.
-
-send_beam(JobSock, BeamFile) ->
- Mod=filename:rootname(filename:basename(BeamFile), code:objfile_extension()),
- send_beam(JobSock, list_to_atom(Mod), BeamFile).
-send_beam(JobSock, Mod, BeamFile) ->
- {ok,BeamBin} = file:read_file(BeamFile),
- request(JobSock, {{beam,Mod,BeamFile}, BeamBin}).
-
-check_new_crash_dumps(Where) ->
- case Where of
- target ->
- case get(test_server_ctrl_job_sock) of
- undefined ->
- ok;
- Socket ->
- read_job_sock_loop(Socket)
- end;
- _ ->
- ok
- end,
- test_server_sup:check_new_crash_dumps().
-
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% progress(Result, CaseNum, Mod, Func, Location, Reason, Time,
%% Comment, TimeFormat) -> Result
@@ -4456,11 +4106,10 @@ do_format_exception(Reason={Error,Stack}) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit,
-%% Where, TimetrapData, RejectIoReqs) ->
+%% TimetrapData) ->
%% {{Time,RetVal,Loc,Opts,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} |
%% {{died,Reason,unknown,Comment},DetectedFail,ProcessesBefore,ProcessesAfter}
%% Name = atom()
-%% Where = target | host
%% Time = float() (seconds)
%% RetVal = term()
%% Loc = term()
@@ -4475,23 +4124,10 @@ 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, RejectIoReqs) ->
+run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit,
+ TimetrapData) ->
test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,
- 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,RejectIoReqs});
- JobSock ->
- %% remote target
- request(JobSock, {test_case,{CaseNum,Mod,Func,Args,Name,RunInit,
- TimetrapData,RejectIoReqs}}),
- read_job_sock_loop(JobSock)
- end.
+ TimetrapData}).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% print(Detail, Format, Args) -> ok
@@ -4501,16 +4137,6 @@ run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, target,
%%
%% Just like io:format, except that depending on the Detail value, the output
%% is directed to console, major and/or minor log files.
-%%
-%% To handle printouts to common (not minor) log files from parallel test
-%% case processes, the test_server_common_io_handler value is checked. If
-%% set, the data is sent to the main controlling process. Note that test
-%% cases that belong to a conf group nested under a parallel group will also
-%% get its io data sent to main rather than immediately printed out, even
-%% if the test cases are executed by the same, main, process (ie the main
-%% process sends messages to itself then).
-%%
-%% Buffered io is handled by the handle_test_case_io_and_status/0 function.
print(Detail, Format) ->
print(Detail, Format, []).
@@ -4523,19 +4149,7 @@ print(Detail, Format, Args, Printer) ->
print_or_buffer(Detail, Msg, Printer).
print_or_buffer(Detail, Msg, Printer) ->
- case get(test_server_minor_level) of
- _ when Detail == minor ->
- output({Detail,Msg}, Printer);
- MinLevel when is_number(Detail), Detail >= MinLevel ->
- output({Detail,Msg}, Printer);
- _ -> % Detail < Minor | major | html
- case get(test_server_common_io_handler) of
- undefined ->
- output({Detail,Msg}, Printer);
- {_,MainPid} ->
- MainPid ! {print,self(),Detail,Msg}
- end
- end.
+ test_server_gl:print(group_leader(), Detail, Msg, Printer).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% print_timestamp(Detail, Leader) -> ok
@@ -4599,112 +4213,6 @@ format(Detail, Format, Args) ->
print_or_buffer(Detail, Str, self()).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% output({Level,Message}, Sender) -> ok
-%% Level = integer() | minor | major | html
-%% Message = string() | [integer()]
-%% Sender = string() | internal
-%%
-%% Outputs the message on the channels indicated by Level. If Level is an
-%% atom, only the corresponding channel receives the output. When Level is
-%% an integer console, major and/or minor log file will receive output
-%% depending on the user set thresholds (see get_levels/0, set_levels/3)
-%%
-%% When printing on the console, the message is prefixed with the test
-%% suite's name. In case a name is not set (yet), Sender is used.
-%%
-%% When not outputting to the console, and the Sender is 'internal',
-%% the message is prefixed with "=== ", so that it will be apparent that
-%% the message comes from the test server and not the test suite itself.
-
-output({Level,Msg}, Sender) when is_integer(Level) ->
- SumLev = get(test_server_summary_level),
- if Level =< SumLev ->
- output_to_fd(stdout, Msg, Sender);
- true ->
- ok
- end,
- MajLev = get(test_server_major_level),
- if Level =< MajLev ->
- output_to_fd(get(test_server_major_fd), Msg, Sender);
- true ->
- ok
- end,
- MinLev = get(test_server_minor_level),
- if Level >= MinLev ->
- output_to_fd(get(test_server_minor_fd), Msg, Sender);
- true ->
- ok
- end;
-output({minor,Bytes}, Sender) when is_list(Bytes) ->
- output_to_fd(get(test_server_minor_fd), Bytes, Sender);
-output({major,Bytes}, Sender) when is_list(Bytes) ->
- output_to_fd(get(test_server_major_fd), Bytes, Sender);
-output({minor,Bytes}, Sender) when is_binary(Bytes) ->
- output_to_fd(get(test_server_minor_fd),binary_to_list(Bytes), Sender);
-output({major,Bytes}, Sender) when is_binary(Bytes) ->
- output_to_fd(get(test_server_major_fd),binary_to_list(Bytes), Sender);
-output({html,Msg}, _Sender) ->
- case get(test_server_html_fd) of
- undefined ->
- ok;
- Fd ->
- io:put_chars(Fd,Msg),
- case file:position(Fd, {cur, 0}) of
- {ok, Pos} ->
- %% We are writing to a seekable file. Finalise so
- %% we get complete valid (and viewable) HTML code.
- %% Then rewind to overwrite the finalising code.
- io:put_chars(Fd, "\n</table>\n"),
- case get(test_server_html_footer) of
- undefined ->
- io:put_chars(Fd, "</body>\n</html>\n");
- Footer ->
- io:put_chars(Fd, Footer)
- end,
- file:position(Fd, Pos);
- {error, epipe} ->
- %% The file is not seekable. We cannot erase what
- %% we've already written --- so the reader will
- %% have to wait until we're done.
- ok
- end
- end;
-output({minor,Data}, Sender) ->
- output_to_fd(get(test_server_minor_fd),
- lists:flatten(io_lib:format(
- "Unexpected output: ~p~n", [Data])),Sender);
-output({major,Data}, Sender) ->
- output_to_fd(get(test_server_major_fd),
- lists:flatten(io_lib:format(
- "Unexpected output: ~p~n", [Data])),Sender).
-
-output_to_fd(stdout, Msg, Sender) ->
- Name =
- case get(test_server_name) of
- undefined -> Sender;
- Other -> Other
- end,
- 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, [$=,$=,$=,$ ]),
- io:put_chars(Fd, Msg),
- io:put_chars(Fd, "\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")
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% xhtml(BasicHtml, XHtml) -> BasicHtml | XHtml
%%
xhtml(HTML, XHTML) ->
@@ -5216,7 +4724,7 @@ get_target_info() ->
%% Called by test_server. See test_server:start_node/3 for details
start_node(Name, Type, Options) ->
- T = 10 * ?ACCEPT_TIMEOUT, % give some extra time
+ T = 10 * ?ACCEPT_TIMEOUT * test_server:timetrap_scale_factor(),
format(minor, "Attempt to start ~w node ~p with options ~p",
[Type, Name, Options]),
case controller_call({start_node,Name,Type,Options}, T) of
@@ -5261,7 +4769,8 @@ start_node(Name, Type, Options) ->
%% when the new node has contacted test_server_ctrl again
wait_for_node(Slave) ->
- case catch controller_call({wait_for_node,Slave},10000) of
+ T = 10000 * test_server:timetrap_scale_factor(),
+ case catch controller_call({wait_for_node,Slave},T) of
{'EXIT',{timeout,_}} -> {error,timeout};
ok -> ok
end.
@@ -5285,60 +4794,6 @@ stop_node(Slave) ->
controller_call({stop_node,Slave}).
-%%--------------------------------------------------------------------
-%% Functions handling target communication over socket
-
-%% Generic send function for communication with target
-request(Sock,Request) ->
- gen_tcp:send(Sock,<<1,(term_to_binary(Request))/binary>>).
-
-%% Receive and decode request on job specific socket
-%% Used when test is running on a remote target
-read_job_sock_loop(Sock) ->
- case gen_tcp:recv(Sock,0) of
- {error,Reason} ->
- gen_tcp:close(Sock),
- exit({controller,connection_lost,Reason});
- {ok,<<1,Request/binary>>} ->
- case decode(binary_to_term(Request)) of
- ok ->
- read_job_sock_loop(Sock);
- {stop,Result} ->
- Result
- end
- end.
-
-decode({apply,{M,F,A}}) ->
- apply(M,F,A),
- ok;
-decode({sync_apply,{M,F,A}}) ->
- R = apply(M,F,A),
- request(get(test_server_ctrl_job_sock),{sync_result,R}),
- ok;
-decode({sync_result,Result}) ->
- {stop,Result};
-decode({test_case_result,Result}) ->
- {stop,Result};
-decode({privdir,empty_priv_dir}) ->
- {stop,ok};
-decode({{privdir,PrivDirTar},TarBin}) ->
- Root = get(test_server_log_dir_base),
- unpack_tar(Root,PrivDirTar,TarBin),
- {stop,ok};
-decode({crash_dumps,no_crash_dumps}) ->
- {stop,ok};
-decode({{crash_dumps,CrashDumpTar},TarBin}) ->
- Dir = test_server_sup:crash_dump_dir(),
- unpack_tar(Dir,CrashDumpTar,TarBin),
- {stop,ok}.
-
-unpack_tar(Dir,TarFileName0,TarBin) ->
- TarFileName = filename:join(Dir,TarFileName0),
- ok = file:write_file(TarFileName,TarBin),
- ok = erl_tar:extract(TarFileName,[compressed,{cwd,Dir}]),
- ok = file:delete(TarFileName).
-
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% DEBUGGER INTERFACE %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -5483,16 +4938,7 @@ cover_compile({App,CoverFile}) ->
cover_compile1({App,Exclude,Include,Cross}).
cover_compile1(What) ->
- case get(test_server_ctrl_job_sock) of
- undefined ->
- %% local target
- test_server:cover_compile(What);
- JobSock ->
- %% remote target
- request(JobSock, {sync_apply,{test_server,cover_compile,[What]}}),
- read_job_sock_loop(JobSock)
- end.
-
+ test_server:cover_compile(What).
%% Read the coverfile for an application and return a list of modules
%% that are members of the application but shall not be compiled
@@ -5544,7 +4990,7 @@ check_cover_file([], Exclude, Include) ->
%%
%% This per application analysis writes the file cover.html in the
%% application's run.<timestamp> directory.
-cover_analyse({App,CoverInfo}, Analyse, AnalyseMods, TestDir) ->
+cover_analyse({App,CoverInfo}, Analyse, AnalyseMods, Stop, TestDir) ->
write_default_cross_coverlog(TestDir),
{ok,CoverLog} = file:open(filename:join(TestDir, ?coverlog_name), [write]),
@@ -5575,7 +5021,7 @@ cover_analyse({App,CoverInfo}, Analyse, AnalyseMods, TestDir) ->
io:fwrite(CoverLog, "<p>Excluded module(s): <code>~p</code>\n", [Excluded]),
- Coverage = cover_analyse(Analyse, AnalyseMods),
+ Coverage = cover_analyse(Analyse, AnalyseMods, Stop),
case lists:filter(fun({_M,{_,_,_}}) -> false;
(_) -> true
@@ -5592,32 +5038,27 @@ cover_analyse({App,CoverInfo}, Analyse, AnalyseMods, TestDir) ->
file:write_file(filename:join(TestDir, ?cover_total),
term_to_binary(TotPercent)).
-cover_analyse(Analyse, AnalyseMods) ->
+cover_analyse(Analyse, AnalyseMods, Stop) ->
TestDir = get(test_server_log_dir_base),
- case get(test_server_ctrl_job_sock) of
- undefined ->
- %% local target
- test_server:cover_analyse({Analyse,TestDir}, AnalyseMods);
- JobSock ->
- %% remote target
- request(JobSock, {sync_apply,{test_server,
- cover_analyse,
- [Analyse,AnalyseMods]}}),
- read_job_sock_loop(JobSock)
- end.
+ test_server:cover_analyse({Analyse,TestDir}, AnalyseMods, Stop).
%% Cover analysis, cross application
%% This can be executed on any node after all tests are finished.
-%% The node's current directory must be the same as when the tests
-%% were run.
-cross_cover_analyse(Analyse) ->
- cross_cover_analyse(Analyse, undefined).
-
-cross_cover_analyse(Analyse, CrossModules) ->
- CoverdataFiles = get_coverdata_files(),
+%% Apps = [{App,Dir}]
+%% App = atom(), application name
+%% Dir = string(), the log directory for App, normally where
+%% run.<timestamp> is found.
+%% Modules = [atom()], modules that have been cover compiled during tests
+%% of other apps than the one they belong to.
+cross_cover_analyse(Analyse, Apps) ->
+ cross_cover_analyse(Analyse, Apps, get_cross_modules()).
+cross_cover_analyse(Analyse, Apps, Modules) ->
+ Apps1 = get_latest_run_dirs(Apps),
+ Apps2 = add_cross_modules(Modules,Apps1),
+ CoverdataFiles = get_coverdata_files(Apps2),
lists:foreach(fun(CDF) -> cover:import(CDF) end, CoverdataFiles),
- io:fwrite("Cover analysing... ", []),
+ io:fwrite("Cover analysing...\n", []),
DetailsFun =
case Analyse of
details ->
@@ -5631,25 +5072,15 @@ cross_cover_analyse(Analyse, CrossModules) ->
_ ->
fun(_,_) -> undefined end
end,
- SortedModules =
- case CrossModules of
- undefined ->
- sort_modules([Mod || Mod <- get_all_cross_modules(),
- lists:member(Mod, cover:imported_modules())], []);
- _ ->
- sort_modules(CrossModules, [])
- end,
- Coverage = analyse_apps(SortedModules, DetailsFun, []),
+ Coverage = analyse_apps(Apps2, DetailsFun, []),
cover:stop(),
- write_cross_cover_logs(Coverage).
+ write_cross_cover_logs(Coverage,Apps2).
-%% For each application from which there are modules listed in the
-%% cross.cover, write a cross cover log (cross_cover.html).
-write_cross_cover_logs([{App,Coverage}|T]) ->
- case last_test_for_app(App) of
- false ->
- ok;
- Dir ->
+%% For each application from which there are cross cover analysed
+%% modules, write a cross cover log (cross_cover.html).
+write_cross_cover_logs([{App,Coverage}|T],Apps) ->
+ case lists:keyfind(App,1,Apps) of
+ {_,Dir,Mods} when Mods=/=[] ->
CoverLogName = filename:join(Dir,?cross_coverlog_name),
{ok,CoverLog} = file:open(CoverLogName, [write]),
write_coverlog_header(CoverLog),
@@ -5657,54 +5088,51 @@ write_cross_cover_logs([{App,Coverage}|T]) ->
"<h1>Coverage results for \'~w\' from all tests</h1>\n",
[App]),
write_cover_result_table(CoverLog, Coverage),
- io:fwrite("Written file ~p\n", [CoverLogName])
+ io:fwrite("Written file ~p\n", [CoverLogName]);
+ _ ->
+ ok
end,
- write_cross_cover_logs(T);
-write_cross_cover_logs([]) ->
+ write_cross_cover_logs(T,Apps);
+write_cross_cover_logs([],_) ->
io:fwrite("done\n", []).
-%% Find all exported coverdata files. First find all the latest
-%% run.<timestamp> directories, and the check if there is a file named
-%% all.coverdata.
-get_coverdata_files() ->
- PossibleFiles = [last_coverdata_file(Dir) ||
- Dir <- filelib:wildcard([$*|?logdir_ext]),
- filelib:is_dir(Dir)],
- [File || File <- PossibleFiles, filelib:is_file(File)].
-
-last_coverdata_file(Dir) ->
- LastDir = last_test(filelib:wildcard(filename:join(Dir,"run.[1-2]*")),false),
- filename:join(LastDir,"all.coverdata").
-
-
-%% Find the latest run.<timestamp> directory for the given application.
-last_test_for_app(App) ->
- AppLogDir = atom_to_list(App)++?logdir_ext,
- last_test(filelib:wildcard(filename:join(AppLogDir,"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) ->
+%% Get the latest run.<timestamp> directories
+get_latest_run_dirs([{App,Dir}|Apps]) ->
+ [{App,get_latest_run_dir(Dir)} | get_latest_run_dirs(Apps)];
+get_latest_run_dirs([]) ->
+ [].
+
+get_latest_run_dir(Dir) ->
+ case filelib:wildcard(filename:join(Dir,"run.[1-2]*")) of
+ [] ->
+ Dir;
+ [H|T] ->
+ get_latest_dir(T,H)
+ end.
+
+get_latest_dir([H|T],Latest) when H>Latest ->
+ get_latest_dir(T,H);
+get_latest_dir([_|T],Latest) ->
+ get_latest_dir(T,Latest);
+get_latest_dir([],Latest) ->
Latest.
-%% Sort modules according to the application they belong to.
-%% Return [{App,LastTestDir,ModuleList}]
-sort_modules([M|Modules], Acc) ->
- App = get_app(M),
- Acc1 =
- case lists:keysearch(App, 1, Acc) of
- {value,{App,LastTest,List}} ->
- lists:keyreplace(App, 1, Acc, {App,LastTest,[M|List]});
+%% Associate the cross cover modules with their applications.
+add_cross_modules(Mods,Apps)->
+ do_add_cross_modules(Mods,[{App,Dir,[]} || {App,Dir} <- Apps]).
+do_add_cross_modules([Mod|Mods],Apps)->
+ App = get_app(Mod),
+ NewApps =
+ case lists:keytake(App,1,Apps) of
+ {value,{App,Dir,AppMods},Rest} ->
+ [{App,Dir,lists:umerge([Mod],AppMods)}|Rest];
false ->
- [{App,last_test_for_app(App),[M]}|Acc]
+ Apps
end,
- sort_modules(Modules, Acc1);
-sort_modules([], Acc) ->
- Acc.
+ do_add_cross_modules(Mods,NewApps);
+do_add_cross_modules([],Apps) ->
+ %% Just to get the modules in the same order as app-only cover log
+ [{App,Dir,lists:reverse(Mods)} || {App,Dir,Mods} <- Apps].
get_app(Module) ->
Beam = code:which(Module),
@@ -5712,6 +5140,14 @@ get_app(Module) ->
[AppStr|_] = string:tokens(AppDir,"-"),
list_to_atom(AppStr).
+%% Find all exported coverdata files.
+get_coverdata_files(Apps) ->
+ lists:flatmap(
+ fun({_,LatestAppDir,_}) ->
+ filelib:wildcard(filename:join(LatestAppDir,"all.coverdata"))
+ end,
+ Apps).
+
%% For each application, analyse all modules
%% Used for cross cover analysis.
@@ -5732,7 +5168,7 @@ analyse_modules(_Dir, [], _DetailsFun, Acc) ->
%% Read the cross cover file (cross.cover)
-get_all_cross_modules() ->
+get_cross_modules() ->
get_cross_modules(all).
get_cross_modules(App) ->
case file:consult(?cross_cover_file) of
@@ -5835,11 +5271,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_gl.erl b/lib/test_server/src/test_server_gl.erl
new file mode 100644
index 0000000000..d32c7c07dc
--- /dev/null
+++ b/lib/test_server/src/test_server_gl.erl
@@ -0,0 +1,293 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 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%
+%%
+%% This module implements group leader processes for test cases.
+%% Each group leader process handles output to the minor log file for
+%% a test case, and calls test_server_io to handle output to the common
+%% log files. The group leader processes are created and destroyed
+%% through the test_server_io module/process.
+
+-module(test_server_gl).
+-export([start_link/0,stop/1,set_minor_fd/3,unset_minor_fd/1,
+ get_tc_supervisor/1,print/4,set_props/2]).
+
+-export([init/1,handle_call/3,handle_cast/2,handle_info/2,terminate/2]).
+
+-record(st, {tc_supervisor :: 'none'|pid(), %Test case supervisor
+ tc :: mfa(), %Current test case MFA
+ minor :: 'none'|pid(), %Minor fd
+ minor_monitor, %Monitor ref for minor fd
+ capture :: 'none'|pid(), %Capture output
+ reject_io :: boolean(), %Reject I/O requests...
+ permit_io, %... and exceptions
+ auto_nl=true :: boolean(), %Automatically add NL
+ levels %{Stdout,Major,Minor}
+ }).
+
+%% start_link()
+%% Start a new group leader process. Only to be called by
+%% the test_server_io process.
+
+start_link() ->
+ case gen_server:start_link(?MODULE, [], []) of
+ {ok,Pid} ->
+ {ok,Pid};
+ Other ->
+ Other
+ end.
+
+
+%% stop(Pid)
+%% Stop a group leader process. Only to be called by
+%% the test_server_io process.
+
+stop(GL) ->
+ gen_server:cast(GL, stop).
+
+
+%% set_minor_fd(GL, Fd, MFA)
+%% GL = Pid for the group leader process
+%% Fd = file descriptor for the minor log file
+%% MFA = {M,F,A} for the test case owning the minor log file
+%%
+%% Register the file descriptor for the minor log file. Subsequent
+%% IO directed to the minor log file will be written to this file.
+%% Also register the currently executing process at the testcase
+%% supervisor corresponding to this group leader process.
+
+set_minor_fd(GL, Fd, MFA) ->
+ req(GL, {set_minor_fd,Fd,MFA,self()}).
+
+
+%% unset_minor_fd(GL, Fd, MFA)
+%% GL = Pid for the group leader process
+%%
+%% Unregister the file descriptor for minor log file (typically
+%% because the test case has ended the minor log file is about
+%% to be closed). Subsequent IO (for example, by a process spawned
+%% by the testcase process) will go to the unexpected_io log file.
+
+unset_minor_fd(GL) ->
+ req(GL, unset_minor_fd).
+
+
+%% get_tc_supervisor(GL)
+%% GL = Pid for the group leader process
+%%
+%% Return the Pid for the process that supervises the test case
+%% that has this group leader.
+
+get_tc_supervisor(GL) ->
+ req(GL, get_tc_supervisor).
+
+
+%% print(GL, Detail, Format, Args) -> ok
+%% GL = Pid for the group leader process
+%% Detail = integer() | minor | major | html | stdout
+%% Msg = iodata()
+%% Printer = internal | pid()
+%%
+%% Print a message to one of the log files. If Detail is an integer,
+%% it will be compared to the levels (set by set_props/2) to
+%% determine which log file(s) that are to receive the output. If
+%% Detail is an atom, the value of the atom will directly determine
+%% which log file to use. IO to the minor log file will be handled
+%% directly by this group leader process (printing to the file set by
+%% set_minor_fd/3), and all other IO will be handled by calling
+%% test_server_io:print/3.
+
+print(GL, Detail, Msg, Printer) ->
+ req(GL, {print,Detail,Msg,Printer}).
+
+
+%% set_props(GL, [PropertyTuple])
+%% GL = Pid for the group leader process
+%% PropertyTuple = {levels,{Show,Major,Minor}} |
+%% {auto_nl,boolean()} |
+%% {reject_io_reqs,boolean()}
+%%
+%% Set properties for this group leader process.
+
+set_props(GL, PropList) ->
+ req(GL, {set_props,PropList}).
+
+%%% Internal functions.
+
+init([]) ->
+ {ok,#st{tc_supervisor=none,
+ minor=none,
+ minor_monitor=none,
+ capture=none,
+ reject_io=false,
+ permit_io=gb_sets:empty(),
+ auto_nl=true,
+ levels={1,19,10}
+ }}.
+
+req(GL, Req) ->
+ gen_server:call(GL, Req, infinity).
+
+handle_call(get_tc_supervisor, _From, #st{tc_supervisor=Pid}=St) ->
+ {reply,Pid,St};
+handle_call({set_minor_fd,Fd,MFA,Supervisor}, _From, St) ->
+ Ref = erlang:monitor(process, Fd),
+ {reply,ok,St#st{tc=MFA,minor=Fd,minor_monitor=Ref,
+ tc_supervisor=Supervisor}};
+handle_call(unset_minor_fd, _From, St) ->
+ {reply,ok,St#st{minor=none,tc_supervisor=none}};
+handle_call({set_props,PropList}, _From, St) ->
+ {reply,ok,do_set_props(PropList, St)};
+handle_call({print,Detail,Msg,Printer}, {From,_}, St) ->
+ output(Detail, Msg, Printer, From, St),
+ {reply,ok,St}.
+
+handle_cast(stop, St) ->
+ {stop,normal,St}.
+
+handle_info({'DOWN',Ref,process,_,_}, #st{minor_monitor=Ref}=St) ->
+ {noreply,St#st{minor=none,minor_monitor=none}};
+handle_info({permit_io,Pid}, #st{permit_io=P}=St) ->
+ {noreply,St#st{permit_io=gb_sets:add(Pid, P)}};
+handle_info({capture,Cap0}, St) ->
+ Cap = case Cap0 of
+ false -> none;
+ Pid when is_pid(Cap0) -> Pid
+ end,
+ {noreply,St#st{capture=Cap}};
+handle_info({io_request,From,ReplyAs,Req}=IoReq, St) ->
+ try io_req(Req, From, St) of
+ passthrough ->
+ group_leader() ! IoReq;
+ Data ->
+ case is_io_permitted(From, St) of
+ false ->
+ ok;
+ true ->
+ case St of
+ #st{capture=none} ->
+ ok;
+ #st{capture=CapturePid} ->
+ CapturePid ! {captured,Data}
+ end,
+ output(minor, Data, From, From, St)
+ end,
+ From ! {io_reply,ReplyAs,ok}
+ catch
+ _:_ ->
+ {io_reply,ReplyAs,{error,arguments}}
+ end,
+ {noreply,St};
+handle_info({structured_io,ClientPid,{Detail,Str}}, St) ->
+ output(Detail, Str, ClientPid, ClientPid, St),
+ {noreply,St};
+handle_info({printout,Detail,Format,Args}, St) ->
+ Str = io_lib:format(Format, Args),
+ output(Detail, Str, internal, none, St),
+ {noreply,St};
+handle_info(Msg, #st{tc_supervisor=Pid}=St) when is_pid(Pid) ->
+ %% The process overseeing the testcase process also used to be
+ %% the group leader; thus, it is widely expected that it can be
+ %% reached by sending a message to the group leader. Therefore
+ %% we'll need to forward any non-recognized messaged to the test
+ %% case supervisor.
+ Pid ! Msg,
+ {noreply,St};
+handle_info(_Msg, #st{}=St) ->
+ %% There is no known supervisor process. Ignore this message.
+ {noreply,St}.
+
+terminate(_, _) ->
+ ok.
+
+do_set_props([{levels,Levels}|Ps], St) ->
+ do_set_props(Ps, St#st{levels=Levels});
+do_set_props([{auto_nl,AutoNL}|Ps], St) ->
+ do_set_props(Ps, St#st{auto_nl=AutoNL});
+do_set_props([{reject_io_reqs,Bool}|Ps], St) ->
+ do_set_props(Ps, St#st{reject_io=Bool});
+do_set_props([], St) -> St.
+
+io_req({put_chars,Enc,Bytes}, _, _) when Enc =:= latin1; Enc =:= unicode ->
+ to_latin1(Enc, Bytes);
+io_req({put_chars,Encoding,Mod,Func,[Format,Args]}, _, _) ->
+ Str = Mod:Func(Format, Args),
+ to_latin1(Encoding, Str);
+io_req(_, _, _) -> passthrough.
+
+to_latin1(unicode, Str) ->
+ [if C > 255 ->
+ io_lib:format("\\{~.8B}", [C]);
+ true ->
+ C
+ end || C <- unicode:characters_to_list(Str, unicode)];
+to_latin1(latin1, Str) -> Str.
+
+output(Level, Str, Sender, From, St) when is_integer(Level) ->
+ case selected_by_level(Level, stdout, St) of
+ true -> output(stdout, Str, Sender, From, St);
+ false -> ok
+ end,
+ case selected_by_level(Level, major, St) of
+ true -> output(major, Str, Sender, From, St);
+ false -> ok
+ end,
+ case selected_by_level(Level, minor, St) of
+ true -> output(minor, Str, Sender, From, St);
+ false -> ok
+ end;
+output(stdout, Str, _Sender, From, St) ->
+ output_to_file(stdout, Str, From, St);
+output(html, Str, _Sender, From, St) ->
+ output_to_file(html, Str, From, St);
+output(Level, Str, Sender, From, St) when is_atom(Level) ->
+ output_to_file(Level, dress_output(Str, Sender, St), From, St).
+
+output_to_file(minor, Data0, From, #st{tc={M,F,A},minor=none}) ->
+ Data = [io_lib:format("=== ~p:~p/~p\n", [M,F,A]),Data0],
+ test_server_io:print(From, unexpected_io, Data),
+ ok;
+output_to_file(minor, Data, From, #st{minor=Fd}) ->
+ try
+ io:put_chars(Fd, Data)
+ catch
+ _:_ ->
+ test_server_io:print(From, unexpected_io, Data)
+ end;
+output_to_file(Detail, Data, From, _) ->
+ test_server_io:print(From, Detail, Data).
+
+is_io_permitted(From, #st{reject_io=true,permit_io=P}) ->
+ gb_sets:is_member(From, P);
+is_io_permitted(_, #st{reject_io=false}) -> true.
+
+selected_by_level(Level, stdout, #st{levels={Stdout,_,_}}) ->
+ Level =< Stdout;
+selected_by_level(Level, major, #st{levels={_,Major,_}}) ->
+ Level =< Major;
+selected_by_level(Level, minor, #st{levels={_,_,Minor}}) ->
+ Level >= Minor.
+
+dress_output([$=|_]=Str, internal, _) ->
+ [Str,$\n];
+dress_output(Str, internal, _) ->
+ ["=== ",Str,$\n];
+dress_output(Str, _, #st{auto_nl=AutoNL}) ->
+ case AutoNL of
+ true -> [Str,$\n];
+ false -> Str
+ end.
diff --git a/lib/test_server/src/test_server_internal.hrl b/lib/test_server/src/test_server_internal.hrl
index c9c52854e3..d204c35293 100644
--- a/lib/test_server/src/test_server_internal.hrl
+++ b/lib/test_server/src/test_server_internal.hrl
@@ -24,8 +24,7 @@
%% Target information generated by test_server:init_target_info/0 and
%% 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
+-record(target_info, {os_family, % atom(); win32 | unix
os_type, % result of os:type()
host, % string(); the name of the target machine
version, % string()
@@ -43,7 +42,6 @@
% itself is master for slave nodes
%% The following are only used for remote targets
- target_client, % reference to a client talking to target
slave_targets=[]}).% list() of atom(); all available
% targets for starting slavenodes
diff --git a/lib/test_server/src/test_server_io.erl b/lib/test_server/src/test_server_io.erl
new file mode 100644
index 0000000000..e960b3087a
--- /dev/null
+++ b/lib/test_server/src/test_server_io.erl
@@ -0,0 +1,317 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 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%
+%%
+%% This module implements a process with the registered name 'test_server_io',
+%% which has two main responsibilities:
+%%
+%% * Manage group leader processes (see the test_server_gl module)
+%% for test cases. A group_leader process is obtained by calling
+%% get_gl/1. Group leader processes will be kept alive as along as
+%% the 'test_server_io' process is alive.
+%%
+%% * Handle output to the common log files (stdout, major, html,
+%% unexpected_io).
+%%
+
+-module(test_server_io).
+-export([start_link/0,stop/0,get_gl/1,set_fd/2,
+ start_transaction/0,end_transaction/0,print_buffered/1,print/3,
+ set_footer/1,set_job_name/1,set_gl_props/1]).
+
+-export([init/1,handle_call/3,handle_info/2,terminate/2]).
+
+-record(st, {fds, %Singleton fds (gb_tree)
+ shared_gl :: pid(), %Shared group leader
+ gls, %Group leaders (gb_set)
+ io_buffering=false, %I/O buffering
+ buffered, %Buffered I/O requests
+ html_footer, %HTML footer
+ job_name, %Name of current job.
+ gl_props, %Properties for GL.
+ stopping
+ }).
+
+start_link() ->
+ case gen_server:start_link({local,?MODULE}, ?MODULE, [], []) of
+ {ok,Pid} ->
+ {ok,Pid};
+ Other ->
+ Other
+ end.
+
+stop() ->
+ OldGL = group_leader(),
+ group_leader(self(), self()),
+ req(stop),
+ group_leader(OldGL, self()),
+ ok.
+
+%% get_gl(Shared) -> Pid
+%% Shared = boolean()
+%% Pid = pid()
+%%
+%% Return a group leader (a process using the test_server_gl module).
+%% If Shared is true, the shared group leader is returned (suitable for
+%% running sequential test cases), otherwise a new group leader process
+%% is spawned. Group leader processes will live until the
+%% 'test_server_io' process is stopped.
+
+get_gl(Shared) when is_boolean(Shared) ->
+ req({get_gl,Shared}).
+
+%% set_fd(Tag, Fd) -> ok.
+%% Tag = major | html | unexpected_io
+%% Fd = a file descriptor (as returned by file:open/2)
+%%
+%% Associate a file descriptor with the given Tag. This
+%% Tag can later be used in when calling to print/3.
+
+set_fd(Tag, Fd) ->
+ req({set_fd,Tag,Fd}).
+
+%% start_transaction()
+%%
+%% Subsequent calls to print/3 from the process executing start_transaction/0
+%% will cause the messages to be buffered instead of printed directly.
+
+start_transaction() ->
+ req({start_transaction,self()}).
+
+%% end_transaction()
+%%
+%% End the transaction started by start_transaction/0. Subsequent calls to
+%% print/3 will cause the message to be printed directly.
+
+end_transaction() ->
+ req({end_transaction,self()}).
+
+%% print(From, Tag, Msg)
+%% From = pid()
+%% Tag = stdout, or any tag that has been registered using set_fd/2
+%% Msg = string or iolist
+%%
+%% Either print Msg to the file identified by Tag, or buffer the message
+%% start_transaction/0 has been called from the process From.
+%%
+%% NOTE: The tags have various special meanings. For example, 'html'
+%% is assumed to be a HTML file.
+
+print(From, Tag, Msg) ->
+ req({print,From,Tag,Msg}).
+
+%% print_buffered(Pid)
+%% Pid = pid()
+%%
+%% Print all messages buffered in the *first* transaction buffered for Pid.
+%% (If start_transaction/0 and end_transaction/0 has been called N times,
+%% print_buffered/1 must be called N times to print all transactions.)
+
+print_buffered(Pid) ->
+ req({print_buffered,Pid}).
+
+%% set_footer(IoData)
+%%
+%% Set a footer for the file associated with the 'html' tag.
+%% It will be used by print/3 to print a footer for the HTML file.
+
+set_footer(Footer) ->
+ req({set_footer,Footer}).
+
+%% set_job_name(Name)
+%% Set a name for the currently running job. The name will be used
+%% when printing to 'stdout'.
+%%
+set_job_name(Name) ->
+ req({set_job_name,Name}).
+
+%% set_gl_props(PropList)
+%% Set properties for group leader processes. When a group_leader process
+%% is created, test_server_gl:set_props(PropList) will be called.
+
+set_gl_props(PropList) ->
+ req({set_gl_props,PropList}).
+
+
+%%% Internal functions.
+
+init([]) ->
+ process_flag(trap_exit, true),
+ Empty = gb_trees:empty(),
+ {ok,Shared} = test_server_gl:start_link(),
+ {ok,#st{fds=Empty,shared_gl=Shared,gls=gb_sets:empty(),
+ io_buffering=gb_sets:empty(),
+ buffered=Empty,
+ html_footer="</body>\n</html>\n",
+ job_name="<name not set>",
+ gl_props=[]}}.
+
+req(Req) ->
+ gen_server:call(?MODULE, Req, infinity).
+
+handle_call({get_gl,false}, _From, #st{gls=Gls,gl_props=Props}=St) ->
+ {ok,Pid} = test_server_gl:start_link(),
+ test_server_gl:set_props(Pid, Props),
+ {reply,Pid,St#st{gls=gb_sets:insert(Pid, Gls)}};
+handle_call({get_gl,true}, _From, #st{shared_gl=Shared}=St) ->
+ {reply,Shared,St};
+handle_call({set_fd,Tag,Fd}, _From, #st{fds=Fds0}=St) ->
+ Fds = gb_trees:enter(Tag, Fd, Fds0),
+ {reply,ok,St#st{fds=Fds}};
+handle_call({start_transaction,Pid}, _From, #st{io_buffering=Buffer0,
+ buffered=Buf0}=St) ->
+ Buf = case gb_trees:is_defined(Pid, Buf0) of
+ false -> gb_trees:insert(Pid, queue:new(), Buf0);
+ true -> Buf0
+ end,
+ Buffer = gb_sets:add(Pid, Buffer0),
+ {reply,ok,St#st{io_buffering=Buffer,buffered=Buf}};
+handle_call({print,From,Tag,Str}, _From, St0) ->
+ St = output(From, Tag, Str, St0),
+ {reply,ok,St};
+handle_call({end_transaction,Pid}, _From, #st{io_buffering=Buffer0,
+ buffered=Buffered0}=St0) ->
+ Q0 = gb_trees:get(Pid, Buffered0),
+ Q = queue:in(eot, Q0),
+ Buffered = gb_trees:update(Pid, Q, Buffered0),
+ Buffer = gb_sets:delete_any(Pid, Buffer0),
+ St = St0#st{io_buffering=Buffer,buffered=Buffered},
+ {reply,ok,St};
+handle_call({print_buffered,Pid}, _From, #st{buffered=Buffered0}=St0) ->
+ Q0 = gb_trees:get(Pid, Buffered0),
+ Q = do_print_buffered(Q0, St0),
+ Buffered = gb_trees:update(Pid, Q, Buffered0),
+ St = St0#st{buffered=Buffered},
+ {reply,ok,St};
+handle_call({set_footer,Footer}, _From, St) ->
+ {reply,ok,St#st{html_footer=Footer}};
+handle_call({set_job_name,Name}, _From, St) ->
+ {reply,ok,St#st{job_name=Name}};
+handle_call({set_gl_props,Props}, _From, #st{shared_gl=Shared}=St) ->
+ test_server_gl:set_props(Shared, Props),
+ {reply,ok,St#st{gl_props=Props}};
+handle_call(stop, From, #st{shared_gl=SGL,gls=Gls0}=St0) ->
+ St = St0#st{gls=gb_sets:insert(SGL, Gls0),stopping=From},
+ gc(St),
+ %% Give the users of the surviving group leaders some
+ %% time to finish.
+ erlang:send_after(2000, self(), stop_group_leaders),
+ {noreply,St}.
+
+handle_info({'EXIT',Pid,normal}, #st{gls=Gls0,stopping=From}=St) ->
+ Gls = gb_sets:delete_any(Pid, Gls0),
+ case gb_sets:is_empty(Gls) andalso stopping =/= undefined of
+ true ->
+ %% No more group leaders left.
+ gen_server:reply(From, ok),
+ {stop,normal,St#st{gls=Gls,stopping=undefined}};
+ false ->
+ %% Wait for more group leaders to finish.
+ {noreply,St#st{gls=Gls}}
+ end;
+handle_info({'EXIT',_Pid,Reason}, _St) ->
+ exit(Reason);
+handle_info(stop_group_leaders, #st{gls=Gls}=St) ->
+ %% Stop the remaining group leaders.
+ [test_server_gl:stop(GL) || GL <- gb_sets:to_list(Gls)],
+ erlang:send_after(2000, self(), kill_group_leaders),
+ {noreply,St};
+handle_info(kill_group_leaders, #st{gls=Gls,stopping=From}=St) ->
+ [exit(GL, kill) || GL <- gb_sets:to_list(Gls)],
+ gen_server:reply(From, ok),
+ {stop,normal,St};
+handle_info(Other, St) ->
+ io:format("Ignoring: ~p\n", [Other]),
+ {noreply,St}.
+
+terminate(_, _) ->
+ ok.
+
+output(From, Tag, Str, #st{io_buffering=Buffered,buffered=Buf0}=St) ->
+ case gb_sets:is_member(From, Buffered) of
+ false ->
+ do_output(Tag, Str, St),
+ St;
+ true ->
+ Q0 = gb_trees:get(From, Buf0),
+ Q = queue:in({Tag,Str}, Q0),
+ Buf = gb_trees:update(From, Q, Buf0),
+ St#st{buffered=Buf}
+ end.
+
+do_output(stdout, Str, #st{job_name=undefined}) ->
+ io:put_chars(Str);
+do_output(stdout, Str0, #st{job_name=Name}) ->
+ Str = io_lib:format("Testing ~s: ~s\n", [Name,Str0]),
+ io:put_chars(Str);
+do_output(Tag, Str, #st{fds=Fds}=St) ->
+ case gb_trees:lookup(Tag, Fds) of
+ none ->
+ S = io_lib:format("\n*** ERROR: ~p, line ~p: No known '~p' log file\n",
+ [?MODULE,?LINE,Tag]),
+ do_output(stdout, [S,Str], St);
+ {value,Fd} ->
+ try
+ io:put_chars(Fd, Str),
+ case Tag of
+ html -> finalise_table(Fd, St);
+ _ -> ok
+ end
+ catch _:Error ->
+ S = io_lib:format("\n*** ERROR: ~p, line ~p: Error writing to "
+ "log file '~p': ~p\n",
+ [?MODULE,?LINE,Tag,Error]),
+ do_output(stdout, [S,Str], St)
+ end
+ end.
+
+finalise_table(Fd, #st{html_footer=Footer}) ->
+ case file:position(Fd, {cur,0}) of
+ {ok,Pos} ->
+ %% We are writing to a seekable file. Finalise so
+ %% we get complete valid (and viewable) HTML code.
+ %% Then rewind to overwrite the finalising code.
+ io:put_chars(Fd, ["\n</table>\n",Footer]),
+ file:position(Fd, Pos);
+ {error,epipe} ->
+ %% The file is not seekable. We cannot erase what
+ %% we've already written --- so the reader will
+ %% have to wait until we're done.
+ ok
+ end.
+
+do_print_buffered(Q0, St) ->
+ Item = queue:get(Q0),
+ Q = queue:drop(Q0),
+ case Item of
+ eot ->
+ Q;
+ {Tag,Str} ->
+ do_output(Tag, Str, St),
+ do_print_buffered(Q, St)
+ end.
+
+gc(#st{gls=Gls0}) ->
+ InUse0 = [begin
+ {group_leader,GL} = process_info(P, group_leader),
+ GL
+ end || P <- processes()],
+ InUse = ordsets:from_list(InUse0),
+ Gls = gb_sets:to_list(Gls0),
+ NotUsed = ordsets:subtract(Gls, InUse),
+ [test_server_gl:stop(Pid) || Pid <- NotUsed],
+ ok.
diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl
index 6358efa764..b307d93c7d 100644
--- a/lib/test_server/src/test_server_node.erl
+++ b/lib/test_server/src/test_server_node.erl
@@ -26,7 +26,7 @@
%% Test Controller interface
-export([is_release_available/1]).
--export([start_remote_main_target/1,stop/1]).
+-export([stop/1]).
-export([start_tracer_node/2,trace_nodes/2,stop_tracer_node/1]).
-export([start_node/5, stop_node/2]).
-export([kill_nodes/1, nodedown/2]).
@@ -35,7 +35,6 @@
-include("test_server_internal.hrl").
-record(slave_info, {name,socket,client}).
--define(VXWORKS_ACCEPT_TIMEOUT,?ACCEPT_TIMEOUT).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% %%%
@@ -58,87 +57,8 @@ is_release_available(Rel) ->
false
end.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%% Start main target node on remote host
-%%% The target node must not know the controller node via erlang distribution.
-start_remote_main_target(Parameters) ->
- #par{type=TargetType,
- target=TargetHost,
- naming=Naming,
- master=MasterNode,
- cookie=MasterCookie,
- slave_targets=SlaveTargets} = 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 =
- case os:getenv("TEST_SERVER_FRAMEWORK") of
- FW when FW =:= false; FW =:= "undefined" -> Cmd0;
- FW -> Cmd0 ++ " -env TEST_SERVER_FRAMEWORK " ++ FW
- end,
-
- {ok,LSock} = gen_tcp:listen(?MAIN_PORT,[binary,{reuseaddr,true},{packet,2}]),
- case start_target(TargetType,TargetHost,Cmd) of
- {ok,TargetClient,AcceptTimeout} ->
- case gen_tcp:accept(LSock,AcceptTimeout) of
- {ok,Sock} ->
- gen_tcp:close(LSock),
- receive
- {tcp,Sock,Bin} when is_binary(Bin) ->
- case unpack(Bin) of
- error ->
- gen_tcp:close(Sock),
- close_target_client(TargetClient),
- {error,bad_message};
- {ok,{target_info,TI}} ->
- put(test_server_free_targets,SlaveTargets),
- {ok, TI#target_info{where=Sock,
- host=TargetHost,
- naming=Naming,
- master=MasterNode,
- target_client=TargetClient,
- slave_targets=SlaveTargets}}
- end;
- {tcp_closed,Sock} ->
- gen_tcp:close(Sock),
- close_target_client(TargetClient),
- {error,could_not_contact_target}
- after AcceptTimeout ->
- gen_tcp:close(Sock),
- close_target_client(TargetClient),
- {error,timeout}
- end;
- Error ->
- %%! maybe something like kill_target(...)???
- gen_tcp:close(LSock),
- close_target_client(TargetClient),
- {error,{could_not_contact_target,Error}}
- end;
- Error ->
- gen_tcp:close(LSock),
- {error,{could_not_start_target,Error}}
- end.
-
stop(TI) ->
- kill_nodes(TI),
- case TI#target_info.where of
- local -> % there is no remote target to stop
- ok;
- Sock -> % stop remote target
- gen_tcp:close(Sock),
- close_target_client(TI#target_info.target_client)
- end.
+ kill_nodes(TI).
nodedown(Sock, TI) ->
Match = #slave_info{name='$1',socket=Sock,client='$2',_='_'},
@@ -155,14 +75,8 @@ nodedown(Sock, TI) ->
false -> ok
end,
slave_died;
- [] ->
- case TI#target_info.where of
- Sock ->
- %% test_server_ctrl will do the cleanup
- target_died;
- _ ->
- ignore
- end
+ [] ->
+ ok
end.
@@ -176,10 +90,7 @@ start_tracer_node(TraceFile,TI) ->
Match = #slave_info{name='$1',_='_'},
SlaveNodes = lists:map(fun([N]) -> [" ",N] end,
ets:match(slave_tab,Match)),
- TargetNode = case TI#target_info.where of
- local -> node();
- _ -> "test_server@" ++ TI#target_info.host
- end,
+ TargetNode = node(),
Cookie = TI#target_info.cookie,
{ok,LSock} = gen_tcp:listen(0,[binary,{reuseaddr,true},{packet,2}]),
{ok,TracePort} = inet:port(LSock),
@@ -433,10 +344,12 @@ start_node_peer(SlaveName, OptList, From, TI) ->
%% Bad environment can cause open port to fail. If this happens,
%% we ignore it and let the testcase handle the situation...
catch open_port({spawn, Cmd}, [stream|Opts]),
+
+ Tmo = 60000 * test_server:timetrap_scale_factor(),
case start_node_get_option_value(wait, OptList, true) of
true ->
- Ret = wait_for_node_started(LSock,60000,undefined,Cleanup,TI,self()),
+ Ret = wait_for_node_started(LSock,Tmo,undefined,Cleanup,TI,self()),
case {Ret,FailOnError} of
{{{ok, Node}, Warning},_} ->
gen_server:reply(From,{{ok,Node},HostStr,Cmd,[],Warning});
@@ -452,7 +365,7 @@ start_node_peer(SlaveName, OptList, From, TI) ->
Self = self(),
spawn_link(
fun() ->
- wait_for_node_started(LSock,60000,undefined,
+ wait_for_node_started(LSock,Tmo,undefined,
Cleanup,TI,Self),
receive after infinity -> ok end
end),
@@ -462,9 +375,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, []),
@@ -481,129 +391,29 @@ start_node_slave(SlaveName, OptList, From, TI) ->
Ret =
case start_which_node(OptList) of
{error,Reason} -> {{error,Reason},undefined,undefined};
- Host0 -> do_start_node_slave(Host0,SlaveName,Args,Prog,Cleanup,TI)
+ Host0 -> do_start_node_slave(Host0,SlaveName,Args,Prog,Cleanup)
end,
gen_server:reply(From,Ret).
-do_start_node_slave(Host0, SlaveName, Args, Prog, Cleanup, TI) ->
- case TI#target_info.where of
- local ->
- Host =
- case Host0 of
- local -> test_server_sup:hoststr();
- _ -> cast_to_list(Host0)
- end,
- Cmd = Prog ++ " " ++ Args,
- %% Can use slave.erl here because I'm both controller and target
- %% so I will ping the new node anyway
- case slave:start(Host, SlaveName, Args, no_link, Prog) of
- {ok,Nodename} ->
- case Cleanup of
- true -> ets:insert(slave_tab,#slave_info{name=Nodename});
- false -> ok
- end,
- {{ok,Nodename}, Host, Cmd, [], []};
- Ret ->
- {Ret, Host, Cmd}
- end;
-
- _Sock ->
- %% Cannot use slave.erl here because I'm only controller, and will
- %% not ping the new node. Only target shall contact the new node!!
- no_contact_start_slave(Host0,SlaveName,Args,Prog,Cleanup,TI)
- end.
-
-
-
-no_contact_start_slave(Host, Name, Args0, Prog, Cleanup,TI) ->
- Args1 = case string:str(Args0,"-setcookie") of
- 0 -> "-setcookie " ++ TI#target_info.cookie ++ " " ++ Args0;
- _ -> Args0
+do_start_node_slave(Host0, SlaveName, Args, Prog, Cleanup) ->
+ Host =
+ case Host0 of
+ local -> test_server_sup:hoststr();
+ _ -> cast_to_list(Host0)
+ end,
+ Cmd = Prog ++ " " ++ Args,
+ %% Can use slave.erl here because I'm both controller and target
+ %% so I will ping the new node anyway
+ case slave:start(Host, SlaveName, Args, no_link, Prog) of
+ {ok,Nodename} ->
+ case Cleanup of
+ true -> ets:insert(slave_tab,#slave_info{name=Nodename});
+ false -> ok
end,
- Args = TI#target_info.naming ++ " " ++ cast_to_list(Name) ++ " " ++ Args1,
- case Host of
- local ->
- case get(test_server_free_targets) of
- [] ->
- io:format("Starting slave ~p on HOST~n", [Name]),
- TargetType = test_server_sup:get_os_family(),
- Cmd0 = get_slave_node_start_command(TargetType,
- Prog,
- TI#target_info.master),
- Cmd = Cmd0 ++ " " ++ Args,
- do_no_contact_start_slave(TargetType,
- test_server_sup:hoststr(),
- Cmd, Cleanup,TI, false);
- [H|T] ->
- TargetType = TI#target_info.os_family,
- Cmd0 = get_slave_node_start_command(TargetType,
- Prog,
- TI#target_info.master),
- Cmd = Cmd0 ++ " " ++ Args,
- case do_no_contact_start_slave(TargetType,H,Cmd,Cleanup,
- TI,true) of
- {error,remove} ->
- io:format("Cannot start node on ~p, "
- "removing from slave "
- "target list.", [H]),
- put(test_server_free_targets,T),
- no_contact_start_slave(Host,Name,Args,Prog,
- Cleanup,TI);
- {error,keep} ->
- %% H is added to the END OF THE LIST
- %% in order to avoid the same target to
- %% be selected each time
- put(test_server_free_targets,T++[H]),
- no_contact_start_slave(Host,Name,Args,Prog,
- Cleanup,TI);
- R ->
- put(test_server_free_targets,T),
- R
- end
- end;
- _ ->
- TargetType = TI#target_info.os_family,
- Cmd0 = get_slave_node_start_command(TargetType,
- Prog,
- TI#target_info.master),
- Cmd = Cmd0 ++ " " ++ Args,
- do_no_contact_start_slave(TargetType, Host, Cmd, Cleanup, TI, false)
- end.
-
-do_no_contact_start_slave(TargetType,Host0,Cmd0,Cleanup,TI,Retry) ->
- %% Must use TargetType instead of TI#target_info.os_familiy here
- %% because if there were no free_targets we will be starting the
- %% slave node on host which might have a different os_familiy
- Host = cast_to_list(Host0),
- {ok,LSock} = gen_tcp:listen(0,[binary,
- {reuseaddr,true},
- {packet,2}]),
- {ok,WaitPort} = inet:port(LSock),
- Cmd = lists:concat([Cmd0, " -s ", ?MODULE, " node_started ",
- test_server_sup:hoststr(), " ", WaitPort]),
-
- case start_target(TargetType,Host,Cmd) of
- {ok,Client,AcceptTimeout} ->
- case wait_for_node_started(LSock,AcceptTimeout,
- Client,Cleanup,TI,self()) of
- {error,_}=WaitError ->
- if Retry ->
- case maybe_reboot_target(Client) of
- {error,_} -> {error,remove};
- ok -> {error,keep}
- end;
- true ->
- {WaitError,Host,Cmd}
- end;
- {Ok,Warning} ->
- {Ok,Host,Cmd,[],Warning}
- end;
- StartError ->
- gen_tcp:close(LSock),
- if Retry -> {error,remove};
- true -> {{error,{could_not_start_target,StartError}},Host,Cmd}
- end
+ {{ok,Nodename}, Host, Cmd, [], []};
+ Ret ->
+ {Ret, Host, Cmd}
end.
@@ -787,71 +597,10 @@ 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
- TargetHost -> Cmd0;
- _ -> lists:concat(["rsh ",TargetHost, " ", Cmd0])
- end,
- 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.
-
-%%
-%% 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),
- Prog ++ " " ++ Naming ++ " test_server" ++
- " -boot start_sasl -sasl errlog_type error"
- " -s test_server start " ++ test_server_sup:hoststr().
-
-%%
-%% 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.
-
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% cast_to_list(X) -> string()
%%% X = list() | atom() | void()
diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl
index 9d111ff769..ba5bb9f5d2 100644
--- a/lib/test_server/src/test_server_sup.erl
+++ b/lib/test_server/src/test_server_sup.erl
@@ -64,13 +64,7 @@ timetrap(Timeout0, ReportTVal, Scale, Pid) ->
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,
+ Trap = {timetrap_timeout,TimeToReport,MFLs},
exit(Pid, Trap),
receive
{'DOWN', Mon, process, Pid, _} ->
@@ -473,10 +467,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.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -520,8 +512,18 @@ framework_call(Callback,Func,Args,DefaultReturn) ->
end,
case erlang:function_exported(Mod,Func,length(Args)) of
true ->
- put(test_server_loc, {Mod,Func,framework}),
EH = fun(Reason) -> exit({fw_error,{Mod,Func,Reason}}) end,
+ SetTcState = case Func of
+ end_tc -> true;
+ init_tc -> true;
+ _ -> false
+ end,
+ case SetTcState of
+ true ->
+ test_server:set_tc_state({framework,Mod,Func});
+ false ->
+ ok
+ end,
try apply(Mod,Func,Args) of
Result ->
Result
@@ -552,18 +554,6 @@ format_loc([{Mod,LineOrFunc}]) ->
format_loc({Mod,LineOrFunc});
format_loc({Mod,Func}) when is_atom(Func) ->
io_lib:format("{~s,~w}",[package_str(Mod),Func]);
-format_loc({Mod,Line}) when is_integer(Line) ->
- %% ?line macro is used
- ModStr = package_str(Mod),
- case {lists:member(no_src, get(test_server_logopts)),
- lists:reverse(ModStr)} of
- {false,[$E,$T,$I,$U,$S,$_|_]} ->
- io_lib:format("{~s,<a href=\"~s~s#~w\">~w</a>}",
- [ModStr,downcase(ModStr),?src_listing_ext,
- round_to_10(Line),Line]);
- _ ->
- io_lib:format("{~s,~w}",[ModStr,Line])
- end;
format_loc(Loc) ->
io_lib:format("~p",[Loc]).
diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl
index 4899f38d2b..3ddc58fdbc 100644
--- a/lib/test_server/src/ts.erl
+++ b/lib/test_server/src/ts.erl
@@ -25,9 +25,9 @@
-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, 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,
@@ -40,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.
@@ -63,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.
@@ -77,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").
@@ -128,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",
@@ -158,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"
@@ -179,6 +168,13 @@ help(installed) ->
" - 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]).
@@ -193,33 +189,6 @@ install() ->
install(Options) when is_list(Options) ->
ts_install:install(install_local,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
%% {error, no_tests_available}. (batch)
@@ -291,12 +260,19 @@ run(Testspec, Config) when is_atom(Testspec), is_list(Config) ->
Options=check_test_get_opts(Testspec, Config),
File=atom_to_list(Testspec),
Spec = case code:lib_dir(Testspec) of
- {error, bad_name} when Testspec /= emulator,
- Testspec /= system,
- Testspec /= epmd ->
+ _ when Testspec == emulator;
+ Testspec == system;
+ Testspec == epmd ->
+ File++".spec";
+ {error, bad_name} ->
create_skip_spec(Testspec, tests(Testspec));
- _ ->
- File++".spec"
+ Path ->
+ case file:read_file_info(filename:join(Path,"ebin")) of
+ {ok,_} ->
+ File++".spec";
+ _ ->
+ create_skip_spec(Testspec, tests(Testspec))
+ end
end,
run_test(File, [{spec,[Spec]}], Options);
%% Runs one module in a spec (interactive)
@@ -491,6 +467,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
@@ -510,8 +505,60 @@ estone(Opts) when is_list(Opts) -> run(emulator,estone_SUITE,Opts).
cross_cover_analyse([Level]) ->
cross_cover_analyse(Level);
cross_cover_analyse(Level) ->
- test_server_ctrl:cross_cover_analyse(Level).
-
+ Apps = get_last_app_tests(),
+ Modules = get_cross_modules(Apps,[]),
+ test_server_ctrl:cross_cover_analyse(Level,Apps,Modules).
+
+get_last_app_tests() ->
+ AllTests = filelib:wildcard(filename:join(["*","*_test.logs"])),
+ {ok,RE} = re:compile("^[^/]*/[^\.]*\.(.*)_test\.logs$"),
+ get_last_app_tests(AllTests,RE,[]).
+
+get_last_app_tests([Dir|Dirs],RE,Acc) ->
+ NewAcc =
+ case re:run(Dir,RE,[{capture,all,list}]) of
+ {match,[Dir,AppStr]} ->
+ App = list_to_atom(AppStr),
+ case lists:keytake(App,1,Acc) of
+ {value,{App,LastDir},Rest} ->
+ if Dir > LastDir ->
+ [{App,Dir}|Rest];
+ true ->
+ Acc
+ end;
+ false ->
+ [{App,Dir} | Acc]
+ end;
+ _ ->
+ Acc
+ end,
+ get_last_app_tests(Dirs,RE,NewAcc);
+get_last_app_tests([],_,Acc) ->
+ Acc.
+
+get_cross_modules([{App,_}|Apps],Acc) ->
+ Mods = cross_modules(App),
+ get_cross_modules(Apps,lists:umerge(Mods,Acc));
+get_cross_modules([],Acc) ->
+ Acc.
+
+cross_modules(App) ->
+ case default_coverfile(App) of
+ none ->
+ [];
+ File ->
+ case catch file:consult(File) of
+ {ok,CoverSpec} ->
+ case lists:keyfind(cross_apps,1,CoverSpec) of
+ false ->
+ [];
+ {cross_apps,App,Modules} ->
+ lists:usort(Modules)
+ end;
+ _ ->
+ []
+ end
+ end.
%%% Implementation.
@@ -552,32 +599,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.
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_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 43e56e1098..73abe86e11 100644
--- a/lib/test_server/src/ts_erl_config.erl
+++ b/lib/test_server/src/ts_erl_config.erl
@@ -160,7 +160,6 @@ system_include(Root, Vars) ->
SysDir =
case ts_lib:var(os, Vars) of
"Windows" ++ _T -> "sys/win32";
- "VxWorks" -> "sys.vxworks";
_ -> "sys/unix"
end,
" -I" ++ quote(filename:nativename(filename:join([Root, "erts", "emulator", SysDir]))).
@@ -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,7 +214,7 @@ erl_interface(Vars,OsType) ->
{unix,_} ->
"-lpthread";
_ ->
- "" % VxWorks
+ ""
end,
[{erl_interface_libpath, quote(filename:nativename(LibPath))},
{erl_interface_sock_libs, sock_libraries(OsType)},
@@ -318,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}).
diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl
index caf00759e5..ba8952f10f 100644
--- a/lib/test_server/src/ts_install.erl
+++ b/lib/test_server/src/ts_install.erl
@@ -55,8 +55,7 @@ build_install(TargetSystem, Options) ->
end.
os_type({unix,_}=OsType) -> OsType;
-os_type({win32,_}=OsType) -> OsType;
-os_type(_Other) -> vxworks.
+os_type({win32,_}=OsType) -> OsType.
target_install(CrossVars) ->
io:format("Cross installation detected, skipping configure and data_dir make~n"),
@@ -76,7 +75,6 @@ target_install(CrossVars) ->
%% Autoconf for various platforms.
%% unix uses the configure script
%% win32 uses ts_autoconf_win32
-%% VxWorks uses ts_autoconf_vxworks.
autoconf(TargetSystem, XComp) ->
case autoconf1(TargetSystem, XComp) of
@@ -90,8 +88,6 @@ autoconf1({win32, _},[{cross,"no"}]) ->
ts_autoconf_win32:configure();
autoconf1({unix, _},XCompFile) ->
unix_autoconf(XCompFile);
-autoconf1(Other,[{cross,"no"}]) ->
- ts_autoconf_vxworks:configure(Other);
autoconf1(_,_) ->
io:format("cross compilation not supported for that this platform~n"),
throw(cross_installation_failed).
diff --git a/lib/test_server/src/ts_lib.erl b/lib/test_server/src/ts_lib.erl
index ea97361bd3..d9a699ca9f 100644
--- a/lib/test_server/src/ts_lib.erl
+++ b/lib/test_server/src/ts_lib.erl
@@ -25,9 +25,8 @@
-compile({no_auto_import,[error/1]}).
-export([error/1, var/2, erlang_type/0,
erlang_type/1,
- initial_capital/1, interesting_logs/1,
- specs/1, suites/2, last_test/1,
- force_write_file/2, force_delete/1,
+ 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
@@ -91,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",
@@ -157,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}
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 ->
- ["&nbsp;<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 &copy; ", 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 &copy; ", 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 &copy; ", 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 95e3c08d5b..741dd483f5 100644
--- a/lib/test_server/src/ts_run.erl
+++ b/lib/test_server/src/ts_run.erl
@@ -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].
@@ -231,8 +248,7 @@ make_command(Vars, Spec, State) ->
" -boot start_sasl -sasl errlog_type error",
" -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,8 +345,7 @@ start_xterm(Command) ->
path_separator() ->
case os:type() of
{win32, _} -> ";";
- {unix, _} -> ":";
- vxworks -> ":"
+ {unix, _} -> ":"
end.
@@ -353,7 +368,7 @@ make_common_test_args(Args0, Options0, _Vars) ->
io:format("No cover file found for ~p~n",[App]),
[];
{value,{cover,_App,File,_Analyse}} ->
- [{cover,to_list(File)}];
+ [{cover,to_list(File)},{cover_stop,false}];
false ->
[]
end,
@@ -365,13 +380,7 @@ make_common_test_args(Args0, Options0, _Vars) ->
[{logdir,"../test_server"}]
end,
- TimeTrap = case test_server:timetrap_scale_factor() of
- 1 ->
- [];
- Scale ->
- [{multiply_timetraps, Scale},
- {scale_timetraps, true}]
- end,
+ TimeTrap = [{scale_timetraps, true}],
{ConfigPath,
Options} = case {os:getenv("TEST_CONFIG_PATH"),
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.
-
-
-
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-01 23:17:08 +0000