diff options
Diffstat (limited to 'lib/test_server/src/test_server.erl')
-rw-r--r-- | lib/test_server/src/test_server.erl | 293 |
1 files changed, 192 insertions, 101 deletions
diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 244207e140..51754cb3b4 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -36,7 +36,8 @@ -export([capture_start/0,capture_stop/0,capture_get/0]). -export([messages_get/0]). -export([hours/1,minutes/1,seconds/1,sleep/1,adjusted_sleep/1,timecall/3]). --export([timetrap_scale_factor/0,timetrap/1,timetrap_cancel/1,timetrap_cancel/0]). +-export([timetrap_scale_factor/0,timetrap/1,get_timetrap_info/0, + timetrap_cancel/1,timetrap_cancel/0]). -export([m_out_of_n/3,do_times/4,do_times/2]). -export([call_crash/3,call_crash/4,call_crash/5]). -export([temp_name/1]). @@ -611,6 +612,7 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> print(minor, "Test case started with:\n~s:~s(~p)\n", [Mod,Func,Args2Print]), print(minor, "Current directory is ~p\n", [Cwd]), print_timestamp(minor,"Started at "), + print(minor, "", [], internal_raw), TCCallback = get(test_server_testcase_callback), LogOpts = get(test_server_logopts), Ref = make_ref(), @@ -768,7 +770,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, Comment,undefined); Loc1 -> - {Mod,Func} = get_mf(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 @@ -784,6 +785,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> 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 @@ -821,7 +823,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, Comment,undefined); Loc1 -> - {Mod,Func} = get_mf(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 @@ -839,6 +840,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> TVal), {EndConfPid,{Mod,Func},Conf}; _ -> + {Mod,Func} = get_mf(Loc1), spawn_fw_call(Mod,Func,CurrConf,Pid,ErrorMsg, Loc1,self(),Comment), undefined @@ -1006,8 +1008,11 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid, end, %% if end_per_testcase fails a warning should be %% printed as comment - Comment1 = if Comment == "" -> ""; - true -> Comment ++ "<br>" + Comment1 = if Comment == "" -> + ""; + true -> + Comment ++ test_server_ctrl:xhtml("<br>", + "<br />") end, %% finished, report back SendTo ! {self(),fw_notify_done, @@ -1135,7 +1140,7 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, {auto_skip,Reason} -> Where = {Mod,Func}, NewResult = do_end_tc_call(Mod,Func, Where, {{skip,Reason},Args0}, - {skip,{fw_auto_skip,Reason}}), + {skip,Reason}), {{0,NewResult},Where,[]} end, exit({Ref,Time,Value,Loc,Opts}). @@ -1253,11 +1258,15 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> 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, FwMod = os:getenv("TEST_SERVER_FRAMEWORK"), {Mod,Func} = if FwMod == M ; FwMod == "undefined"; FwMod == false -> {M,F}; - is_list(Loc) and (length(Loc)>1) -> + (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. @@ -1388,57 +1397,62 @@ init_per_testcase(Mod, Func, Args) -> false -> code:load_file(Mod); _ -> ok end, - %% init_per_testcase defined, returns new configuration - case erlang:function_exported(Mod,init_per_testcase,2) of + case erlang:function_exported(Mod, init_per_testcase, 2) of true -> - case catch my_apply(Mod, init_per_testcase, [Func|Args]) of - {'$test_server_ok',{Skip,Reason}} when Skip==skip; - Skip==skipped -> - {skip,Reason}; - {'$test_server_ok',Res={skip_and_save,_,_}} -> - Res; - {'$test_server_ok',NewConf} when is_list(NewConf) -> - case lists:filter(fun(T) when is_tuple(T) -> false; - (_) -> true end, NewConf) of - [] -> - {ok,NewConf}; - Bad -> - group_leader() ! {printout,12, - "ERROR! init_per_testcase has returned " - "bad elements in Config: ~p\n",[Bad]}, - {skip,{failed,{Mod,init_per_testcase,bad_return}}} - end; - {'$test_server_ok',Res={fail,_Reason}} -> - Res; - {'$test_server_ok',_Other} -> - group_leader() ! {printout,12, - "ERROR! init_per_testcase did not return " - "a Config list.\n",[]}, - {skip,{failed,{Mod,init_per_testcase,bad_return}}}; - {'EXIT',Reason} -> - Line = get_loc(), - FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), - group_leader() ! {printout,12, - "ERROR! init_per_testcase crashed!\n" - "\tLocation: ~s\n\tReason: ~p\n", - [FormattedLoc,Reason]}, - {skip,{failed,{Mod,init_per_testcase,Reason}}}; - Other -> - Line = get_loc(), - FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), - group_leader() ! {printout,12, - "ERROR! init_per_testcase thrown!\n" - "\tLocation: ~s\n\tReason: ~p\n", - [FormattedLoc, Other]}, - {skip,{failed,{Mod,init_per_testcase,Other}}} - end; + do_init_per_testcase(Mod, [Func|Args]); false -> -%% Optional init_per_testcase not defined -%% keep quiet. + %% Optional init_per_testcase is not defined -- keep quiet. [Config] = Args, {ok, Config} end. +do_init_per_testcase(Mod, Args) -> + try apply(Mod, init_per_testcase, Args) of + {Skip,Reason} when Skip =:= skip; Skip =:= skipped -> + {skip,Reason}; + {skip_and_save,_,_}=Res -> + Res; + NewConf when is_list(NewConf) -> + case lists:filter(fun(T) when is_tuple(T) -> false; + (_) -> true end, NewConf) of + [] -> + {ok,NewConf}; + Bad -> + group_leader() ! {printout,12, + "ERROR! init_per_testcase has returned " + "bad elements in Config: ~p\n",[Bad]}, + {skip,{failed,{Mod,init_per_testcase,bad_return}}} + end; + {fail,_Reason}=Res -> + Res; + _Other -> + group_leader() ! {printout,12, + "ERROR! init_per_testcase did not return " + "a Config list.\n",[]}, + {skip,{failed,{Mod,init_per_testcase,bad_return}}} + catch + throw:Other -> + set_loc(erlang:get_stacktrace()), + Line = get_loc(), + FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), + group_leader() ! {printout,12, + "ERROR! init_per_testcase thrown!\n" + "\tLocation: ~s\n\tReason: ~p\n", + [FormattedLoc, Other]}, + {skip,{failed,{Mod,init_per_testcase,Other}}}; + _:Reason0 -> + Stk = erlang:get_stacktrace(), + Reason = {Reason0,Stk}, + set_loc(Stk), + Line = get_loc(), + FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), + group_leader() ! {printout,12, + "ERROR! init_per_testcase crashed!\n" + "\tLocation: ~s\n\tReason: ~p\n", + [FormattedLoc,Reason]}, + {skip,{failed,{Mod,init_per_testcase,Reason}}} + end. + end_per_testcase(Mod, Func, Conf) -> case erlang:function_exported(Mod,end_per_testcase,2) of true -> @@ -1456,65 +1470,92 @@ end_per_testcase(Mod, Func, Conf) -> do_end_per_testcase(Mod,EndFunc,Func,Conf) -> put(test_server_init_or_end_conf,{EndFunc,Func}), put(test_server_loc, {Mod,{EndFunc,Func}}), - case catch my_apply(Mod, EndFunc, [Func,Conf]) of - {'$test_server_ok',SaveCfg={save_config,_}} -> + try Mod:EndFunc(Func, Conf) of + {save_config,_}=SaveCfg -> SaveCfg; - {'$test_server_ok',{fail,_}=Fail} -> + {fail,_}=Fail -> Fail; - {'$test_server_ok',_} -> - ok; - {'EXIT',Reason} = Why -> + _ -> + ok + catch + throw:Other -> Comment0 = case read_comment() of "" -> ""; - Cmt -> Cmt ++ "<br>" + Cmt -> Cmt ++ test_server_ctrl:xhtml("<br>", + "<br />") end, + set_loc(erlang:get_stacktrace()), comment(io_lib:format("~s<font color=\"red\">" - "WARNING: ~w crashed!" + "WARNING: ~w thrown!" "</font>\n",[Comment0,EndFunc])), group_leader() ! {printout,12, - "WARNING: ~w crashed!\n" + "WARNING: ~w thrown!\n" "Reason: ~p\n" "Line: ~s\n", - [EndFunc, Reason, + [EndFunc, Other, test_server_sup:format_loc( mod_loc(get_loc()))]}, - {failed,{Mod,end_per_testcase,Why}}; - Other -> + {failed,{Mod,end_per_testcase,Other}}; + Class:Reason -> + Stk = erlang:get_stacktrace(), + set_loc(Stk), + Why = case Class of + exit -> {'EXIT',Reason}; + error -> {'EXIT',{Reason,Stk}} + end, Comment0 = case read_comment() of "" -> ""; - Cmt -> Cmt ++ "<br>" + Cmt -> Cmt ++ test_server_ctrl:xhtml("<br>", + "<br />") end, comment(io_lib:format("~s<font color=\"red\">" - "WARNING: ~w thrown!" + "WARNING: ~w crashed!" "</font>\n",[Comment0,EndFunc])), group_leader() ! {printout,12, - "WARNING: ~w thrown!\n" + "WARNING: ~w crashed!\n" "Reason: ~p\n" "Line: ~s\n", - [EndFunc, Other, + [EndFunc, Reason, test_server_sup:format_loc( mod_loc(get_loc()))]}, - {failed,{Mod,end_per_testcase,Other}} + {failed,{Mod,end_per_testcase,Why}} end. get_loc() -> - case catch test_server_line:get_lines() of - [] -> - get(test_server_loc); - {'EXIT',_} -> - get(test_server_loc); - Loc -> - Loc - end. + get(test_server_loc). get_loc(Pid) -> - {dictionary,Dict} = process_info(Pid, dictionary), - lists:foreach(fun({Key,Val}) -> put(Key,Val) end,Dict), + [{current_stacktrace,Stk0},{dictionary,Dict}] = + process_info(Pid, [current_stacktrace,dictionary]), + 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); + _ -> ok + end, get_loc(). -get_mf([{M,F,_}|_]) -> {M,F}; -get_mf([{M,F}|_]) -> {M,F}; -get_mf(_) -> {undefined,undefined}. +%% 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 @@ -1544,7 +1585,7 @@ fw_error_notify(Mod, Func, Args, Error, Loc) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% print(Detail,Format,Args) -> ok +%% print(Detail,Format,Args,Printer) -> ok %% Detail = integer() %% Format = string() %% Args = [term()] @@ -1555,6 +1596,9 @@ fw_error_notify(Mod, Func, Args, Error, Loc) -> print(Detail,Format,Args) -> local_or_remote_apply({test_server_ctrl,print,[Detail,Format,Args]}). +print(Detail,Format,Args,Printer) -> + local_or_remote_apply({test_server_ctrl,print,[Detail,Format,Args,Printer]}). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% print_timsteamp(Detail,Leader) -> ok %% @@ -1587,16 +1631,22 @@ lookup_config(Key,Config) -> %% timer:tc/3 ts_tc(M, F, A) -> Before = erlang:now(), - Val = (catch my_apply(M, F, A)), + Result = try + apply(M, F, A) + catch + Type:Reason -> + Stk = erlang:get_stacktrace(), + set_loc(Stk), + case Type of + throw -> + {failed,{thrown,Reason}}; + error -> + {'EXIT',{Reason,Stk}}; + exit -> + {'EXIT',Reason} + end + end, After = erlang:now(), - Result = case Val of - {'$test_server_ok', R} -> - R; % test case ok - {'EXIT',_Reason} = R -> - R; % test case crashed - Other -> - {failed, {thrown,Other}} % test case was thrown - end, Elapsed = (element(1,After)*1000000000000 +element(2,After)*1000000+element(3,After)) - @@ -1604,8 +1654,12 @@ ts_tc(M, F, A) -> +element(2,Before)*1000000+element(3,Before)), {Elapsed, Result}. -my_apply(M, F, A) -> - {'$test_server_ok',apply(M, F, A)}. +set_loc(Stk) -> + Loc = [rewrite_loc_item(I) || {_,_,_,_}=I <- Stk], + put(test_server_loc, Loc). + +rewrite_loc_item({M,F,_,Loc}) -> + {M,F,proplists:get_value(line, Loc, 0)}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1768,7 +1822,16 @@ adjusted_sleep(MSecs) -> %% to read when using this function, rather than exit directly. fail(Reason) -> comment(cast_to_list(Reason)), - exit({suite_failed,Reason}). + try + exit({suite_failed,Reason}) + catch + Class:R -> + case erlang:get_stacktrace() of + [{?MODULE,fail,1,_}|Stk] -> ok; + Stk -> ok + end, + erlang:raise(Class, R, Stk) + end. cast_to_list(X) when is_list(X) -> X; cast_to_list(X) when is_atom(X) -> atom_to_list(X); @@ -1782,7 +1845,16 @@ cast_to_list(X) -> lists:flatten(io_lib:format("~p", [X])). %% Immediately calls exit. Included because test suites are easier %% to read when using this function, rather than exit directly. fail() -> - exit(suite_failed). + try + exit(suite_failed) + catch + Class:R -> + case erlang:get_stacktrace() of + [{?MODULE,fail,0,_}|Stk] -> ok; + Stk -> ok + end, + erlang:raise(Class, R, Stk) + end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% break(Comment) -> ok @@ -1792,7 +1864,9 @@ fail() -> break(Comment) -> case erase(test_server_timetraps) of undefined -> ok; - List -> lists:foreach(fun({Ref,_}) -> timetrap_cancel(Ref) end, List) + List -> lists:foreach(fun({Ref,_,_}) -> + timetrap_cancel(Ref) + end, List) end, io:format(user, "\n\n\n--- SEMIAUTOMATIC TESTING ---" @@ -1881,8 +1955,8 @@ timetrap1(Timeout, Scale) -> TCPid = self(), Ref = spawn_link(test_server_sup,timetrap,[Timeout,Scale,TCPid]), case get(test_server_timetraps) of - undefined -> put(test_server_timetraps,[{Ref,TCPid}]); - List -> put(test_server_timetraps,[{Ref,TCPid}|List]) + undefined -> put(test_server_timetraps,[{Ref,TCPid,{Timeout,Scale}}]); + List -> put(test_server_timetraps,[{Ref,TCPid,{Timeout,Scale}}|List]) end, Ref. @@ -1993,7 +2067,7 @@ timetrap_cancel(infinity) -> timetrap_cancel(Handle) -> case get(test_server_timetraps) of undefined -> ok; - [{Handle,_}] -> erase(test_server_timetraps); + [{Handle,_,_}] -> erase(test_server_timetraps); Timers -> put(test_server_timetraps, lists:keydelete(Handle, 1, Timers)) end, @@ -2009,13 +2083,30 @@ timetrap_cancel() -> ok; Timers -> case lists:keysearch(self(), 2, Timers) of - {value,{Handle,_}} -> + {value,{Handle,_,_}} -> timetrap_cancel(Handle); _ -> ok end end. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% get_timetrap_info() -> {Timeout,Scale} | undefined +%% +%% Read timetrap info for current test case +get_timetrap_info() -> + case get(test_server_timetraps) of + undefined -> + undefined; + Timers -> + case lists:keysearch(self(), 2, Timers) of + {value,{_,_,Info}} -> + Info; + _ -> + undefined + end + end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% hours(N) -> Milliseconds %% minutes(N) -> Milliseconds |