diff options
Diffstat (limited to 'lib/test_server')
| -rw-r--r-- | lib/test_server/src/test_server.erl | 648 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_sup.erl | 32 |
2 files changed, 242 insertions, 438 deletions
diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index bcffe896c4..57834120f7 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -28,7 +28,7 @@ -export([cover_compile/1,cover_analyse/2]). %%% TEST_SERVER_SUP INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([get_loc/1]). +-export([get_loc/1,set_tc_state/2]). %%% TEST SUITE INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -export([lookup_config/2]). @@ -605,6 +605,22 @@ run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> end end. +-type tc_status() :: 'starting' | 'running' | 'init_per_testcase' | + 'end_per_testcase' | {'framework',atom(),atom()} | + 'tc'. +-record(st, + { + ref :: reference(), + pid :: pid(), + mf :: {atom(),atom()}, + status :: tc_status() | 'undefined', + ret_val :: term(), + comment :: list(char()), + timeout :: non_neg_integer() | 'infinity', + config :: list() | 'undefined', + end_conf_pid :: pid() | 'undefined' + }). + do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> {ok,Cwd} = file:get_cwd(), Args2Print = case Args of @@ -628,8 +644,9 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> LogOpts, TCCallback) end), put(test_server_detected_fail, []), - run_test_case_msgloop(Ref, Pid, false, "", - undefined, starting). + St = #st{ref=Ref,pid=Pid,mf={Mod,Func},status=starting,ret_val=[], + comment="",timeout=infinity,config=undefined}, + run_test_case_msgloop(St). %% Ugly bug (pre R5A): %% If this process (group leader of the test case) terminates before @@ -640,31 +657,19 @@ 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, Terminate, Comment, CurrConf, Status) -> - %% NOTE: Keep job_proxy_msgloop/0 up to date when changes - %% are made in this function! - {Timeout,ReturnValue} = - case Terminate of - {true, ReturnVal} -> - %% stop any timetrap timers for the test case - %% that have been started by this process - timetrap_cancel_all(Pid, false), - {20, ReturnVal}; - false -> - {infinity, should_never_appear} - end, +run_test_case_msgloop(#st{ref=Ref,pid=Pid,end_conf_pid=EndConfPid0}=St0) -> receive - {test_case_initialized,Pid} -> - run_test_case_msgloop(Ref,Pid,Terminate, - Comment,CurrConf,running); - Abort = {abort_current_testcase,_,_} when Status == starting -> + {set_tc_state=Tag,From,{Status,Config}} -> + St = St0#st{status=Status,config=Config}, + From ! {self(),Tag,ok}, + run_test_case_msgloop(St); + {abort_current_testcase,_,_}=Abort when St0#st.status =:= starting -> %% we're in init phase, must must postpone this operation %% until test case execution is in progress (or FW:init_tc %% gets killed) self() ! Abort, erlang:yield(), - run_test_case_msgloop(Ref,Pid,Terminate, - Comment,CurrConf,Status); + run_test_case_msgloop(St0); {abort_current_testcase,Reason,From} -> Line = case is_process_alive(Pid) of true -> get_loc(Pid); @@ -674,65 +679,49 @@ run_test_case_msgloop(Ref, Pid, Terminate, Comment, CurrConf, Status) -> exit(Pid,{testcase_aborted,Reason,Line}), erlang:yield(), From ! {self(),abort_current_testcase,ok}, - NewComment = - receive - {'DOWN', Mon, process, Pid, _} -> - Comment - after 10000 -> - %% Pid is probably trapping exits, hit it harder... - exit(Pid, kill), - %% here's the only place we know Reason, so we save - %% it as a comment, potentially replacing user data - Error = lists:flatten(io_lib:format("Aborted: ~p", - [Reason])), - Error1 = lists:flatten([string:strip(S,left) || + St = receive + {'DOWN', Mon, process, Pid, _} -> + St0 + after 10000 -> + %% Pid is probably trapping exits, hit it harder... + exit(Pid, kill), + %% here's the only place we know Reason, so we save + %% it as a comment, potentially replacing user data + Error = lists:flatten(io_lib:format("Aborted: ~p", + [Reason])), + Error1 = lists:flatten([string:strip(S,left) || S <- string:tokens(Error, [$\n])]), - if length(Error1) > 63 -> - string:substr(Error1,1,60) ++ "..."; - true -> - Error1 - end - end, - run_test_case_msgloop(Ref,Pid,Terminate, - NewComment,CurrConf,Status); + Comment = if length(Error1) > 63 -> + string:substr(Error1,1,60) ++ "..."; + true -> + Error1 + end, + St0#st{comment=Comment} + end, + run_test_case_msgloop(St); {sync_apply,From,MFA} -> sync_local_or_remote_apply(false,From,MFA), - run_test_case_msgloop(Ref,Pid,Terminate, - Comment,CurrConf,Status); + run_test_case_msgloop(St0); {sync_apply_proxy,Proxy,From,MFA} -> sync_local_or_remote_apply(Proxy,From,MFA), - run_test_case_msgloop(Ref,Pid,Terminate, - Comment,CurrConf,Status); - {comment,NewComment} -> - NewComment1 = test_server_ctrl:to_string(NewComment), - NewComment2 = test_server_sup:framework_call(format_comment, - [NewComment1], - NewComment1), - Terminate1 = - case Terminate of - {true,{Time,Value,Loc,Opts,_OldComment}} -> - {true,{Time,Value,mod_loc(Loc),Opts,NewComment2}}; - Other -> - Other - end, - run_test_case_msgloop(Ref,Pid,Terminate1, - NewComment2,CurrConf,Status); + run_test_case_msgloop(St0); + {comment,NewComment0} -> + NewComment1 = test_server_ctrl:to_string(NewComment0), + NewComment = test_server_sup:framework_call(format_comment, + [NewComment1], + NewComment1), + run_test_case_msgloop(St0#st{comment=NewComment}); {read_comment,From} -> - From ! {self(),read_comment,Comment}, - run_test_case_msgloop(Ref,Pid,Terminate, - Comment,CurrConf,Status); - {set_curr_conf,From,NewCurrConf} -> - From ! {self(),set_curr_conf,ok}, - 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,Terminate, - Comment,CurrConf,Status); + From ! {self(),read_comment,St0#st.comment}, + run_test_case_msgloop(St0); {make_priv_dir,From} -> + Config = case St0#st.config of + undefined -> []; + Config0 -> Config0 + end, Result = - case proplists:get_value(priv_dir, element(2, CurrConf)) of + case proplists:get_value(priv_dir, Config) of undefined -> {error,no_priv_dir_in_config}; PrivDir -> @@ -746,207 +735,63 @@ run_test_case_msgloop(Ref, Pid, Terminate, Comment, CurrConf, Status) -> end end, From ! {self(),make_priv_dir,Result}, - run_test_case_msgloop(Ref,Pid,Terminate, - Comment,CurrConf,Status); + run_test_case_msgloop(St0); {'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} -> - RetVal = {Time/1000000,Value,mod_loc(Loc),Opts,Comment}, - run_test_case_msgloop(Ref,Pid, - {true,RetVal},Comment,undefined,Status); + RetVal = {Time/1000000,Value,Loc,Opts}, + St = setup_termination(RetVal, St0#st{config=undefined}), + run_test_case_msgloop(St); {'EXIT',Pid,Reason} -> - case Reason of - {timetrap_timeout,TVal,Loc} -> - %% convert Loc to form that can be formatted - case mod_loc(Loc) of - {FwMod,FwFunc,framework} -> - %% timout during framework call - spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, - {framework_error,{timetrap,TVal}}, - unknown,self()), - run_test_case_msgloop(Ref,Pid, - Terminate,Comment, - undefined,Status); - Loc1 -> - %% call end_per_testcase on a separate process, - %% only so that the user has a chance to - %% clean up after init_per_testcase, even after - %% a timetrap timeout - NewCurrConf = - case CurrConf of - {{Mod,Func},Conf} -> - EndConfPid = - call_end_conf( - Mod,Func,Pid, - {timetrap_timeout,TVal}, - Loc1,[{tc_status, - {failed, - timetrap_timeout}}|Conf], - TVal), - {EndConfPid,{Mod,Func},Conf}; - _ -> - {Mod,Func} = get_mf(Loc1), - %% The framework functions mustn't - %% execute on this group leader process - %% or io will cause deadlock, so we - %% spawn a dedicated process for the - %% operation and let the group leader - %% go back to handle io. - spawn_fw_call(Mod,Func,CurrConf,Pid, - {timetrap_timeout,TVal}, - Loc1,self()), - undefined - end, - run_test_case_msgloop(Ref,Pid, - Terminate,Comment, - NewCurrConf,Status) - end; - {timetrap_timeout,TVal,Loc,InitOrEnd} -> - case mod_loc(Loc) of - {FwMod,FwFunc,framework} -> - %% timout during framework call - spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, - {framework_error,{timetrap,TVal}}, - unknown,self()); - Loc1 -> - {Mod,_Func} = get_mf(Loc1), - spawn_fw_call(Mod,InitOrEnd,CurrConf,Pid, - {timetrap_timeout,TVal}, - Loc1,self()) - end, - run_test_case_msgloop(Ref,Pid, - 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, - Terminate,Comment, - undefined,Status); - {testcase_aborted,AbortReason,AbortLoc} -> - ErrorMsg = {testcase_aborted,AbortReason}, - case mod_loc(AbortLoc) of - {FwMod,FwFunc,framework} -> - %% abort during framework call - spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, - {framework_error,ErrorMsg}, - unknown,self()), - run_test_case_msgloop(Ref,Pid, - Terminate,Comment, - undefined,Status); - Loc1 -> - %% call end_per_testcase on a separate process, - %% only so that the user has a chance to clean up - %% after init_per_testcase, even after abortion - NewCurrConf = - case CurrConf of - {{Mod,Func},Conf} -> - TVal = - case lists:keysearch(default_timeout, - 1, - Conf) of - {value,{default_timeout,Tmo}} -> - Tmo; - _ -> - ?DEFAULT_TIMETRAP_SECS*1000 - end, - EndConfPid = - call_end_conf( - Mod,Func,Pid, - ErrorMsg,Loc1, - [{tc_status, - {failed,ErrorMsg}}|Conf],TVal), - {EndConfPid,{Mod,Func},Conf}; - _ -> - {Mod,Func} = get_mf(Loc1), - spawn_fw_call(Mod,Func,CurrConf,Pid, - ErrorMsg,Loc1,self()), - undefined - end, - run_test_case_msgloop(Ref,Pid, - Terminate,Comment, - NewCurrConf,Status) - end; - killed -> - %% result of an exit(TestCase,kill) call, which is the - %% only way to abort a testcase process that traps exits - %% (see abort_current_testcase) - {Mod,Func} = case CurrConf of - {MF,_} -> MF; - _ -> {undefined,undefined} - end, - spawn_fw_call(Mod,Func,CurrConf,Pid, - testcase_aborted_or_killed, - unknown,self()), - run_test_case_msgloop(Ref,Pid, - 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, - Terminate,Comment,CurrConf,Status); - _Other -> - %% the testcase has terminated because of Reason (e.g. an exit - %% because a linked process failed) - {Mod,Func} = case CurrConf of - {MF,_} -> MF; - _ -> {undefined,undefined} - end, - spawn_fw_call(Mod,Func,CurrConf,Pid, - Reason,unknown,self()), - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,CurrConf,Status) - end; - {EndConfPid,{call_end_conf,Data,_Result}} -> + St = handle_tc_exit(Reason, St0), + run_test_case_msgloop(St); + {EndConfPid0,{call_end_conf,Data,_Result}} -> + #st{mf={Mod,Func},config=CurrConf} = St0, case CurrConf of - {EndConfPid,{Mod,Func},_Conf} -> + _ when is_list(CurrConf) -> {_Mod,_Func,TCPid,TCExitReason,Loc} = Data, spawn_fw_call(Mod,Func,CurrConf,TCPid, TCExitReason,Loc,self()), - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,undefined,Status); + St = St0#st{config=undefined,end_conf_pid=undefined}, + run_test_case_msgloop(St); _ -> - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,CurrConf,Status) + run_test_case_msgloop(St0) end; {_FwCallPid,fw_notify_done,{T,Value,Loc,Opts,AddToComment}} -> %% the framework has been notified, we're finished - RetVal = - case AddToComment of - undefined -> - {T,Value,Loc,Opts,Comment}; - _ -> - Comment1 = - if Comment == "" -> - AddToComment; - true -> - Comment ++ - test_server_ctrl:xhtml("<br>", - "<br />") ++ - AddToComment - end, - {T,Value,Loc,Opts,Comment1} - end, - run_test_case_msgloop(Ref,Pid, - {true,RetVal},Comment,undefined,Status); + RetVal = {T,Value,Loc,Opts}, + Comment0 = St0#st.comment, + Comment = case AddToComment of + undefined -> + Comment0; + _ -> + if Comment0 =:= "" -> + AddToComment; + true -> + Comment0 ++ + test_server_ctrl:xhtml("<br>", + "<br />") ++ + AddToComment + end + end, + St = setup_termination(RetVal, St0#st{comment=Comment, + config=undefined}), + run_test_case_msgloop(St); {'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} -> %% a framework function failed CB = os:getenv("TEST_SERVER_FRAMEWORK"), Loc = case CB of FW when FW =:= false; FW =:= "undefined" -> - {test_server,Func}; + [{test_server,Func}]; _ -> - {list_to_atom(CB),Func} + [{list_to_atom(CB),Func}] end, - RetVal = {died,{framework_error,Loc,Error},Loc,"Framework error"}, - run_test_case_msgloop(Ref,Pid, - {true,RetVal},Comment,undefined,Status); + RetVal = {died,{framework_error,Loc,Error},Loc}, + St = setup_termination(RetVal, St0#st{comment="Framework error", + config=undefined}), + run_test_case_msgloop(St); {failed,File,Line} -> put(test_server_detected_fail, [{File, Line}| get(test_server_detected_fail)]), - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,CurrConf,Status); + run_test_case_msgloop(St0); {user_timetrap,Pid,_TrapTime,StartTime,E={user_timetrap_error,_},_} -> case update_user_timetraps(Pid, StartTime) of @@ -955,8 +800,7 @@ run_test_case_msgloop(Ref, Pid, Terminate, Comment, CurrConf, Status) -> ignore -> ok end, - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,CurrConf,Status); + run_test_case_msgloop(St0); {user_timetrap,Pid,TrapTime,StartTime,ElapsedTime,Scale} -> %% a user timetrap is triggered, ignore it if new %% timetrap has been started since @@ -971,36 +815,105 @@ run_test_case_msgloop(Ref, Pid, Terminate, Comment, CurrConf, Status) -> ignore -> ok end, - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,CurrConf,Status); + run_test_case_msgloop(St0); {timetrap_cancel_one,Handle,_From} -> timetrap_cancel_one(Handle, false), - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,CurrConf,Status); + run_test_case_msgloop(St0); {timetrap_cancel_all,TCPid,_From} -> timetrap_cancel_all(TCPid, false), - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,CurrConf,Status); + run_test_case_msgloop(St0); {get_timetrap_info,From,TCPid} -> Info = get_timetrap_info(TCPid, false), From ! {self(),get_timetrap_info,Info}, - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,CurrConf,Status); + run_test_case_msgloop(St0); _Other when not is_tuple(_Other) -> %% ignore anything not generated by test server - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,CurrConf,Status); + run_test_case_msgloop(St0); _Other when element(1, _Other) /= 'EXIT', element(1, _Other) /= started, element(1, _Other) /= finished, element(1, _Other) /= print -> %% ignore anything not generated by test server - run_test_case_msgloop(Ref,Pid, - Terminate,Comment,CurrConf,Status) - after Timeout -> - ReturnValue + run_test_case_msgloop(St0) + after St0#st.timeout -> + #st{ret_val=RetVal,comment=Comment} = St0, + erlang:append_element(RetVal, Comment) end. +setup_termination(RetVal, #st{pid=Pid}=St) -> + timetrap_cancel_all(Pid, false), + St#st{ret_val=RetVal,timeout=20}. + +set_tc_state(State, Config) -> + tc_supervisor_req(set_tc_state, {State,Config}). + +handle_tc_exit(killed, St) -> + %% probably the result of an exit(TestCase,kill) call, which is the + %% only way to abort a testcase process that traps exits + %% (see abort_current_testcase). + #st{config=Config,mf={Mod,Func},pid=Pid} = St, + Msg = testcase_aborted_or_killed, + spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()), + St; +handle_tc_exit({testcase_aborted,{user_timetrap_error,_}=Msg,_}, St) -> + #st{config=Config,mf={Mod,Func},pid=Pid} = St, + spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()), + St; +handle_tc_exit(Reason, #st{status={framework,FwMod,FwFunc}, + config=Config,pid=Pid}=St) -> + R = case Reason of + {timetrap_timeout,TVal,_} -> + {timetrap,TVal}; + {testcase_aborted=E,AbortReason,_} -> + {E,AbortReason}; + {fw_error,{FwMod,FwFunc,FwError}} -> + FwError; + Other -> + Other + end, + Error = {framework_error,R}, + spawn_fw_call(FwMod, FwFunc, Config, Pid, Error, unknown, self()), + St; +handle_tc_exit(Reason, #st{status=tc,config=Config0,mf={Mod,Func},pid=Pid}=St) + when is_list(Config0) -> + {R,Loc1,F} = case Reason of + {timetrap_timeout=E,TVal,Loc0} -> + {{E,TVal},Loc0,E}; + {testcase_aborted=E,AbortReason,Loc0} -> + Msg = {E,AbortReason}, + {Msg,Loc0,Msg}; + Other -> + {Other,unknown,Other} + end, + Timeout = end_conf_timeout(Reason, St), + Config = [{tc_status,{failed,F}}|Config0], + EndConfPid = call_end_conf(Mod, Func, Pid, R, Loc1, Config, Timeout), + St#st{end_conf_pid=EndConfPid}; +handle_tc_exit(Reason, #st{config=Config,mf={Mod,Func0},pid=Pid, + status=Status}=St) -> + {R,Loc1} = case Reason of + {timetrap_timeout=E,TVal,Loc0} -> + {{E,TVal},Loc0}; + {testcase_aborted=E,AbortReason,Loc0} -> + {{E,AbortReason},Loc0}; + Other -> + {Other,unknown} + end, + Func = case Status of + init_per_testcase=F -> {F,Func0}; + end_per_testcase=F -> {F,Func0}; + _ -> Func0 + end, + spawn_fw_call(Mod, Func, Config, Pid, R, Loc1, self()), + St. + +end_conf_timeout({timetrap_timeout,Timeout,_}, _) -> + Timeout; +end_conf_timeout(_, #st{config=Config}) when is_list(Config) -> + proplists:get_value(default_timeout, Config, ?DEFAULT_TIMETRAP_SECS*1000); +end_conf_timeout(_, _) -> + ?DEFAULT_TIMETRAP_SECS*1000. + call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) -> Starter = self(), Data = {Mod,Func,TCPid,TCExitReason,Loc}, @@ -1046,7 +959,7 @@ spawn_fw_call(Mod,{init_per_testcase,Func},_,Pid,{timetrap_timeout,TVal}=Why, Skip = {skip,{failed,{Mod,init_per_testcase,Why}}}, %% if init_per_testcase fails, the test case %% should be skipped - case catch do_end_tc_call(Mod,Func, Loc, {Pid,Skip,[[]]}, Why) of + case catch do_end_tc_call(Mod,Func, {Pid,Skip,[[]]}, Why) of {'EXIT',FwEndTCErr} -> exit({fw_notify_done,end_tc,FwEndTCErr}); _ -> @@ -1060,19 +973,10 @@ spawn_fw_call(Mod,{init_per_testcase,Func},_,Pid,{timetrap_timeout,TVal}=Why, spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid, {timetrap_timeout,TVal}=Why,_Loc,SendTo) -> - %%! This is a temporary fix that keeps Test Server alive during - %%! execution of a parallel test case group, when sometimes - %%! this clause gets called with EndConf == undefined. See OTP-9594 - %%! for more info. - EndConf1 = if EndConf == undefined -> - [{tc_status,{failed,{Mod,end_per_testcase,Why}}}]; - true -> - EndConf - end, FwCall = fun() -> {RetVal,Report} = - case proplists:get_value(tc_status, EndConf1) of + case proplists:get_value(tc_status, EndConf) of undefined -> E = {failed,{Mod,end_per_testcase,Why}}, {E,E}; @@ -1086,9 +990,9 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid, "WARNING! ~p:end_per_testcase(~p, ~p)" " failed!\n\tReason: timetrap timeout" " after ~w ms!\n", [Mod,Func,EndConf,TVal]}, - FailLoc = proplists:get_value(tc_fail_loc, EndConf1), - case catch do_end_tc_call(Mod,Func, FailLoc, - {Pid,Report,[EndConf1]}, Why) of + FailLoc = proplists:get_value(tc_fail_loc, EndConf), + case catch do_end_tc_call(Mod,Func, + {Pid,Report,[EndConf]}, Why) of {'EXIT',FwEndTCErr} -> exit({fw_notify_done,end_tc,FwEndTCErr}); _ -> @@ -1121,15 +1025,10 @@ spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) -> end, spawn_link(FwCall); -spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) -> - {Mod1,Func1} = - case {Mod,Func,CurrConf} of - {undefined,undefined,{{M,F},_}} -> {M,F}; - _ -> {Mod,Func} - end, +spawn_fw_call(Mod,Func,_CurrConf,Pid,Error,Loc,SendTo) -> FwCall = fun() -> - case catch fw_error_notify(Mod1,Func1,[], + case catch fw_error_notify(Mod,Func,[], Error,Loc) of {'EXIT',FwErrorNotifyErr} -> exit({fw_notify_done,error_notification, @@ -1138,7 +1037,7 @@ spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) -> ok end, Conf = [{tc_status,{failed,timetrap_timeout}}], - case catch do_end_tc_call(Mod1,Func1, Loc, + case catch do_end_tc_call(Mod,Func, {Pid,Error,[Conf]},Error) of {'EXIT',FwEndTCErr} -> exit({fw_notify_done,end_tc,FwEndTCErr}); @@ -1203,81 +1102,73 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, TimetrapData, LogOpts, TCCallback) -> put(test_server_multiply_timetraps, TimetrapData), put(test_server_logopts, LogOpts), + Where = [{Mod,Func}], + put(test_server_loc, Where), FWInitResult = test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0], {ok,Args0}), - group_leader() ! {test_case_initialized,self()}, + set_tc_state(running, undefined), {{Time,Value},Loc,Opts} = case FWInitResult of {ok,Args} -> run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback); Error = {error,_Reason} -> - Where = {Mod,Func}, - NewResult = do_end_tc_call(Mod,Func, Where, {Error,Args0}, + NewResult = do_end_tc_call(Mod,Func, {Error,Args0}, {skip,{failed,Error}}), {{0,NewResult},Where,[]}; {fail,Reason} -> Conf = [{tc_status,{failed,Reason}} | hd(Args0)], - Where = {Mod,Func}, fw_error_notify(Mod, Func, Conf, Reason), - NewResult = do_end_tc_call(Mod,Func, Where, {{error,Reason},[Conf]}, + NewResult = do_end_tc_call(Mod,Func, {{error,Reason},[Conf]}, {fail,Reason}), {{0,NewResult},Where,[]}; Skip = {skip,_Reason} -> - Where = {Mod,Func}, - NewResult = do_end_tc_call(Mod,Func, Where, {Skip,Args0}, Skip), + NewResult = do_end_tc_call(Mod,Func, {Skip,Args0}, Skip), {{0,NewResult},Where,[]}; {auto_skip,Reason} -> - Where = {Mod,Func}, - NewResult = do_end_tc_call(Mod,Func, Where, {{skip,Reason},Args0}, + NewResult = do_end_tc_call(Mod,Func, {{skip,Reason},Args0}, {skip,Reason}), {{0,NewResult},Where,[]} end, exit({Ref,Time,Value,Loc,Opts}). run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> - %% save current state in controller loop - 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}), - put(test_server_loc, {Mod,{init_per_testcase,Func}}), + set_tc_state(init_per_testcase, hd(Args)), ensure_timetrap(Args), case init_per_testcase(Mod, Func, Args) of Skip = {skip,Reason} -> Line = get_loc(), Conf = [{tc_status,{skipped,Reason}}], - NewRes = do_end_tc_call(Mod,Func, Line, {Skip,[Conf]}, Skip), + NewRes = do_end_tc_call(Mod,Func, {Skip,[Conf]}, Skip), {{0,NewRes},Line,[]}; {skip_and_save,Reason,SaveCfg} -> Line = get_loc(), Conf = [{tc_status,{skipped,Reason}},{save_config,SaveCfg}], - NewRes = do_end_tc_call(Mod,Func, Line, {{skip,Reason},[Conf]}, + NewRes = do_end_tc_call(Mod,Func, {{skip,Reason},[Conf]}, {skip,Reason}), {{0,NewRes},Line,[]}; FailTC = {fail,Reason} -> % user fails the testcase EndConf = [{tc_status,{failed,Reason}} | hd(Args)], fw_error_notify(Mod, Func, EndConf, Reason), - NewRes = do_end_tc_call(Mod,Func, {Mod,Func}, + NewRes = do_end_tc_call(Mod,Func, {{error,Reason},[EndConf]}, FailTC), - {{0,NewRes},{Mod,Func},[]}; + {{0,NewRes},[{Mod,Func}],[]}; {ok,NewConf} -> - put(test_server_init_or_end_conf,undefined), %% call user callback function if defined NewConf1 = user_callback(TCCallback, Mod, Func, init, NewConf), %% save current state in controller loop - tc_supervisor_req(set_curr_conf, {{Mod,Func},NewConf1}), - put(test_server_loc, {Mod,Func}), + set_tc_state(tc, NewConf1), %% execute the test case {{T,Return},Loc} = {ts_tc(Mod, Func, [NewConf1]),get_loc()}, {EndConf,TSReturn,FWReturn} = case Return of {E,TCError} when E=='EXIT' ; E==failed -> - ModLoc = mod_loc(Loc), fw_error_notify(Mod, Func, NewConf1, - TCError, ModLoc), + TCError, Loc), {[{tc_status,{failed,TCError}}, - {tc_fail_loc,ModLoc}|NewConf1], + {tc_fail_loc,Loc}|NewConf1], Return,{error,TCError}}; SaveCfg={save_config,_} -> {[{tc_status,ok},SaveCfg|NewConf1],Return,ok}; @@ -1294,7 +1185,6 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> %% call user callback function if defined EndConf1 = user_callback(TCCallback, Mod, Func, 'end', EndConf), %% update current state in controller loop - tc_supervisor_req(set_curr_conf, EndConf1), {FWReturn1,TSReturn1,EndConf2} = case end_per_testcase(Mod, Func, EndConf1) of SaveCfg1={save_config,_} -> @@ -1314,23 +1204,21 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> {FWReturn,TSReturn,EndConf1} end, %% clear current state in controller loop - tc_supervisor_req(set_curr_conf, undefined), - put(test_server_init_or_end_conf,undefined), - case do_end_tc_call(Mod,Func, Loc, + case do_end_tc_call(Mod,Func, {FWReturn1,[EndConf2]}, TSReturn1) of {failed,Reason} = NewReturn -> fw_error_notify(Mod,Func,EndConf2, Reason), - {{T,NewReturn},{Mod,Func},[]}; + {{T,NewReturn},[{Mod,Func}],[]}; NewReturn -> {{T,NewReturn},Loc,[]} end end; skip_init -> + set_tc_state(running, hd(Args)), %% call user callback function if defined Args1 = user_callback(TCCallback, Mod, Func, init, Args), ensure_timetrap(Args1), %% ts_tc does a catch - put(test_server_loc, {Mod,Func}), %% if this is a named conf group, the test case (init or end conf) %% should be called with the name as the first argument Args2 = if Name == undefined -> Args1; @@ -1341,43 +1229,12 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> %% call user callback function if defined Return1 = user_callback(TCCallback, Mod, Func, 'end', Return), {Return2,Opts} = process_return_val([Return1], Mod, Func, - Args1, {Mod,Func}, Return1), + Args1, [{Mod,Func}], Return1), {{T,Return2},Loc,Opts} end. -do_end_tc_call(M,F, Loc, Res, Return) -> - IsSuite = case lists:reverse(atom_to_list(M)) of - [$E,$T,$I,$U,$S,$_|_] -> true; - _ -> false - end, +do_end_tc_call(Mod, Func, Res, Return) -> FwMod = os:getenv("TEST_SERVER_FRAMEWORK"), - {Mod,Func} = - if FwMod == M ; FwMod == "undefined"; FwMod == false -> - {M,F}; - (not IsSuite) and is_list(Loc) and (length(Loc)>1) -> - %% If failure in other module (M) than suite, try locate - %% suite name in Loc list and call end_tc with Suite:TestCase - %% instead of M:F. - GetSuite = fun(S,TC) -> - case lists:reverse(atom_to_list(S)) of - [$E,$T,$I,$U,$S,$_|_] -> [{S,TC}]; - _ -> [] - end - end, - case lists:flatmap(fun({S,TC,_}) -> GetSuite(S,TC); - ({{S,TC},_}) -> GetSuite(S,TC); - ({S,TC}) -> GetSuite(S,TC); - (_) -> [] - end, Loc) of - [] -> - {M,F}; - [FoundSuite|_] -> - FoundSuite - end; - true -> - {M,F} - end, - Ref = make_ref(), if FwMod == "ct_framework" ; FwMod == "undefined"; FwMod == false -> case test_server_sup:framework_call( @@ -1419,7 +1276,7 @@ process_return_val([Return], M,F,A, Loc, Final) when is_list(Return) -> true -> % must be return value from end conf case process_return_val1(Return, M,F,A, Loc, Final, []); false -> % must be Config value from init conf case - case do_end_tc_call(M, F, Loc, {ok,A}, Return) of + case do_end_tc_call(M, F, {ok,A}, Return) of {failed, FWReason} = Failed -> fw_error_notify(M,F,A, FWReason), {Failed, []}; @@ -1435,9 +1292,9 @@ process_return_val(Return, M,F,A, Loc, Final) -> process_return_val1([Failed={E,TCError}|_], M,F,A=[Args], Loc, _, SaveOpts) when E=='EXIT'; E==failed -> - fw_error_notify(M,F,A, TCError, mod_loc(Loc)), - case do_end_tc_call(M,F, Loc, {{error,TCError}, - [[{tc_status,{failed,TCError}}|Args]]}, + fw_error_notify(M,F,A, TCError, Loc), + case do_end_tc_call(M,F, {{error,TCError}, + [[{tc_status,{failed,TCError}}|Args]]}, Failed) of {failed,FWReason} -> {{failed,FWReason},SaveOpts}; @@ -1455,8 +1312,8 @@ process_return_val1([RetVal={Tag,_}|Opts], M,F,A, Loc, _, SaveOpts) when Tag==sk process_return_val1(Opts, M,F,A, Loc, RetVal, SaveOpts); process_return_val1([_|Opts], M,F,A, Loc, Final, SaveOpts) -> process_return_val1(Opts, M,F,A, Loc, Final, SaveOpts); -process_return_val1([], M,F,A, Loc, Final, SaveOpts) -> - case do_end_tc_call(M,F, Loc, {Final,A}, Final) of +process_return_val1([], M,F,A, _Loc, Final, SaveOpts) -> + case do_end_tc_call(M,F, {Final,A}, Final) of {failed,FWReason} -> {{failed,FWReason},SaveOpts}; NewReturn -> @@ -1522,7 +1379,7 @@ do_init_per_testcase(Mod, Args) -> throw:Other -> set_loc(erlang:get_stacktrace()), Line = get_loc(), - FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), + FormattedLoc = test_server_sup:format_loc(Line), group_leader() ! {printout,12, "ERROR! init_per_testcase thrown!\n" "\tLocation: ~s\n\tReason: ~p\n", @@ -1533,7 +1390,7 @@ do_init_per_testcase(Mod, Args) -> Reason = {Reason0,Stk}, set_loc(Stk), Line = get_loc(), - FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), + FormattedLoc = test_server_sup:format_loc(Line), group_leader() ! {printout,12, "ERROR! init_per_testcase crashed!\n" "\tLocation: ~s\n\tReason: ~p\n", @@ -1556,8 +1413,7 @@ end_per_testcase(Mod, Func, Conf) -> end. do_end_per_testcase(Mod,EndFunc,Func,Conf) -> - put(test_server_init_or_end_conf,{EndFunc,Func}), - put(test_server_loc, {Mod,{EndFunc,Func}}), + set_tc_state(end_per_testcase, Conf), try Mod:EndFunc(Func, Conf) of {save_config,_}=SaveCfg -> SaveCfg; @@ -1581,8 +1437,7 @@ do_end_per_testcase(Mod,EndFunc,Func,Conf) -> "Reason: ~p\n" "Line: ~s\n", [EndFunc, Other, - test_server_sup:format_loc( - mod_loc(get_loc()))]}, + test_server_sup:format_loc(get_loc())]}, {failed,{Mod,end_per_testcase,Other}}; Class:Reason -> Stk = erlang:get_stacktrace(), @@ -1604,8 +1459,7 @@ do_end_per_testcase(Mod,EndFunc,Func,Conf) -> "Reason: ~p\n" "Line: ~s\n", [EndFunc, Reason, - test_server_sup:format_loc( - mod_loc(get_loc()))]}, + test_server_sup:format_loc(get_loc())]}, {failed,{Mod,end_per_testcase,Why}} end. @@ -1618,66 +1472,19 @@ get_loc(Pid) -> lists:foreach(fun({Key,Val}) -> put(Key, Val) end, Dict), Stk = [rewrite_loc_item(Loc) || Loc <- Stk0], case get(test_server_loc) of - undefined -> - put(test_server_loc, Stk); - {Suite,Case} -> + [{Suite,Case}] -> %% location info unknown, check if {Suite,Case,Line} %% is available in stacktrace. and if so, use stacktrace - %% instead of currect test_server_loc + %% instead of current test_server_loc case [match || {S,C,_L} <- Stk, S == Suite, C == Case] of [match|_] -> put(test_server_loc, Stk); _ -> ok end; _ -> - ok + put(test_server_loc, Stk) end, get_loc(). -%% find the latest known Suite:Testcase -get_mf(MFs) -> - get_mf(MFs, {undefined,undefined}). - -get_mf([MF|MFs], _Found) when is_tuple(MF) -> - ModFunc = {Mod,_} = case MF of - {M,F,_} -> {M,F}; - MF -> MF - end, - case is_suite(Mod) of - true -> ModFunc; - false -> get_mf(MFs, ModFunc) - end; -get_mf(_, Found) -> - Found. - -is_suite(Mod) -> - case lists:reverse(atom_to_list(Mod)) of - "ETIUS" ++ _ -> true; - _ -> false - end. - -mod_loc(Loc) -> - %% handle diff line num versions - case Loc of - [{{_M,_F},_L}|_] -> - [begin if L /= 0 -> {?pl2a(M),F,L}; - true -> {?pl2a(M),F} end end || {{M,F},L} <- Loc]; - [{_M,_F}|_] -> - [{?pl2a(M),F} || {M,F} <- Loc]; - {{M,F},0} -> - [{?pl2a(M),F}]; - {{M,F},L} -> - [{?pl2a(M),F,L}]; - {M,ForL} -> - [{?pl2a(M),ForL}]; - {M,F,0} -> - [{M,F}]; - [{M,F,0}|Stack] -> - [{M,F}|Stack]; - _ -> - Loc - end. - - fw_error_notify(Mod, Func, Args, Error) -> test_server_sup:framework_call(error_notification, [?pl2a(Mod),Func,[Args], @@ -1760,7 +1567,12 @@ ts_tc(M, F, A) -> {Elapsed, Result}. set_loc(Stk) -> - Loc = [rewrite_loc_item(I) || {_,_,_,_}=I <- Stk], + Loc = case [rewrite_loc_item(I) || {_,_,_,_}=I <- Stk] of + [{M,F,0}|Stack] -> + [{M,F}|Stack]; + Other -> + Other + end, put(test_server_loc, Loc). rewrite_loc_item({M,F,_,Loc}) -> diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 4a27c1ebae..3d00318b1b 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -64,13 +64,7 @@ timetrap(Timeout0, ReportTVal, Scale, Pid) -> true -> ReportTVal end, MFLs = test_server:get_loc(Pid), Mon = erlang:monitor(process, Pid), - Trap = - case get(test_server_init_or_end_conf) of - undefined -> - {timetrap_timeout,TimeToReport,MFLs}; - InitOrEnd -> - {timetrap_timeout,TimeToReport,MFLs,InitOrEnd} - end, + Trap = {timetrap_timeout,TimeToReport,MFLs}, exit(Pid, Trap), receive {'DOWN', Mon, process, Pid, _} -> @@ -518,8 +512,18 @@ framework_call(Callback,Func,Args,DefaultReturn) -> end, case erlang:function_exported(Mod,Func,length(Args)) of true -> - put(test_server_loc, {Mod,Func,framework}), EH = fun(Reason) -> exit({fw_error,{Mod,Func,Reason}}) end, + SetTcState = case Func of + end_tc -> true; + init_tc -> true; + _ -> false + end, + case SetTcState of + true -> + test_server:set_tc_state({framework,Mod,Func}, undefined); + false -> + ok + end, try apply(Mod,Func,Args) of Result -> Result @@ -550,18 +554,6 @@ format_loc([{Mod,LineOrFunc}]) -> format_loc({Mod,LineOrFunc}); format_loc({Mod,Func}) when is_atom(Func) -> io_lib:format("{~s,~w}",[package_str(Mod),Func]); -format_loc({Mod,Line}) when is_integer(Line) -> - %% ?line macro is used - ModStr = package_str(Mod), - case {lists:member(no_src, get(test_server_logopts)), - lists:reverse(ModStr)} of - {false,[$E,$T,$I,$U,$S,$_|_]} -> - io_lib:format("{~s,<a href=\"~s~s#~w\">~w</a>}", - [ModStr,downcase(ModStr),?src_listing_ext, - round_to_10(Line),Line]); - _ -> - io_lib:format("{~s,~w}",[ModStr,Line]) - end; format_loc(Loc) -> io_lib:format("~p",[Loc]). |