diff options
| -rw-r--r-- | lib/common_test/src/ct.erl | 14 | ||||
| -rw-r--r-- | lib/common_test/src/ct_framework.erl | 35 | ||||
| -rw-r--r-- | lib/common_test/test/ct_error_SUITE.erl | 137 | ||||
| -rw-r--r-- | lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_5_SUITE.erl | 84 | ||||
| -rw-r--r-- | lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_7_SUITE.erl | 4 | ||||
| -rw-r--r-- | lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_utils.erl | 9 | ||||
| -rw-r--r-- | lib/common_test/test/ct_test_support.erl | 6 | ||||
| -rw-r--r-- | lib/test_server/src/test_server.erl | 593 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_sup.erl | 68 |
9 files changed, 672 insertions, 278 deletions
diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index 68ddce8068..3c6e68101d 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -995,13 +995,21 @@ remove_config(Callback, Config) -> %%%----------------------------------------------------------------- %%% @spec timetrap(Time) -> ok -%%% Time = {hours,Hours} | {minutes,Mins} | {seconds,Secs} | Millisecs | infinity +%%% Time = {hours,Hours} | {minutes,Mins} | {seconds,Secs} | Millisecs | infinity | Func %%% Hours = integer() %%% Mins = integer() %%% Secs = integer() %%% Millisecs = integer() | float() -%%% -%%% @doc <p>Use this function to set a new timetrap for the running test case.</p> +%%% Func = {M,F,A} | fun() +%%% M = atom() +%%% F = atom() +%%% A = list() +%%% +%%% @doc <p>Use this function to set a new timetrap for the running test case. +%%% If the argument is <code>Func</code>, the timetrap will be triggered +%%% when this function returns. <code>Func</code> may also return a new +%%% <code>Time</code> value, which in that case will be the value for the +%%% new timetrap.</p> timetrap(Time) -> test_server:timetrap_cancel(), test_server:timetrap(Time). diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 187794e78b..e4fbf95fdd 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -212,23 +212,16 @@ init_tc2(Mod,Suite,Func,SuiteInfo,MergeResult,Config) -> {auto_skip,{require_failed,Reason}}; {'EXIT',Reason} -> {auto_skip,Reason}; - {ok,FinalConfig} -> - case MergeResult of - {error,Reason} -> - %% suite0 configure finished now, report that - %% first test case actually failed - {skip,Reason}; - _ -> - case get('$test_server_framework_test') of - undefined -> - ct_suite_init(Suite, FuncSpec, FinalConfig); - Fun -> - case Fun(init_tc, FinalConfig) of - NewConfig when is_list(NewConfig) -> - {ok,NewConfig}; - Else -> - Else - end + {ok,Config1} -> + case get('$test_server_framework_test') of + undefined -> + ct_suite_init(Suite, FuncSpec, Config1); + Fun -> + case Fun(init_tc, Config1) of + NewConfig when is_list(NewConfig) -> + {ok,NewConfig}; + Else -> + Else end end end. @@ -346,16 +339,12 @@ get_suite_name(Mod, _) -> Mod. %% Check that alias names are not already in use -check_for_clashes(TCInfo, GrPathInfo, SuiteInfo) -> - {CurrGrInfo,SearchIn} = case GrPathInfo of - [] -> {[],[SuiteInfo]}; - [Curr|Path] -> {Curr,[SuiteInfo|Path]} - end, +check_for_clashes(TCInfo, [CurrGrInfo|Path], SuiteInfo) -> ReqNames = fun(Info) -> [element(2,R) || R <- Info, size(R) == 3, require == element(1,R)] end, - ExistingNames = lists:flatten([ReqNames(L) || L <- SearchIn]), + ExistingNames = lists:flatten([ReqNames(L) || L <- [SuiteInfo|Path]]), CurrGrReqNs = ReqNames(CurrGrInfo), GrClashes = [Name || Name <- CurrGrReqNs, true == lists:member(Name, ExistingNames)], diff --git a/lib/common_test/test/ct_error_SUITE.erl b/lib/common_test/test/ct_error_SUITE.erl index 79ed51bc28..8c56d9ffde 100644 --- a/lib/common_test/test/ct_error_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE.erl @@ -848,77 +848,124 @@ test_events(timetrap_parallel) -> test_events(timetrap_fun) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,start_info,{4,4,17}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{4,4,24}}, + {?eh,tc_start,{timetrap_4_SUITE,init_per_suite}}, {?eh,tc_done,{timetrap_4_SUITE,init_per_suite,ok}}, {?eh,tc_start,{timetrap_4_SUITE,tc0}}, - {?eh,tc_done, - {timetrap_4_SUITE,tc0,{failed,{timetrap_timeout,1000}}}}, + {?eh,tc_done,{timetrap_4_SUITE,tc0, + {failed,{timetrap_timeout,{'$approx',1000}}}}}, + {?eh,test_stats,{0,1,{0,0}}}, {?eh,tc_start,{timetrap_4_SUITE,tc1}}, - {?eh,tc_done, - {timetrap_4_SUITE,tc1,{failed,{timetrap_timeout,2000}}}}, + {?eh,tc_done,{timetrap_4_SUITE,tc1, + {failed,{timetrap_timeout,{'$approx',2000}}}}}, + {?eh,test_stats,{0,2,{0,0}}}, {?eh,tc_start,{timetrap_4_SUITE,tc2}}, - {?eh,tc_done, - {timetrap_4_SUITE,tc2,{failed,{timetrap_timeout,500}}}}, + {?eh,tc_done,{timetrap_4_SUITE,tc2, + {failed,{timetrap_timeout,{'$approx',500}}}}}, + {?eh,test_stats,{0,3,{0,0}}}, {?eh,tc_start,{timetrap_4_SUITE,tc3}}, - {?eh,tc_done, - {timetrap_4_SUITE,tc3,{failed,{timetrap_timeout,1000}}}}, + {?eh,tc_done,{timetrap_4_SUITE,tc3, + {failed,{timetrap_timeout,{'$approx',1000}}}}}, {?eh,test_stats,{0,4,{0,0}}}, + {?eh,tc_start,{timetrap_4_SUITE,end_per_suite}}, {?eh,tc_done,{timetrap_4_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{timetrap_5_SUITE,init_per_suite}}, {?eh,tc_done,{timetrap_5_SUITE,init_per_suite,ok}}, {?eh,tc_start,{timetrap_5_SUITE,tc0}}, - {?eh,tc_done, - {timetrap_5_SUITE,tc0,{failed,{timetrap_timeout,1000}}}}, + {?eh,tc_done,{timetrap_5_SUITE,tc0, + {failed,{timetrap_timeout,{'$approx',1000}}}}}, {?eh,test_stats,{0,5,{0,0}}}, {?eh,tc_start,{timetrap_5_SUITE,tc1}}, - {?eh,tc_done, - {timetrap_5_SUITE,tc1,{skipped,{timetrap_error,kaboom}}}}, + {?eh,tc_done,{undefined,undefined,{user_timetrap_error, + {kaboom,'_'}}}}, + {?eh,test_stats,{0,6,{0,0}}}, {?eh,tc_start,{timetrap_5_SUITE,tc2}}, - {?eh,tc_done, - {timetrap_5_SUITE,tc2,{skipped,{timetrap_error,kaboom}}}}, + {?eh,tc_done,{undefined,undefined,{user_timetrap_error, + {kaboom,'_'}}}}, + {?eh,test_stats,{0,7,{0,0}}}, {?eh,tc_start,{timetrap_5_SUITE,tc3}}, - {?eh,tc_done, - {timetrap_5_SUITE,tc3, - {skipped,{invalid_time_format,{timetrap_utils,timetrap_val,[5000]}}}}}, + {?eh,tc_done,{timetrap_5_SUITE,tc3, + {failed,{timetrap_timeout,{'$approx',2000}}}}}, + {?eh,test_stats,{0,8,{0,0}}}, {?eh,tc_start,{timetrap_5_SUITE,tc4}}, - {?eh,tc_done, - {timetrap_5_SUITE,tc4,{skipped,{invalid_time_format,'_'}}}}, - {?eh,test_stats,{0,5,{0,4}}}, + {?eh,tc_done,{timetrap_5_SUITE,tc4, + {failed,{timetrap_timeout,{'$approx',500}}}}}, + {?eh,test_stats,{0,9,{0,0}}}, {?eh,tc_start,{timetrap_5_SUITE,tc5}}, - {?eh,tc_done, - {timetrap_5_SUITE,tc5,{failed,{timetrap_timeout,1000}}}}, + {?eh,tc_done,{timetrap_5_SUITE,tc5, + {failed,{timetrap_timeout,{'$approx',1000}}}}}, + {?eh,test_stats,{0,10,{0,0}}}, {?eh,tc_start,{timetrap_5_SUITE,tc6}}, - {?eh,tc_done, - {timetrap_5_SUITE,tc6,{failed,{timetrap_timeout,1000}}}}, + {?eh,tc_done,{timetrap_5_SUITE,tc6, + {failed,{timetrap_timeout,{'$approx',41000}}}}}, + {?eh,test_stats,{0,11,{0,0}}}, {?eh,tc_start,{timetrap_5_SUITE,tc7}}, - {?eh,tc_done, - {timetrap_5_SUITE,tc7,{failed,{timetrap_timeout,1000}}}}, - {?eh,test_stats,{0,8,{0,4}}}, + {?eh,tc_done,{timetrap_5_SUITE,tc7, + {failed,{timetrap_timeout,{'$approx',3000}}}}}, + {?eh,test_stats,{0,12,{0,0}}}, + {?eh,tc_start,{timetrap_5_SUITE,tc8}}, + {?eh,tc_done,{timetrap_5_SUITE,tc8, + {failed,{timetrap_timeout,{'$approx',7000}}}}}, + {?eh,test_stats,{0,13,{0,0}}}, + {?eh,tc_start,{timetrap_5_SUITE,tc9}}, + {?eh,tc_done,{timetrap_5_SUITE,tc9, + {failed,{timetrap_timeout,{'$approx',2000}}}}}, + {?eh,test_stats,{0,14,{0,0}}}, + {?eh,tc_start,{timetrap_5_SUITE,tc10}}, + {?eh,tc_done,{timetrap_5_SUITE,tc10, + {failed,{timetrap_timeout,{'$approx',1500}}}}}, + {?eh,test_stats,{0,15,{0,0}}}, + {?eh,tc_start,{timetrap_5_SUITE,tc11}}, + {?eh,tc_done,{timetrap_5_SUITE,tc11, + {failed,{timetrap_timeout,{'$approx',1500}}}}}, + {?eh,test_stats,{0,16,{0,0}}}, + {?eh,tc_start,{timetrap_5_SUITE,tc12}}, + {?eh,tc_done,{timetrap_5_SUITE,tc12, + {failed,{timetrap_timeout,{'$approx',1000}}}}}, + {?eh,test_stats,{0,17,{0,0}}}, + {?eh,tc_start,{timetrap_5_SUITE,tc13}}, + {?eh,tc_done,{timetrap_5_SUITE,tc13, + {failed,{timetrap_timeout,{'$approx',500}}}}}, + {?eh,test_stats,{0,18,{0,0}}}, + {?eh,tc_start,{timetrap_5_SUITE,tc14}}, + {?eh,tc_done,{timetrap_5_SUITE,tc14, + {failed,{timetrap_timeout,{'$approx',1000}}}}}, + {?eh,test_stats,{0,19,{0,0}}}, + {?eh,tc_start,{timetrap_5_SUITE,end_per_suite}}, {?eh,tc_done,{timetrap_5_SUITE,end_per_suite,ok}}, {?eh,tc_start,{timetrap_6_SUITE,init_per_suite}}, - {?eh,tc_done, - {timetrap_6_SUITE,init_per_suite,{skipped,{timetrap_error,kaboom}}}}, - {?eh,tc_auto_skip, - {timetrap_6_SUITE,tc0,{timetrap_error,kaboom}}}, - {?eh,test_stats,{0,8,{0,5}}}, - {?eh,tc_auto_skip, - {timetrap_6_SUITE,end_per_suite,{timetrap_error,kaboom}}}, - + {?eh,tc_done,{undefined,undefined,{user_timetrap_error, + {kaboom,'_'}}}}, + {?eh,tc_auto_skip,{timetrap_6_SUITE,tc0, + {failed,{timetrap_6_SUITE,init_per_suite, + {user_timetrap_error,{kaboom,'_'}}}}}}, + {?eh,test_stats,{0,19,{0,1}}}, + {?eh,tc_auto_skip,{timetrap_6_SUITE,end_per_suite, + {failed,{timetrap_6_SUITE,init_per_suite, + {user_timetrap_error,{kaboom,'_'}}}}}}, + + {?eh,tc_start,{timetrap_7_SUITE,init_per_suite}}, {?eh,tc_done,{timetrap_7_SUITE,init_per_suite,ok}}, {?eh,tc_start,{timetrap_7_SUITE,tc0}}, - {?eh,tc_done, - {timetrap_7_SUITE,tc0,{failed,{timetrap_timeout,1000}}}}, + {?eh,tc_done,{timetrap_7_SUITE,tc0, + {failed,{timetrap_timeout,{'$approx',7000}}}}}, + {?eh,test_stats,{0,20,{0,1}}}, {?eh,tc_start,{timetrap_7_SUITE,tc1}}, - {?eh,tc_done, - {timetrap_7_SUITE,tc1,{failed,{timetrap_timeout,2000}}}}, + {?eh,tc_done,{timetrap_7_SUITE,tc1, + {failed,{timetrap_timeout,{'$approx',2000}}}}}, + {?eh,test_stats,{0,21,{0,1}}}, {?eh,tc_start,{timetrap_7_SUITE,tc2}}, - {?eh,tc_done, - {timetrap_7_SUITE,tc2,{failed,{timetrap_timeout,500}}}}, + {?eh,tc_done,{timetrap_7_SUITE,tc2, + {failed,{timetrap_timeout,{'$approx',500}}}}}, + {?eh,test_stats,{0,22,{0,1}}}, {?eh,tc_start,{timetrap_7_SUITE,tc3}}, - {?eh,tc_done, - {timetrap_7_SUITE,tc3,{failed,{timetrap_timeout,1000}}}}, - {?eh,test_stats,{0,12,{0,5}}}, + {?eh,tc_done,{timetrap_7_SUITE,tc3, + {failed,{timetrap_timeout,{'$approx',7000}}}}}, + {?eh,test_stats,{0,23,{0,1}}}, + {?eh,tc_start,{timetrap_7_SUITE,end_per_suite}}, {?eh,tc_done,{timetrap_7_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_5_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_5_SUITE.erl index c5d4b5062e..58042c04fc 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_5_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_5_SUITE.erl @@ -108,7 +108,8 @@ groups() -> %% Reason = term() %%-------------------------------------------------------------------- all() -> - [tc0,tc1,tc2,tc3,tc4,tc5,tc6,tc7]. + [tc0,tc1,tc2,tc3,tc4,tc5,tc6,tc7,tc8,tc9, + tc10,tc11,tc12,tc13,tc14]. tc0(_) -> ct:comment(io_lib:format("TO after ~w sec", [?TO])), @@ -126,30 +127,89 @@ tc2(_) -> exit(this_should_not_execute). tc3() -> - [{timetrap,{timetrap_utils,timetrap_err_mfa,[]}}]. -tc3(_) -> - exit(this_should_not_execute). + [{timetrap,{timetrap_utils,timetrap_val,[{seconds,2}]}}]. +tc3(_) -> + ct:comment("TO after ~2 sec"), + ct:sleep({seconds,10}), + ok. tc4() -> - [{timetrap,fun() -> timetrap_utils:timetrap_err_fun() end}]. -tc4(_) -> - exit(this_should_not_execute). + [{timetrap,fun() -> 500 end}]. +tc4(_) -> + ct:comment("TO after 500 ms"), + ct:sleep({seconds,10}), + ok. tc5() -> + [{timetrap,{timetrap_utils,timetrap_timeout,[1000,ok]}}]. +tc5(_) -> + ct:comment("TO after ~1 sec"), + ct:sleep({seconds,10}), + ok. + +tc6() -> [{timetrap,{timetrap_utils,timetrap_timeout,[{seconds,40}, {seconds,1}]}}]. -tc5(_) -> +tc6(_) -> ct:comment("TO after 40+1 sec"), ct:sleep({seconds,42}), ok. -tc6() -> +tc7() -> + [{timetrap,{timetrap_utils,timetrap_timeout,[1000,2000]}}]. +tc7(_) -> + ct:comment("TO after ~3 sec"), + ct:sleep({seconds,10}), + ok. + +tc8() -> [{timetrap,fun() -> ct:sleep(6000), 1000 end}]. -tc6(_) -> +tc8(_) -> ct:comment("TO after 6+1 sec"), - ct:sleep({seconds,10}). + ct:sleep({seconds,10}), + ok. -tc7(_) -> +tc9() -> + [{timetrap,{timetrap_utils,timetrap_timeout, + [500,fun() -> {seconds,2} end]}}]. +tc9(_) -> + ct:comment("TO after ~2 sec (2.5 sec in reality)"), + ct:sleep({seconds,10}), + ok. + +tc10() -> + [{timetrap,500}]. +tc10(_) -> + ct:timetrap({timetrap_utils,timetrap_val,[1500]}), + ct:comment("TO after ~1.5 sec"), + ct:sleep({seconds,10}), + ok. + +tc11() -> + [{timetrap,2000}]. +tc11(_) -> + ct:timetrap(fun() -> 1500 end), + ct:comment("TO after ~1.5 sec"), + ct:sleep({seconds,10}), + ok. + +tc12() -> + [{timetrap,500}]. +tc12(_) -> + ct:timetrap({timetrap_utils,timetrap_timeout,[1000,ok]}), + ct:comment("TO after ~1 sec"), + ct:sleep({seconds,10}), + ok. + +tc13() -> + [{timetrap,2000}]. +tc13(_) -> + ct:timetrap(fun() -> ct:sleep(500), ok end), + ct:comment("TO after ~500 ms"), + ct:sleep({seconds,10}), + ok. + +tc14(_) -> ct:comment(io_lib:format("TO after ~w sec", [?TO])), ct:sleep({seconds,5}), ok. diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_7_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_7_SUITE.erl index b25b7770a7..62de959458 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_7_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_7_SUITE.erl @@ -114,7 +114,7 @@ all() -> tc0(_) -> ct:comment(io_lib:format("TO after ~w+~w sec", [?HANG,?TO])), - ct:sleep({seconds,5}), + ct:sleep({seconds,10}), ok. tc1() -> @@ -133,5 +133,5 @@ tc2(_) -> tc3(_) -> ct:comment(io_lib:format("TO after ~w+~w sec", [?HANG,?TO])), - ct:sleep({seconds,5}), + ct:sleep({seconds,10}), ok. diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_utils.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_utils.erl index fcde6cd701..016014b03a 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_utils.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_utils.erl @@ -20,24 +20,15 @@ -module(timetrap_utils). -export([timetrap_val/1, - timetrap_err_fun/0, - timetrap_err_mfa/0, timetrap_exit/1, timetrap_timeout/2]). timetrap_val(Val) -> Val. -timetrap_err_fun() -> - fun() -> 5000 end. - -timetrap_err_mfa() -> - {?MODULE,timetrap_val,[5000]}. - timetrap_exit(Reason) -> exit(Reason). timetrap_timeout(Sleep, Val) -> ct:sleep(Sleep), Val. - diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index 42d4a1630d..62c167d78b 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -1011,6 +1011,12 @@ result_match({SkipOrFail,{ErrorInd,{Why,'_'}}}, result_match({SkipOrFail,{ErrorInd,{EMod,EFunc,{Why,'_'}}}}, {SkipOrFail,{ErrorInd,{EMod,EFunc,{Why,_Stack}}}}) -> true; +result_match({failed,{timetrap_timeout,{'$approx',Num}}}, + {failed,{timetrap_timeout,Value}}) -> + if Value >= trunc(Num-0.01*Num), + Value =< trunc(Num+0.01*Num) -> true; + true -> false + end; result_match(Result, Result) -> true; result_match(_, _) -> diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index d7ce432786..96d2e2b80e 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,19 +639,37 @@ 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} = 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, 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 +683,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 +783,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 +811,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 +827,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 +877,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 +896,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 +943,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 +958,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 +993,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 +1005,63 @@ 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,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,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); + {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); + {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) -> %% 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. @@ -1176,10 +1293,11 @@ 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()}, {{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,26 +2138,56 @@ 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), - 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) - end. +timetrap(Timeout) -> + 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 -> + Timeout1; + true -> + %% only convert to ms, don't start a + %% user timetrap + time_ms_check(TimeToReport0) + 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, 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,{Timeout,Scale}}]); - List -> put(test_server_timetraps,[{Ref,TCPid,{Timeout,Scale}}|List]) + undefined -> + put(test_server_timetraps,[{Handle,TCPid,{TimeToReport,Scale}}]); + List -> + List1 = lists:delete({infinity,TCPid,{infinity,false}}, List), + put(test_server_timetraps,[{Handle,TCPid,{TimeToReport,Scale}}|List1]) end, - Ref. + Handle. ensure_timetrap(Config) -> case get(test_server_timetraps) of @@ -2064,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; @@ -2082,75 +2233,175 @@ 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, 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) -> - 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, undefined). + +time_ms_apply(Func, TCPid, MultAndScale) -> + {_,GL} = process_info(TCPid, group_leader), + WhoAmI = self(), % either TC or IO server + T0 = now(), + UserTTSup = + 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, MultAndScale) + 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, 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), + 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,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,T0,Elapsed,MultAndScale} + end; + {'EXIT',UserTT,Error} when Error /= normal -> + demonitor(MonRef, [flush]), + GL ! {user_timetrap,TCPid,0,T0,{user_timetrap_error,Error}, + MultAndScale}; + {'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. + +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). @@ -2159,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 875f45eea6..68d6198bb7 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. @@ -88,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 @@ -99,7 +115,6 @@ capture_get(Msgs) -> lists:reverse(Msgs) end. - messages_get(Msgs) -> receive Msg -> @@ -108,7 +123,6 @@ messages_get(Msgs) -> lists:reverse(Msgs) end. - timecall(M, F, A) -> Befor = erlang:now(), Val = apply(M, F, A), |