diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/test_server/src/Makefile | 2 | ||||
| -rw-r--r-- | lib/test_server/src/test_server.app.src | 1 | ||||
| -rw-r--r-- | lib/test_server/src/test_server.erl | 274 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_ctrl.erl | 279 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_gl.erl | 293 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_io.erl | 315 |
6 files changed, 769 insertions, 395 deletions
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 @@ -4592,107 +4604,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, [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 %% xhtml(HTML, 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. |