From 320d1332594e1211ccee8167589030b31bccc3aa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Thu, 20 Sep 2012 17:12:49 +0200
Subject: Introduce test_server_io and test_server_gl
---
lib/test_server/src/Makefile | 2 +
lib/test_server/src/test_server.app.src | 1 +
lib/test_server/src/test_server.erl | 274 +++++++--------------------
lib/test_server/src/test_server_ctrl.erl | 279 ++++++++++-----------------
lib/test_server/src/test_server_gl.erl | 293 ++++++++++++++++++++++++++++
lib/test_server/src/test_server_io.erl | 315 +++++++++++++++++++++++++++++++
6 files changed, 769 insertions(+), 395 deletions(-)
create mode 100644 lib/test_server/src/test_server_gl.erl
create mode 100644 lib/test_server/src/test_server_io.erl
(limited to 'lib')
diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile
index bb0b4e55b8..20e7a5942c 100644
--- a/lib/test_server/src/Makefile
+++ b/lib/test_server/src/Makefile
@@ -40,6 +40,8 @@ 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 \
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 bfa5e927b1..bcffe896c4 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/test_server/src/test_server.erl
@@ -524,7 +524,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 +538,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 +558,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,18 +572,18 @@ 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) ->
+run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
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);
+ TimetrapData);
JobDir ->
%% i'm a remote target
case Args of
@@ -602,14 +598,14 @@ run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData, RejectIoReqs)
Config2 = lists:keyreplace(priv_dir, 1, Config1,
{priv_dir,TargetPrivDir}),
do_run_test_case_apply(Mod, Func, [Config2], Name, RunInit,
- TimetrapData, RejectIoReqs);
+ TimetrapData);
_other ->
do_run_test_case_apply(Mod, Func, Args, Name, RunInit,
- TimetrapData, RejectIoReqs)
+ TimetrapData)
end
end.
-do_run_test_case_apply(Mod, Func, Args, Name, RunInit,
- TimetrapData, RejectIoReqs) ->
+
+do_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 +620,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,9 +627,8 @@ 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, "",
+ run_test_case_msgloop(Ref, Pid, false, "",
undefined, starting).
%% Ugly bug (pre R5A):
@@ -648,8 +640,7 @@ 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) ->
+run_test_case_msgloop(Ref, Pid, Terminate, Comment, CurrConf, Status) ->
%% NOTE: Keep job_proxy_msgloop/0 up to date when changes
%% are made in this function!
{Timeout,ReturnValue} =
@@ -664,7 +655,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
end,
receive
{test_case_initialized,Pid} ->
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ run_test_case_msgloop(Ref,Pid,Terminate,
Comment,CurrConf,running);
Abort = {abort_current_testcase,_,_} when Status == starting ->
%% we're in init phase, must must postpone this operation
@@ -672,7 +663,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
%% gets killed)
self() ! Abort,
erlang:yield(),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ run_test_case_msgloop(Ref,Pid,Terminate,
Comment,CurrConf,Status);
{abort_current_testcase,Reason,From} ->
Line = case is_process_alive(Pid) of
@@ -703,92 +694,15 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
Error1
end
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ run_test_case_msgloop(Ref,Pid,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);
{sync_apply,From,MFA} ->
sync_local_or_remote_apply(false,From,MFA),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ run_test_case_msgloop(Ref,Pid,Terminate,
Comment,CurrConf,Status);
{sync_apply_proxy,Proxy,From,MFA} ->
sync_local_or_remote_apply(Proxy,From,MFA),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
- Comment,CurrConf,Status);
- {printout,Detail,Format,Args} ->
- print(Detail,Format,Args),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ run_test_case_msgloop(Ref,Pid,Terminate,
Comment,CurrConf,Status);
{comment,NewComment} ->
NewComment1 = test_server_ctrl:to_string(NewComment),
@@ -802,19 +716,19 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
Other ->
Other
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate1,
+ run_test_case_msgloop(Ref,Pid,Terminate1,
NewComment2,CurrConf,Status);
{read_comment,From} ->
From ! {self(),read_comment,Comment},
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ run_test_case_msgloop(Ref,Pid,Terminate,
Comment,CurrConf,Status);
{set_curr_conf,From,NewCurrConf} ->
From ! {self(),set_curr_conf,ok},
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate,
+ run_test_case_msgloop(Ref,Pid,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,
+ run_test_case_msgloop(Ref,Pid,Terminate,
Comment,CurrConf,Status);
{make_priv_dir,From} ->
Result =
@@ -832,11 +746,11 @@ 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,
+ run_test_case_msgloop(Ref,Pid,Terminate,
Comment,CurrConf,Status);
{'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} ->
RetVal = {Time/1000000,Value,mod_loc(Loc),Opts,Comment},
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ run_test_case_msgloop(Ref,Pid,
{true,RetVal},Comment,undefined,Status);
{'EXIT',Pid,Reason} ->
case Reason of
@@ -849,7 +763,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
{framework_error,{timetrap,TVal}},
unknown,self()),
run_test_case_msgloop(Ref,Pid,
- CaptureStdout,RejectIoReqs,
Terminate,Comment,
undefined,Status);
Loc1 ->
@@ -883,7 +796,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
undefined
end,
run_test_case_msgloop(Ref,Pid,
- CaptureStdout,RejectIoReqs,
Terminate,Comment,
NewCurrConf,Status)
end;
@@ -900,7 +812,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
{timetrap_timeout,TVal},
Loc1,self())
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ run_test_case_msgloop(Ref,Pid,
Terminate,Comment,CurrConf,Status);
{testcase_aborted,ErrorMsg={user_timetrap_error,_},AbortLoc} ->
%% user timetrap function caused exit
@@ -909,7 +821,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
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} ->
@@ -921,7 +832,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
{framework_error,ErrorMsg},
unknown,self()),
run_test_case_msgloop(Ref,Pid,
- CaptureStdout,RejectIoReqs,
Terminate,Comment,
undefined,Status);
Loc1 ->
@@ -954,7 +864,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
undefined
end,
run_test_case_msgloop(Ref,Pid,
- CaptureStdout,RejectIoReqs,
Terminate,Comment,
NewCurrConf,Status)
end;
@@ -969,13 +878,13 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
spawn_fw_call(Mod,Func,CurrConf,Pid,
testcase_aborted_or_killed,
unknown,self()),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ run_test_case_msgloop(Ref,Pid,
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,
+ run_test_case_msgloop(Ref,Pid,
Terminate,Comment,CurrConf,Status);
_Other ->
%% the testcase has terminated because of Reason (e.g. an exit
@@ -986,7 +895,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
end,
spawn_fw_call(Mod,Func,CurrConf,Pid,
Reason,unknown,self()),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ run_test_case_msgloop(Ref,Pid,
Terminate,Comment,CurrConf,Status)
end;
{EndConfPid,{call_end_conf,Data,_Result}} ->
@@ -995,10 +904,10 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
{_Mod,_Func,TCPid,TCExitReason,Loc} = Data,
spawn_fw_call(Mod,Func,CurrConf,TCPid,
TCExitReason,Loc,self()),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ run_test_case_msgloop(Ref,Pid,
Terminate,Comment,undefined,Status);
_ ->
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ run_test_case_msgloop(Ref,Pid,
Terminate,Comment,CurrConf,Status)
end;
{_FwCallPid,fw_notify_done,{T,Value,Loc,Opts,AddToComment}} ->
@@ -1019,7 +928,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
end,
{T,Value,Loc,Opts,Comment1}
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ run_test_case_msgloop(Ref,Pid,
{true,RetVal},Comment,undefined,Status);
{'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} ->
%% a framework function failed
@@ -1031,12 +940,12 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
{list_to_atom(CB),Func}
end,
RetVal = {died,{framework_error,Loc,Error},Loc,"Framework error"},
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ run_test_case_msgloop(Ref,Pid,
{true,RetVal},Comment,undefined,Status);
{failed,File,Line} ->
put(test_server_detected_fail,
[{File, Line}| get(test_server_detected_fail)]),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ run_test_case_msgloop(Ref,Pid,
Terminate,Comment,CurrConf,Status);
{user_timetrap,Pid,_TrapTime,StartTime,E={user_timetrap_error,_},_} ->
@@ -1046,7 +955,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
ignore ->
ok
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ run_test_case_msgloop(Ref,Pid,
Terminate,Comment,CurrConf,Status);
{user_timetrap,Pid,TrapTime,StartTime,ElapsedTime,Scale} ->
%% a user timetrap is triggered, ignore it if new
@@ -1062,68 +971,41 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate,
ignore ->
ok
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ run_test_case_msgloop(Ref,Pid,
Terminate,Comment,CurrConf,Status);
{timetrap_cancel_one,Handle,_From} ->
timetrap_cancel_one(Handle, false),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ run_test_case_msgloop(Ref,Pid,
Terminate,Comment,CurrConf,Status);
{timetrap_cancel_all,TCPid,_From} ->
timetrap_cancel_all(TCPid, false),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ run_test_case_msgloop(Ref,Pid,
Terminate,Comment,CurrConf,Status);
- {get_timetrap_info,TCPid,From} ->
+ {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,
+ run_test_case_msgloop(Ref,Pid,
Terminate,Comment,CurrConf,Status);
_Other when not is_tuple(_Other) ->
%% ignore anything not generated by test server
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ run_test_case_msgloop(Ref,Pid,
Terminate,Comment,CurrConf,Status);
_Other when element(1, _Other) /= 'EXIT',
element(1, _Other) /= started,
element(1, _Other) /= finished,
element(1, _Other) /= print ->
%% ignore anything not generated by test server
- run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,
+ run_test_case_msgloop(Ref,Pid,
Terminate,Comment,CurrConf,Status)
after Timeout ->
ReturnValue
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.
-
-output(Msg,Sender) ->
- local_or_remote_apply({test_server_ctrl,output,[Msg,Sender]}).
-
call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) ->
- %% Starter is also the group leader process
Starter = self(),
Data = {Mod,Func,TCPid,TCExitReason,Loc},
EndConfProc =
fun() ->
- group_leader(Starter, self()),
Supervisor = self(),
EndConfApply =
fun() ->
@@ -1161,9 +1043,6 @@ spawn_fw_call(Mod,{init_per_testcase,Func},_,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
@@ -1192,9 +1071,6 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid,
end,
FwCall =
fun() ->
- %% set group leader so that printouts/comments
- %% from the framework get printed in the logs
- group_leader(SendTo, self()),
{RetVal,Report} =
case proplists:get_value(tc_status, EndConf1) of
undefined ->
@@ -1230,9 +1106,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}]),
@@ -1256,9 +1129,6 @@ spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) ->
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,[],
Error,Loc) of
{'EXIT',FwErrorNotifyErr} ->
@@ -1366,8 +1236,7 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit,
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),
+ tc_supervisor_req(set_curr_conf, {{Mod,Func},hd(Args)}),
case RunInit of
run_init ->
put(test_server_init_or_end_conf,{init_per_testcase,Func}),
@@ -1397,8 +1266,7 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) ->
%% 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),
+ tc_supervisor_req(set_curr_conf, {{Mod,Func},NewConf1}),
put(test_server_loc, {Mod,Func}),
%% execute the test case
{{T,Return},Loc} = {ts_tc(Mod, Func, [NewConf1]),get_loc()},
@@ -1426,8 +1294,7 @@ 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),
+ tc_supervisor_req(set_curr_conf, EndConf1),
{FWReturn1,TSReturn1,EndConf2} =
case end_per_testcase(Mod, Func, EndConf1) of
SaveCfg1={save_config,_} ->
@@ -1447,8 +1314,7 @@ 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),
+ tc_supervisor_req(set_curr_conf, undefined),
put(test_server_init_or_end_conf,undefined),
case do_end_tc_call(Mod,Func, Loc,
{FWReturn1,[EndConf2]}, TSReturn1) of
@@ -1908,16 +1774,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
@@ -2510,11 +2366,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
@@ -2533,17 +2385,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.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -2938,13 +2802,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
@@ -2952,13 +2810,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
diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl
index 8673fbf683..7dd1b38bc2 100644
--- a/lib/test_server/src/test_server_ctrl.erl
+++ b/lib/test_server/src/test_server_ctrl.erl
@@ -172,7 +172,7 @@
-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]).
@@ -203,6 +203,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").
@@ -1370,24 +1371,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),
@@ -1403,11 +1402,18 @@ 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),
set_io_buffering(undefined),
catch stop_extra_tools(StartedExtraTools),
@@ -1439,7 +1445,8 @@ 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]).
@@ -1816,8 +1823,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\">",
@@ -1902,10 +1910,16 @@ start_log_file() ->
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)),
@@ -1958,13 +1972,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 =
@@ -1973,14 +1988,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,
@@ -2028,6 +2044,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, []),
@@ -2448,27 +2465,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.
@@ -3096,8 +3124,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;
@@ -3352,7 +3380,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)
@@ -3493,8 +3523,7 @@ 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).
@@ -3554,7 +3583,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} =
@@ -3585,16 +3614,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)
@@ -3603,13 +3634,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)!
@@ -3636,7 +3667,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} =
@@ -3678,9 +3709,11 @@ handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) ->
receive
%% 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);
@@ -3693,13 +3726,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]),
@@ -3765,11 +3794,15 @@ run_test_case(Ref, Num, Mod, Func, Args, RunInit, Where, TimetrapData, Mode) ->
run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where,
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 is_io_buffered() of
false -> ok;
- true -> Main ! {started,Ref,self(),Num,Mod,Func}
+ true ->
+ test_server_io:start_transaction(),
+ Main ! {started,Ref,self(),Num,Mod,Func}
end,
TSDir = get(test_server_dir),
case Where of
@@ -3778,6 +3811,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where,
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,11 +3865,10 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where,
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, Where, TimetrapData),
{Time,RetVal,Loc,Opts,Comment} =
case Result of
Normal={_Time,_RetVal,_Loc,_Opts,_Comment} -> Normal;
@@ -3960,6 +3993,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where,
false ->
ok;
true ->
+ test_server_io:end_transaction(),
Main ! {finished,Ref,self(),Num,Mod,Func,
?mod_result(Status),{Time,RetVal,Opts}}
end,
@@ -4449,7 +4483,7 @@ do_format_exception(Reason={Error,Stack}) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit,
-%% Where, TimetrapData, RejectIoReqs) ->
+%% Where, TimetrapData) ->
%% {{Time,RetVal,Loc,Opts,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} |
%% {{died,Reason,unknown,Comment},DetectedFail,ProcessesBefore,ProcessesAfter}
%% Name = atom()
@@ -4469,20 +4503,20 @@ do_format_exception(Reason={Error,Stack}) ->
%% 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) ->
+ TimetrapData) ->
test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,
- TimetrapData,RejectIoReqs});
+ TimetrapData});
run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, target,
- TimetrapData, RejectIoReqs) ->
+ TimetrapData) ->
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});
+ TimetrapData});
JobSock ->
%% remote target
request(JobSock, {test_case,{CaseNum,Mod,Func,Args,Name,RunInit,
- TimetrapData,RejectIoReqs}}),
+ TimetrapData}}),
read_job_sock_loop(JobSock)
end.
@@ -4494,16 +4528,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, []).
@@ -4516,19 +4540,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
@@ -4591,107 +4603,6 @@ format(Detail, Format, Args) ->
end,
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, [Msg,"\n"]);
-
-output_to_fd(Fd, Msg, internal) ->
- io:put_chars(Fd, [$=,$=,$=,$ , Msg, "\n"]);
-
-output_to_fd(Fd, Msg, _Sender) ->
- case get(test_server_log_nl) of
- false -> io:put_chars(Fd, Msg);
- _ -> io:put_chars(Fd, [Msg,"\n"])
- end.
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% xhtml(BasicHtml, XHtml) -> BasicHtml | XHtml
%%
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_io.erl b/lib/test_server/src/test_server_io.erl
new file mode 100644
index 0000000000..abdfb71241
--- /dev/null
+++ b/lib/test_server/src/test_server_io.erl
@@ -0,0 +1,315 @@
+%%
+%% %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 they are garbaged
+%% collected by a call to gc/0.
+
+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 directory.
+
+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, 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.
--
cgit v1.2.3