From c2a3647e471bb08de24d867bc7c3f541e2f7a15d Mon Sep 17 00:00:00 2001 From: Peter Andersson Date: Tue, 20 Mar 2012 01:29:02 +0100 Subject: Implement support for user controlled timetraps OTP-9988 --- lib/test_server/src/test_server.erl | 425 ++++++++++++++++++++++---------- lib/test_server/src/test_server_sup.erl | 58 +++-- 2 files changed, 324 insertions(+), 159 deletions(-) (limited to 'lib/test_server') diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index d7ce432786..7baae966c9 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -628,7 +628,7 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> end), group_leader(OldGLeader, self()), put(test_server_detected_fail, []), - run_test_case_msgloop(Ref, Pid, false, false, "", undefined). + run_test_case_msgloop(Ref, Pid, false, false, "", undefined, starting). %% Ugly bug (pre R5A): %% If this process (group leader of the test case) terminates before @@ -639,7 +639,8 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> %% A test case is known to have failed if it returns {'EXIT', _} tuple, %% or sends a message {failed, File, Line} to it's group_leader %% -run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> +run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, + Comment, CurrConf, Status) -> %% NOTE: Keep job_proxy_msgloop/0 up to date when changes %% are made in this function! {Timeout,ReturnValue} = @@ -650,8 +651,22 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> {infinity, should_never_appear} end, receive + {test_case_initialized,Pid} -> + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,running); + Abort = {abort_current_testcase,_,_} when Status == starting -> + %% we're in init phase, must must postpone this operation + %% until test case execution is in progress (or FW:init_tc + %% gets killed) + self() ! Abort, + erlang:yield(), + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {abort_current_testcase,Reason,From} -> - Line = get_loc(Pid), + Line = case is_process_alive(Pid) of + true -> get_loc(Pid); + false -> unknown + end, Mon = erlang:monitor(process, Pid), exit(Pid,{testcase_aborted,Reason,Line}), erlang:yield(), @@ -665,76 +680,94 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> exit(Pid, kill), %% here's the only place we know Reason, so we save %% it as a comment, potentially replacing user data - Error = lists:flatten(io_lib:format("Aborted: ~p",[Reason])), + Error = lists:flatten(io_lib:format("Aborted: ~p", + [Reason])), Error1 = lists:flatten([string:strip(S,left) || - S <- string:tokens(Error,[$\n])]), + S <- string:tokens(Error, + [$\n])]), if length(Error1) > 63 -> string:substr(Error1,1,60) ++ "..."; true -> Error1 end end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,NewComment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + NewComment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}} when is_list(Format) -> Msg = (catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}} when is_atom(Format) -> Msg = (catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,Bytes}} -> run_test_case_msgloop_io( ReplyAs,CaptureStdout,Bytes,From,put_chars), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,unicode,io_lib,Func,[Format,Args]}} when is_list(Format) -> Msg = unicode_to_latin1(catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,latin1,io_lib,Func,[Format,Args]}} when is_list(Format) -> Msg = (catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,unicode,io_lib,Func,[Format,Args]}} when is_atom(Format) -> Msg = unicode_to_latin1(catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,latin1,io_lib,Func,[Format,Args]}} when is_atom(Format) -> Msg = (catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,unicode,Bytes}} -> run_test_case_msgloop_io( ReplyAs,CaptureStdout,unicode_to_latin1(Bytes),From,put_chars), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,latin1,Bytes}} -> run_test_case_msgloop_io( ReplyAs,CaptureStdout,Bytes,From,put_chars), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); IoReq when element(1, IoReq) == io_request -> %% something else, just pass it on group_leader() ! IoReq, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {structured_io,ClientPid,Msg} -> output(Msg, ClientPid), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {capture,NewCapture} -> - run_test_case_msgloop(Ref,Pid,NewCapture,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,NewCapture,Terminate, + Comment,CurrConf,Status); {sync_apply,From,MFA} -> sync_local_or_remote_apply(false,From,MFA), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {sync_apply_proxy,Proxy,From,MFA} -> sync_local_or_remote_apply(Proxy,From,MFA), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {printout,Detail,Format,Args} -> print(Detail,Format,Args), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {comment,NewComment} -> NewComment1 = test_server_ctrl:to_string(NewComment), NewComment2 = test_server_sup:framework_call(format_comment, @@ -747,13 +780,16 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> Other -> Other end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate1,NewComment2,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate1, + NewComment2,CurrConf,Status); {read_comment,From} -> From ! {self(),read_comment,Comment}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {set_curr_conf,From,NewCurrConf} -> From ! {self(),set_curr_conf,ok}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,NewCurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,NewCurrConf,Status); {make_priv_dir,From} when CurrConf == undefined -> From ! {self(),make_priv_dir,{error,no_priv_dir_in_config}}; {make_priv_dir,From} -> @@ -772,10 +808,12 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> end end, From ! {self(),make_priv_dir,Result}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} -> RetVal = {Time/1000000,Value,mod_loc(Loc),Opts,Comment}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment,undefined); + run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal}, + Comment,undefined,Status); {'EXIT',Pid,Reason} -> case Reason of {timetrap_timeout,TVal,Loc} -> @@ -786,36 +824,42 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, {framework_error,{timetrap,TVal}}, unknown,self()), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, - Comment,undefined); + run_test_case_msgloop(Ref,Pid,CaptureStdout, + Terminate,Comment, + undefined,Status); Loc1 -> %% call end_per_testcase on a separate process, - %% only so that the user has a chance to clean up - %% after init_per_testcase, even after a timetrap timeout + %% only so that the user has a chance to + %% clean up after init_per_testcase, even after + %% a timetrap timeout NewCurrConf = case CurrConf of {{Mod,Func},Conf} -> EndConfPid = - call_end_conf(Mod,Func,Pid, - {timetrap_timeout,TVal}, - Loc1,[{tc_status, - {failed, - timetrap_timeout}}|Conf], - TVal), + call_end_conf( + Mod,Func,Pid, + {timetrap_timeout,TVal}, + Loc1,[{tc_status, + {failed, + timetrap_timeout}}|Conf], + TVal), {EndConfPid,{Mod,Func},Conf}; _ -> {Mod,Func} = get_mf(Loc1), - %% The framework functions mustn't execute on this - %% group leader process or io will cause deadlock, - %% so we spawn a dedicated process for the operation - %% and let the group leader go back to handle io. + %% The framework functions mustn't + %% execute on this group leader process + %% or io will cause deadlock, so we + %% spawn a dedicated process for the + %% operation and let the group leader + %% go back to handle io. spawn_fw_call(Mod,Func,CurrConf,Pid, {timetrap_timeout,TVal}, Loc1,self()), undefined end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, - Comment,NewCurrConf) + run_test_case_msgloop(Ref,Pid,CaptureStdout, + Terminate,Comment, + NewCurrConf,Status) end; {timetrap_timeout,TVal,Loc,InitOrEnd} -> case mod_loc(Loc) of @@ -830,7 +874,17 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> {timetrap_timeout,TVal}, Loc1,self()) end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); + {testcase_aborted,ErrorMsg={user_timetrap_error,_},AbortLoc} -> + %% user timetrap function caused exit + %% during start of test case + {Mod,Func} = get_mf(mod_loc(AbortLoc)), + spawn_fw_call(Mod,Func,CurrConf,Pid, + ErrorMsg,unknown,self()), + run_test_case_msgloop(Ref,Pid,CaptureStdout, + Terminate,Comment, + undefined,Status); {testcase_aborted,AbortReason,AbortLoc} -> ErrorMsg = {testcase_aborted,AbortReason}, case mod_loc(AbortLoc) of @@ -839,33 +893,41 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, {framework_error,ErrorMsg}, unknown,self()), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, - Comment,undefined); + run_test_case_msgloop(Ref,Pid,CaptureStdout, + Terminate,Comment, + undefined,Status); Loc1 -> - %% call end_per_testcase on a separate process, only so - %% that the user has a chance to clean up after init_per_testcase, - %% even after abortion + %% call end_per_testcase on a separate process, + %% only so that the user has a chance to clean up + %% after init_per_testcase, even after abortion NewCurrConf = case CurrConf of {{Mod,Func},Conf} -> - TVal = case lists:keysearch(default_timeout,1,Conf) of - {value,{default_timeout,Tmo}} -> Tmo; - _ -> ?DEFAULT_TIMETRAP_SECS*1000 - end, + TVal = + case lists:keysearch(default_timeout, + 1, + Conf) of + {value,{default_timeout,Tmo}} -> + Tmo; + _ -> + ?DEFAULT_TIMETRAP_SECS*1000 + end, EndConfPid = - call_end_conf(Mod,Func,Pid,ErrorMsg, - Loc1, - [{tc_status,{failed,ErrorMsg}}|Conf], - TVal), + call_end_conf( + Mod,Func,Pid, + ErrorMsg,Loc1, + [{tc_status, + {failed,ErrorMsg}}|Conf],TVal), {EndConfPid,{Mod,Func},Conf}; _ -> {Mod,Func} = get_mf(Loc1), - spawn_fw_call(Mod,Func,CurrConf,Pid,ErrorMsg, - Loc1,self()), + spawn_fw_call(Mod,Func,CurrConf,Pid, + ErrorMsg,Loc1,self()), undefined end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, - Comment,NewCurrConf) + run_test_case_msgloop(Ref,Pid,CaptureStdout, + Terminate,Comment, + NewCurrConf,Status) end; killed -> %% result of an exit(TestCase,kill) call, which is the @@ -878,11 +940,14 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> spawn_fw_call(Mod,Func,CurrConf,Pid, testcase_aborted_or_killed, unknown,self()), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {fw_error,{FwMod,FwFunc,FwError}} -> - spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,{framework_error,FwError}, + spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, + {framework_error,FwError}, unknown,self()), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); _Other -> %% the testcase has terminated because of Reason (e.g. an exit %% because a linked process failed) @@ -890,17 +955,22 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> {MF,_} -> MF; _ -> {undefined,undefined} end, - spawn_fw_call(Mod,Func,CurrConf,Pid,Reason,unknown,self()), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf) + spawn_fw_call(Mod,Func,CurrConf,Pid, + Reason,unknown,self()), + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status) end; {EndConfPid,{call_end_conf,Data,_Result}} -> case CurrConf of {EndConfPid,{Mod,Func},_Conf} -> {_Mod,_Func,TCPid,TCExitReason,Loc} = Data, - spawn_fw_call(Mod,Func,CurrConf,TCPid,TCExitReason,Loc,self()), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,undefined); + spawn_fw_call(Mod,Func,CurrConf,TCPid, + TCExitReason,Loc,self()), + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,undefined,Status); _ -> - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf) + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status) end; {_FwCallPid,fw_notify_done,{T,Value,Loc,Opts,AddToComment}} -> %% the framework has been notified, we're finished @@ -920,7 +990,8 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> end, {T,Value,Loc,Opts,Comment1} end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment,undefined); + run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal}, + Comment,undefined,Status); {'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} -> %% a framework function failed CB = os:getenv("TEST_SERVER_FRAMEWORK"), @@ -931,20 +1002,46 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> {list_to_atom(CB),Func} end, RetVal = {died,{framework_error,Loc,Error},Loc,"Framework error"}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment,undefined); + run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal}, + Comment,undefined,Status); {failed,File,Line} -> put(test_server_detected_fail, [{File, Line}| get(test_server_detected_fail)]), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); + + {user_timetrap,Pid,_TrapTime,Error={user_timetrap_error,_}} -> + self() ! {abort_current_testcase,Error,Pid}, + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); + {user_timetrap,Pid,0,ElapsedTime} -> + %% a user timetrap is triggered, use the test case execution + %% time as timeout value for the error report + timetrap(0, ElapsedTime, Pid), + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); + {user_timetrap,Pid,TrapTime,ElapsedTime} -> + TotalTime = if is_integer(TrapTime) -> TrapTime + ElapsedTime; + true -> TrapTime + end, + timetrap(TrapTime, TotalTime, Pid), + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); + {user_timetrap,_OldPid,_TrapTime,_} -> + %% a timetrap for a previous test case triggered, ignore + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); _Other when not is_tuple(_Other) -> %% ignore anything not generated by test server - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); _Other when element(1, _Other) /= 'EXIT', element(1, _Other) /= started, element(1, _Other) /= finished, element(1, _Other) /= print -> %% ignore anything not generated by test server - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf) + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status) after Timeout -> ReturnValue end. @@ -1177,9 +1274,11 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, put(test_server_multiply_timetraps, TimetrapData), put(test_server_logopts, LogOpts), + FWInitResult = test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0], + {ok,Args0}), + group_leader() ! {test_case_initialized,self()}, {{Time,Value},Loc,Opts} = - case test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0], - {ok,Args0}) of + case FWInitResult of {ok,Args} -> run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback); Error = {error,_Reason} -> @@ -2020,24 +2119,44 @@ timetrap_scale_factor() -> %% %% Creates a time trap, that will kill the calling process if the %% trap is not cancelled with timetrap_cancel/1, within Timeout milliseconds. -timetrap(Timeout0) -> - Timeout = time_ms(Timeout0), +timetrap(Timeout) -> + timetrap(Timeout, self()). + +timetrap(Timeout, TCPid) -> + timetrap(Timeout, Timeout, TCPid). + +timetrap(Timeout0, TimeToReport0, TCPid) -> + Timeout = time_ms(Timeout0, TCPid), + TimeToReport = if Timeout0 == TimeToReport0 -> + Timeout; + true -> + time_ms_check(TimeToReport0) + end, cancel_default_timetrap(), case get(test_server_multiply_timetraps) of - undefined -> timetrap1(Timeout, true); - {undefined,false} -> timetrap1(Timeout, false); - {undefined,_} -> timetrap1(Timeout, true); - {infinity,_} -> infinity; - {_Int,_Scale} when Timeout == infinity -> infinity; - {Int,Scale} -> timetrap1(Timeout*Int, Scale) + undefined -> timetrap1(Timeout, TimeToReport, TCPid, true); + {undefined,false} -> timetrap1(Timeout, TimeToReport, TCPid, false); + {undefined,_} -> timetrap1(Timeout, TimeToReport, TCPid, true); + {infinity,_} -> timetrap1(infinity, TimeToReport, TCPid, false); + {_Int,_Scale} when Timeout == infinity -> + timetrap1(infinity, TimeToReport, TCPid, false); + {Int,Scale} -> timetrap1(Timeout*Int, TimeToReport*Int, TCPid, Scale) end. -timetrap1(Timeout, Scale) -> - TCPid = self(), - Ref = spawn_link(test_server_sup,timetrap,[Timeout,Scale,TCPid]), +timetrap1(Timeout, TimeToReport, TCPid, Scale) -> + Ref = case Timeout of + infinity -> + infinity; + _ -> + spawn_link(test_server_sup,timetrap,[Timeout,TimeToReport, + Scale,TCPid]) + end, case get(test_server_timetraps) of - undefined -> put(test_server_timetraps,[{Ref,TCPid,{Timeout,Scale}}]); - List -> put(test_server_timetraps,[{Ref,TCPid,{Timeout,Scale}}|List]) + undefined -> + put(test_server_timetraps,[{Ref,TCPid,{TimeToReport,Scale}}]); + List -> + List1 = lists:delete({infinity,TCPid,{infinity,false}}, List), + put(test_server_timetraps,[{Ref,TCPid,{TimeToReport,Scale}}|List1]) end, Ref. @@ -2082,61 +2201,95 @@ cancel_default_timetrap() -> error end. - -time_ms({hours,N}) -> hours(N); -time_ms({minutes,N}) -> minutes(N); -time_ms({seconds,N}) -> seconds(N); -time_ms({Other,_N}) -> +time_ms({hours,N}, _) -> hours(N); +time_ms({minutes,N}, _) -> minutes(N); +time_ms({seconds,N}, _) -> seconds(N); +time_ms({Other,_N}, _) -> format("=== ERROR: Invalid time specification: ~p. " "Should be seconds, minutes, or hours.~n", [Other]), exit({invalid_time_format,Other}); -time_ms(Ms) when is_integer(Ms) -> Ms; -time_ms(infinity) -> infinity; -time_ms(Fun) when is_function(Fun) -> - time_ms_apply(Fun); -time_ms({M,F,A}=MFA) when is_atom(M), is_atom(F), is_list(A) -> - time_ms_apply(MFA); -time_ms(Other) -> exit({invalid_time_format,Other}). - -time_ms_apply(Func) -> - time_ms_apply(Func, [5000,30000,60000,infinity]). - -time_ms_apply(Func, TOs) -> - Apply = fun() -> - case Func of - {M,F,A} -> - exit({self(),apply(M, F, A)}); - Fun -> - exit({self(),Fun()}) - end - end, - Pid = spawn(Apply), - Ref = monitor(process, Pid), - time_ms_wait(Func, Pid, Ref, TOs). - -time_ms_wait(Func, Pid, Ref, [TO|TOs]) -> - receive - {'DOWN',Ref,process,Pid,{Pid,Result}} -> - time_ms_check(Result); - {'DOWN',Ref,process,Pid,Error} -> - exit({timetrap_error,Error}) - after - TO -> - format("=== WARNING: No return from timetrap function ~p~n", [Func]), - time_ms_wait(Func, Pid, Ref, TOs) - end; -%% this clause will never execute if 'infinity' is in TOs list, that's ok! -time_ms_wait(Func, Pid, Ref, []) -> - demonitor(Ref), - exit(Pid, kill), - exit({timetrap_error,{no_return_from_timetrap_function,Func}}). +time_ms(Ms, _) when is_integer(Ms) -> Ms; +time_ms(infinity, _) -> infinity; +time_ms(Fun, TCPid) when is_function(Fun) -> + time_ms_apply(Fun, TCPid); +time_ms({M,F,A}=MFA, TCPid) when is_atom(M), is_atom(F), is_list(A) -> + time_ms_apply(MFA, TCPid); +time_ms(Other, _) -> exit({invalid_time_format,Other}). time_ms_check(MFA = {M,F,A}) when is_atom(M), is_atom(F), is_list(A) -> - exit({invalid_time_format,MFA}); + MFA; time_ms_check(Fun) when is_function(Fun) -> - exit({invalid_time_format,Fun}); + Fun; time_ms_check(Other) -> - time_ms(Other). + time_ms(Other, undefined). + +time_ms_apply(Func, TCPid) -> + {_,GL} = process_info(TCPid, group_leader), + WhoAmI = self(), % either TC or IO server + UserTTSup = + spawn_link(fun() -> + user_timetrap_supervisor(Func, WhoAmI, TCPid, GL) + end), + receive + {UserTTSup,infinity} -> + %% we need to make sure the user timetrap function + %% gets time to execute and return + timetrap(infinity, TCPid) + after 5000 -> + exit(UserTTSup, kill), + if WhoAmI /= GL -> + exit({user_timetrap_error,time_ms_apply}); + true -> + format("=== ERROR: User timetrap execution failed!", []), + ignore + end + end. + +user_timetrap_supervisor(Func, Spawner, TCPid, GL) -> + process_flag(trap_exit, true), + Spawner ! {self(),infinity}, + MonRef = monitor(process, TCPid), + UserTTSup = self(), + group_leader(GL, UserTTSup), + UserTT = spawn_link(fun() -> call_user_timetrap(Func, UserTTSup) end), + T0 = now(), + receive + {UserTT,Result} -> + demonitor(MonRef, [flush]), + Elapsed = trunc(timer:now_diff(now(), T0) / 1000), + try time_ms_check(Result) of + TimeVal -> + %% this is the new timetrap value to set (return value + %% from a fun or an MFA) + GL ! {user_timetrap,TCPid,TimeVal,Elapsed} + catch _:_ -> + %% when other than a legal timetrap value is returned + %% which will be the normal case for user timetraps + GL ! {user_timetrap,TCPid,0,Elapsed} + end; + {'EXIT',UserTT,Error} when Error /= normal -> + demonitor(MonRef, [flush]), + GL ! {user_timetrap,TCPid,0,{user_timetrap_error,Error}}; + + {'DOWN',MonRef,_,_,_} -> + demonitor(MonRef, [flush]), + exit(UserTT, kill) + end. + +call_user_timetrap(Func, Sup) when is_function(Func) -> + try Func() of + Result -> + Sup ! {self(),Result} + catch _:Error -> + exit({Error,erlang:get_stacktrace()}) + end; +call_user_timetrap({M,F,A}, Sup) -> + try apply(M,F,A) of + Result -> + Sup ! {self(),Result} + catch _:Error -> + exit({Error,erlang:get_stacktrace()}) + end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% timetrap_cancel(Handle) -> ok diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 875f45eea6..d85d1658c3 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -21,7 +21,8 @@ %%% Purpose: Test server support functions. %%%------------------------------------------------------------------- -module(test_server_sup). --export([timetrap/2, timetrap/3, timetrap_cancel/1, capture_get/1, messages_get/1, +-export([timetrap/2, timetrap/3, timetrap/4, + timetrap_cancel/1, capture_get/1, messages_get/1, timecall/3, call_crash/5, app_test/2, check_new_crash_dumps/0, cleanup_crash_dumps/0, crash_dump_dir/0, tar_crash_dumps/0, get_username/0, get_os_family/0, @@ -44,9 +45,12 @@ %% delays during the test (e.g. if cover is running). timetrap(Timeout0, Pid) -> - timetrap(Timeout0, true, Pid). + timetrap(Timeout0, Timeout0, true, Pid). timetrap(Timeout0, Scale, Pid) -> + timetrap(Timeout0, Timeout0, Scale, Pid). + +timetrap(Timeout0, ReportTVal, Scale, Pid) -> process_flag(priority, max), Timeout = if not Scale -> Timeout0; true -> test_server:timetrap_scale_factor() * Timeout0 @@ -54,28 +58,36 @@ timetrap(Timeout0, Scale, Pid) -> TruncTO = trunc(Timeout), receive after TruncTO -> - MFLs = test_server:get_loc(Pid), - Mon = erlang:monitor(process, Pid), - Trap = - case get(test_server_init_or_end_conf) of - undefined -> - {timetrap_timeout,TruncTO,MFLs}; - InitOrEnd -> - {timetrap_timeout,TruncTO,MFLs,InitOrEnd} - end, - exit(Pid, Trap), - receive - {'DOWN', Mon, process, Pid, _} -> + case is_process_alive(Pid) of + true -> + TimeToReport = if Timeout0 == ReportTVal -> TruncTO; + true -> ReportTVal end, + MFLs = test_server:get_loc(Pid), + Mon = erlang:monitor(process, Pid), + Trap = + case get(test_server_init_or_end_conf) of + undefined -> + {timetrap_timeout,TimeToReport,MFLs}; + InitOrEnd -> + {timetrap_timeout,TimeToReport,MFLs,InitOrEnd} + end, + exit(Pid, Trap), + receive + {'DOWN', Mon, process, Pid, _} -> + ok + after 10000 -> + %% Pid is probably trapping exits, hit it harder... + catch error_logger:warning_msg( + "Testcase process ~p not " + "responding to timetrap " + "timeout:~n" + " ~p.~n" + "Killing testcase...~n", + [Pid, Trap]), + exit(Pid, kill) + end; + false -> ok - after 10000 -> - %% Pid is probably trapping exits, hit it harder... - catch error_logger:warning_msg("Testcase process ~p not " - "responding to timetrap " - "timeout:~n" - " ~p.~n" - "Killing testcase...~n", - [Pid, Trap]), - exit(Pid, kill) end end. -- cgit v1.2.3 From 88c935d87a9878016e07b5a3f42bc8efe30b1eea Mon Sep 17 00:00:00 2001 From: Peter Andersson Date: Thu, 22 Mar 2012 18:46:41 +0100 Subject: Fix various problems with the user timetrap implementation --- lib/test_server/src/test_server.erl | 292 +++++++++++++++++++++++--------- lib/test_server/src/test_server_sup.erl | 10 +- 2 files changed, 215 insertions(+), 87 deletions(-) (limited to 'lib/test_server') diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 7baae966c9..96d2e2b80e 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -646,6 +646,9 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, {Timeout,ReturnValue} = case Terminate of {true, ReturnVal} -> + %% stop any timetrap timers for the test case + %% that have been started by this process + timetrap_cancel_all(Pid, false), {20, ReturnVal}; false -> {infinity, should_never_appear} @@ -1010,25 +1013,42 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, Comment,CurrConf,Status); - {user_timetrap,Pid,_TrapTime,Error={user_timetrap_error,_}} -> - self() ! {abort_current_testcase,Error,Pid}, + {user_timetrap,Pid,_TrapTime,StartTime,E={user_timetrap_error,_},_} -> + case update_user_timetraps(Pid, StartTime) of + proceed -> + self() ! {abort_current_testcase,E,Pid}; + ignore -> + ok + end, run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, Comment,CurrConf,Status); - {user_timetrap,Pid,0,ElapsedTime} -> - %% a user timetrap is triggered, use the test case execution - %% time as timeout value for the error report - timetrap(0, ElapsedTime, Pid), + {user_timetrap,Pid,TrapTime,StartTime,ElapsedTime,Scale} -> + %% a user timetrap is triggered, ignore it if new + %% timetrap has been started since + case update_user_timetraps(Pid, StartTime) of + proceed -> + TotalTime = if is_integer(TrapTime) -> + TrapTime + ElapsedTime; + true -> + TrapTime + end, + timetrap(TrapTime, TotalTime, Pid, Scale); + ignore -> + ok + end, run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, Comment,CurrConf,Status); - {user_timetrap,Pid,TrapTime,ElapsedTime} -> - TotalTime = if is_integer(TrapTime) -> TrapTime + ElapsedTime; - true -> TrapTime - end, - timetrap(TrapTime, TotalTime, Pid), + {timetrap_cancel_one,Handle,_From} -> + timetrap_cancel_one(Handle, false), + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); + {timetrap_cancel_all,TCPid,_From} -> + timetrap_cancel_all(TCPid, false), run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, Comment,CurrConf,Status); - {user_timetrap,_OldPid,_TrapTime,_} -> - %% a timetrap for a previous test case triggered, ignore + {get_timetrap_info,TCPid,From} -> + Info = get_timetrap_info(TCPid, false), + From ! {self(),get_timetrap_info,Info}, run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, Comment,CurrConf,Status); _Other when not is_tuple(_Other) -> @@ -1273,7 +1293,6 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, TimetrapData, LogOpts, TCCallback) -> put(test_server_multiply_timetraps, TimetrapData), put(test_server_logopts, LogOpts), - FWInitResult = test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0], {ok,Args0}), group_leader() ! {test_case_initialized,self()}, @@ -2120,45 +2139,55 @@ timetrap_scale_factor() -> %% Creates a time trap, that will kill the calling process if the %% trap is not cancelled with timetrap_cancel/1, within Timeout milliseconds. timetrap(Timeout) -> - timetrap(Timeout, self()). - -timetrap(Timeout, TCPid) -> - timetrap(Timeout, Timeout, TCPid). - -timetrap(Timeout0, TimeToReport0, TCPid) -> - Timeout = time_ms(Timeout0, TCPid), + MultAndScale = + case get(test_server_multiply_timetraps) of + undefined -> {fun(T) -> T end, true}; + {undefined,false} -> {fun(T) -> T end, false}; + {undefined,_} -> {fun(T) -> T end, true}; + {infinity,_} -> {fun(_) -> infinity end, false}; + {Int,Scale} -> {fun(infinity) -> infinity; + (T) -> T*Int end, Scale} + end, + timetrap(Timeout, Timeout, self(), MultAndScale). + +%% when the function is called from different process than +%% the test case, the test_server_multiply_timetraps data +%% is unknown and must be passed as argument +timetrap(Timeout, TCPid, MultAndScale) -> + timetrap(Timeout, Timeout, TCPid, MultAndScale). + +timetrap(Timeout0, TimeToReport0, TCPid, MultAndScale = {Multiplier,Scale}) -> + %% the time_ms call will either convert Timeout to ms or spawn a + %% user timetrap which sends the result to the IO server process + Timeout = time_ms(Timeout0, TCPid, MultAndScale), + Timeout1 = Multiplier(Timeout), TimeToReport = if Timeout0 == TimeToReport0 -> - Timeout; + Timeout1; true -> + %% only convert to ms, don't start a + %% user timetrap time_ms_check(TimeToReport0) end, - cancel_default_timetrap(), - case get(test_server_multiply_timetraps) of - undefined -> timetrap1(Timeout, TimeToReport, TCPid, true); - {undefined,false} -> timetrap1(Timeout, TimeToReport, TCPid, false); - {undefined,_} -> timetrap1(Timeout, TimeToReport, TCPid, true); - {infinity,_} -> timetrap1(infinity, TimeToReport, TCPid, false); - {_Int,_Scale} when Timeout == infinity -> - timetrap1(infinity, TimeToReport, TCPid, false); - {Int,Scale} -> timetrap1(Timeout*Int, TimeToReport*Int, TCPid, Scale) - end. + cancel_default_timetrap(self() == TCPid), + Handle = case Timeout1 of + infinity -> + infinity; + _ -> + spawn_link(test_server_sup,timetrap,[Timeout1,TimeToReport, + Scale,TCPid]) + end, + + %% ERROR! This sets dict on IO process instead of testcase process + %% if Timeout is return value from previous user timetrap!! -timetrap1(Timeout, TimeToReport, TCPid, Scale) -> - Ref = case Timeout of - infinity -> - infinity; - _ -> - spawn_link(test_server_sup,timetrap,[Timeout,TimeToReport, - Scale,TCPid]) - end, case get(test_server_timetraps) of undefined -> - put(test_server_timetraps,[{Ref,TCPid,{TimeToReport,Scale}}]); + put(test_server_timetraps,[{Handle,TCPid,{TimeToReport,Scale}}]); List -> List1 = lists:delete({infinity,TCPid,{infinity,false}}, List), - put(test_server_timetraps,[{Ref,TCPid,{TimeToReport,Scale}}|List1]) + put(test_server_timetraps,[{Handle,TCPid,{TimeToReport,Scale}}|List1]) end, - Ref. + Handle. ensure_timetrap(Config) -> case get(test_server_timetraps) of @@ -2183,7 +2212,10 @@ ensure_timetrap(Config) -> put(test_server_default_timetrap, timetrap(seconds(DTmo))) end. -cancel_default_timetrap() -> +%% executing on IO process, no default timetrap ever set here +cancel_default_timetrap(false) -> + ok; +cancel_default_timetrap(true) -> case get(test_server_default_timetrap) of undefined -> ok; @@ -2201,40 +2233,44 @@ cancel_default_timetrap() -> error end. -time_ms({hours,N}, _) -> hours(N); -time_ms({minutes,N}, _) -> minutes(N); -time_ms({seconds,N}, _) -> seconds(N); -time_ms({Other,_N}, _) -> +time_ms({hours,N}, _, _) -> hours(N); +time_ms({minutes,N}, _, _) -> minutes(N); +time_ms({seconds,N}, _, _) -> seconds(N); +time_ms({Other,_N}, _, _) -> format("=== ERROR: Invalid time specification: ~p. " "Should be seconds, minutes, or hours.~n", [Other]), exit({invalid_time_format,Other}); -time_ms(Ms, _) when is_integer(Ms) -> Ms; -time_ms(infinity, _) -> infinity; -time_ms(Fun, TCPid) when is_function(Fun) -> - time_ms_apply(Fun, TCPid); -time_ms({M,F,A}=MFA, TCPid) when is_atom(M), is_atom(F), is_list(A) -> - time_ms_apply(MFA, TCPid); -time_ms(Other, _) -> exit({invalid_time_format,Other}). +time_ms(Ms, _, _) when is_integer(Ms) -> Ms; +time_ms(infinity, _, _) -> infinity; +time_ms(Fun, TCPid, MultAndScale) when is_function(Fun) -> + time_ms_apply(Fun, TCPid, MultAndScale); +time_ms({M,F,A}=MFA, TCPid, MultAndScale) when is_atom(M), is_atom(F), is_list(A) -> + time_ms_apply(MFA, TCPid, MultAndScale); +time_ms(Other, _, _) -> exit({invalid_time_format,Other}). time_ms_check(MFA = {M,F,A}) when is_atom(M), is_atom(F), is_list(A) -> MFA; time_ms_check(Fun) when is_function(Fun) -> Fun; time_ms_check(Other) -> - time_ms(Other, undefined). + time_ms(Other, undefined, undefined). -time_ms_apply(Func, TCPid) -> +time_ms_apply(Func, TCPid, MultAndScale) -> {_,GL} = process_info(TCPid, group_leader), WhoAmI = self(), % either TC or IO server + T0 = now(), UserTTSup = - spawn_link(fun() -> - user_timetrap_supervisor(Func, WhoAmI, TCPid, GL) - end), + spawn(fun() -> + user_timetrap_supervisor(Func, WhoAmI, TCPid, + GL, T0, MultAndScale) + end), receive {UserTTSup,infinity} -> + %% remember the user timetrap so that it can be cancelled + save_user_timetrap(TCPid, UserTTSup, T0), %% we need to make sure the user timetrap function %% gets time to execute and return - timetrap(infinity, TCPid) + timetrap(infinity, TCPid, MultAndScale) after 5000 -> exit(UserTTSup, kill), if WhoAmI /= GL -> @@ -2243,16 +2279,15 @@ time_ms_apply(Func, TCPid) -> format("=== ERROR: User timetrap execution failed!", []), ignore end - end. + end. -user_timetrap_supervisor(Func, Spawner, TCPid, GL) -> +user_timetrap_supervisor(Func, Spawner, TCPid, GL, T0, MultAndScale) -> process_flag(trap_exit, true), Spawner ! {self(),infinity}, MonRef = monitor(process, TCPid), UserTTSup = self(), group_leader(GL, UserTTSup), UserTT = spawn_link(fun() -> call_user_timetrap(Func, UserTTSup) end), - T0 = now(), receive {UserTT,Result} -> demonitor(MonRef, [flush]), @@ -2261,16 +2296,16 @@ user_timetrap_supervisor(Func, Spawner, TCPid, GL) -> TimeVal -> %% this is the new timetrap value to set (return value %% from a fun or an MFA) - GL ! {user_timetrap,TCPid,TimeVal,Elapsed} + GL ! {user_timetrap,TCPid,TimeVal,T0,Elapsed,MultAndScale} catch _:_ -> %% when other than a legal timetrap value is returned %% which will be the normal case for user timetraps - GL ! {user_timetrap,TCPid,0,Elapsed} + GL ! {user_timetrap,TCPid,0,T0,Elapsed,MultAndScale} end; {'EXIT',UserTT,Error} when Error /= normal -> demonitor(MonRef, [flush]), - GL ! {user_timetrap,TCPid,0,{user_timetrap_error,Error}}; - + GL ! {user_timetrap,TCPid,0,T0,{user_timetrap_error,Error}, + MultAndScale}; {'DOWN',MonRef,_,_,_} -> demonitor(MonRef, [flush]), exit(UserTT, kill) @@ -2291,19 +2326,82 @@ call_user_timetrap({M,F,A}, Sup) -> exit({Error,erlang:get_stacktrace()}) end. +save_user_timetrap(TCPid, UserTTSup, StartTime) -> + %% save pid of user timetrap supervisor process so that + %% it may be stopped even before the timetrap func has returned + NewUserTT = {TCPid,{UserTTSup,StartTime}}, + case get(test_server_user_timetrap) of + undefined -> + put(test_server_user_timetrap, [NewUserTT]); + UserTTSups -> + case proplists:get_value(TCPid, UserTTSups) of + undefined -> + put(test_server_user_timetrap, + [NewUserTT | UserTTSups]); + PrevTTSup -> + %% remove prev user timetrap + remove_user_timetrap(PrevTTSup), + put(test_server_user_timetrap, + [NewUserTT | proplists:delete(TCPid, + UserTTSups)]) + end + end. + +update_user_timetraps(TCPid, StartTime) -> + %% called when a user timetrap is triggered + case get(test_server_user_timetrap) of + undefined -> + proceed; + UserTTs -> + case proplists:get_value(TCPid, UserTTs) of + {_UserTTSup,StartTime} -> % same timetrap + put(test_server_user_timetrap, + proplists:delete(TCPid, UserTTs)), + proceed; + {OtherUserTTSup,OtherStartTime} -> + case timer:now_diff(OtherStartTime, StartTime) of + Diff when Diff >= 0 -> + ignore; + _ -> + exit(OtherUserTTSup, kill), + put(test_server_user_timetrap, + proplists:delete(TCPid, UserTTs)), + proceed + end; + undefined -> + proceed + end + end. + +remove_user_timetrap(TTSup) -> + exit(TTSup, kill). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% timetrap_cancel(Handle) -> ok %% Handle = term() %% %% Cancels a time trap. -timetrap_cancel(infinity) -> - ok; timetrap_cancel(Handle) -> + timetrap_cancel_one(Handle, true). + +timetrap_cancel_one(infinity, _SendToServer) -> + ok; +timetrap_cancel_one(Handle, SendToServer) -> case get(test_server_timetraps) of - undefined -> ok; - [{Handle,_,_}] -> erase(test_server_timetraps); - Timers -> put(test_server_timetraps, - lists:keydelete(Handle, 1, Timers)) + undefined -> + ok; + [{Handle,_,_}] -> + erase(test_server_timetraps); + Timers -> + case lists:keysearch(Handle, 1, Timers) of + {value,_} -> + put(test_server_timetraps, + lists:keydelete(Handle, 1, Timers)); + false when SendToServer == true -> + group_leader() ! {timetrap_cancel_one,Handle,self()}; + false -> + ok + end end, test_server_sup:timetrap_cancel(Handle). @@ -2312,31 +2410,59 @@ timetrap_cancel(Handle) -> %% %% Cancels timetrap for current test case. timetrap_cancel() -> + timetrap_cancel_all(self(), true). + +timetrap_cancel_all(TCPid, SendToServer) -> case get(test_server_timetraps) of undefined -> ok; Timers -> - case lists:keysearch(self(), 2, Timers) of - {value,{Handle,_,_}} -> - timetrap_cancel(Handle); - _ -> + [timetrap_cancel_one(Handle, false) || + {Handle,Pid,_} <- Timers, Pid == TCPid] + end, + case get(test_server_user_timetrap) of + undefined -> + ok; + UserTTs -> + case proplists:get_value(TCPid, UserTTs) of + {UserTTSup,_StartTime} -> + remove_user_timetrap(UserTTSup), + put(test_server_user_timetrap, + proplists:delete(TCPid, UserTTs)); + undefined -> ok end - end. + end, + if SendToServer == true -> + group_leader() ! {timetrap_cancel_all,TCPid,self()}; + true -> + ok + end, + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% get_timetrap_info() -> {Timeout,Scale} | undefined %% %% Read timetrap info for current test case get_timetrap_info() -> + get_timetrap_info(self(), true). + +get_timetrap_info(TCPid, SendToServer) -> case get(test_server_timetraps) of undefined -> undefined; Timers -> - case lists:keysearch(self(), 2, Timers) of - {value,{_,_,Info}} -> - Info; - _ -> + case [Info || {Handle,Pid,Info} <- Timers, + Pid == TCPid, Handle /= infinity] of + [I|_] -> + I; + [] when SendToServer == true -> + MsgLooper = group_leader(), + MsgLooper ! {get_timetrap_info,TCPid,self()}, + receive + {MsgLooper,get_timetrap_info,I} -> I + end; + [] -> undefined end end. diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index d85d1658c3..68d6198bb7 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -100,8 +100,12 @@ timetrap_cancel(Handle) -> unlink(Handle), MonRef = erlang:monitor(process, Handle), exit(Handle, kill), - receive {'DOWN',MonRef,_,_,_} -> ok after 2000 -> ok end. - + receive {'DOWN',MonRef,_,_,_} -> ok + after + 2000 -> + erlang:demonitor(MonRef, [flush]), + ok + end. capture_get(Msgs) -> receive @@ -111,7 +115,6 @@ capture_get(Msgs) -> lists:reverse(Msgs) end. - messages_get(Msgs) -> receive Msg -> @@ -120,7 +123,6 @@ messages_get(Msgs) -> lists:reverse(Msgs) end. - timecall(M, F, A) -> Befor = erlang:now(), Val = apply(M, F, A), -- cgit v1.2.3