aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lib/common_test/src/ct.erl14
-rw-r--r--lib/common_test/src/ct_framework.erl6
-rw-r--r--lib/common_test/test/ct_error_SUITE.erl137
-rw-r--r--lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_5_SUITE.erl84
-rw-r--r--lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_7_SUITE.erl4
-rw-r--r--lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_utils.erl9
-rw-r--r--lib/common_test/test/ct_test_support.erl6
-rw-r--r--lib/test_server/src/test_server.erl425
-rw-r--r--lib/test_server/src/test_server_sup.erl58
9 files changed, 510 insertions, 233 deletions
diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl
index 63a8adbc63..296416737f 100644
--- a/lib/common_test/src/ct.erl
+++ b/lib/common_test/src/ct.erl
@@ -993,13 +993,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..c8aff3c039 100644
--- a/lib/common_test/src/ct_framework.erl
+++ b/lib/common_test/src/ct_framework.erl
@@ -212,7 +212,7 @@ init_tc2(Mod,Suite,Func,SuiteInfo,MergeResult,Config) ->
{auto_skip,{require_failed,Reason}};
{'EXIT',Reason} ->
{auto_skip,Reason};
- {ok,FinalConfig} ->
+ {ok,Config1} ->
case MergeResult of
{error,Reason} ->
%% suite0 configure finished now, report that
@@ -221,9 +221,9 @@ init_tc2(Mod,Suite,Func,SuiteInfo,MergeResult,Config) ->
_ ->
case get('$test_server_framework_test') of
undefined ->
- ct_suite_init(Suite, FuncSpec, FinalConfig);
+ ct_suite_init(Mod, FuncSpec, Config1);
Fun ->
- case Fun(init_tc, FinalConfig) of
+ case Fun(init_tc, Config1) of
NewConfig when is_list(NewConfig) ->
{ok,NewConfig};
Else ->
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 6df02d12b7..753e4d8d42 100644
--- a/lib/common_test/test/ct_test_support.erl
+++ b/lib/common_test/test/ct_test_support.erl
@@ -1001,6 +1001,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..7baae966c9 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/test_server/src/test_server.erl
@@ -628,7 +628,7 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
end),
group_leader(OldGLeader, self()),
put(test_server_detected_fail, []),
- run_test_case_msgloop(Ref, Pid, false, false, "", undefined).
+ run_test_case_msgloop(Ref, Pid, false, false, "", undefined, starting).
%% Ugly bug (pre R5A):
%% If this process (group leader of the test case) terminates before
@@ -639,7 +639,8 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
%% A test case is known to have failed if it returns {'EXIT', _} tuple,
%% or sends a message {failed, File, Line} to it's group_leader
%%
-run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
+run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate,
+ Comment, CurrConf, Status) ->
%% NOTE: Keep job_proxy_msgloop/0 up to date when changes
%% are made in this function!
{Timeout,ReturnValue} =
@@ -650,8 +651,22 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
{infinity, should_never_appear}
end,
receive
+ {test_case_initialized,Pid} ->
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,running);
+ Abort = {abort_current_testcase,_,_} when Status == starting ->
+ %% we're in init phase, must must postpone this operation
+ %% until test case execution is in progress (or FW:init_tc
+ %% gets killed)
+ self() ! Abort,
+ erlang:yield(),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
{abort_current_testcase,Reason,From} ->
- Line = get_loc(Pid),
+ Line = case is_process_alive(Pid) of
+ true -> get_loc(Pid);
+ false -> unknown
+ end,
Mon = erlang:monitor(process, Pid),
exit(Pid,{testcase_aborted,Reason,Line}),
erlang:yield(),
@@ -665,76 +680,94 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
exit(Pid, kill),
%% here's the only place we know Reason, so we save
%% it as a comment, potentially replacing user data
- Error = lists:flatten(io_lib:format("Aborted: ~p",[Reason])),
+ Error = lists:flatten(io_lib:format("Aborted: ~p",
+ [Reason])),
Error1 = lists:flatten([string:strip(S,left) ||
- S <- string:tokens(Error,[$\n])]),
+ S <- string:tokens(Error,
+ [$\n])]),
if length(Error1) > 63 ->
string:substr(Error1,1,60) ++ "...";
true ->
Error1
end
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,NewComment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ NewComment,CurrConf,Status);
{io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}}
when is_list(Format) ->
Msg = (catch io_lib:Func(Format,Args)),
run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
{io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}}
when is_atom(Format) ->
Msg = (catch io_lib:Func(Format,Args)),
run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
{io_request,From,ReplyAs,{put_chars,Bytes}} ->
run_test_case_msgloop_io(
ReplyAs,CaptureStdout,Bytes,From,put_chars),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
{io_request,From,ReplyAs,{put_chars,unicode,io_lib,Func,[Format,Args]}}
when is_list(Format) ->
Msg = unicode_to_latin1(catch io_lib:Func(Format,Args)),
run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
{io_request,From,ReplyAs,{put_chars,latin1,io_lib,Func,[Format,Args]}}
when is_list(Format) ->
Msg = (catch io_lib:Func(Format,Args)),
run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
{io_request,From,ReplyAs,{put_chars,unicode,io_lib,Func,[Format,Args]}}
when is_atom(Format) ->
Msg = unicode_to_latin1(catch io_lib:Func(Format,Args)),
run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
{io_request,From,ReplyAs,{put_chars,latin1,io_lib,Func,[Format,Args]}}
when is_atom(Format) ->
Msg = (catch io_lib:Func(Format,Args)),
run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
{io_request,From,ReplyAs,{put_chars,unicode,Bytes}} ->
run_test_case_msgloop_io(
ReplyAs,CaptureStdout,unicode_to_latin1(Bytes),From,put_chars),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
{io_request,From,ReplyAs,{put_chars,latin1,Bytes}} ->
run_test_case_msgloop_io(
ReplyAs,CaptureStdout,Bytes,From,put_chars),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
IoReq when element(1, IoReq) == io_request ->
%% something else, just pass it on
group_leader() ! IoReq,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
{structured_io,ClientPid,Msg} ->
output(Msg, ClientPid),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
{capture,NewCapture} ->
- run_test_case_msgloop(Ref,Pid,NewCapture,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,NewCapture,Terminate,
+ Comment,CurrConf,Status);
{sync_apply,From,MFA} ->
sync_local_or_remote_apply(false,From,MFA),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
{sync_apply_proxy,Proxy,From,MFA} ->
sync_local_or_remote_apply(Proxy,From,MFA),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
{printout,Detail,Format,Args} ->
print(Detail,Format,Args),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
{comment,NewComment} ->
NewComment1 = test_server_ctrl:to_string(NewComment),
NewComment2 = test_server_sup:framework_call(format_comment,
@@ -747,13 +780,16 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
Other ->
Other
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate1,NewComment2,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate1,
+ NewComment2,CurrConf,Status);
{read_comment,From} ->
From ! {self(),read_comment,Comment},
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
{set_curr_conf,From,NewCurrConf} ->
From ! {self(),set_curr_conf,ok},
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,NewCurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,NewCurrConf,Status);
{make_priv_dir,From} when CurrConf == undefined ->
From ! {self(),make_priv_dir,{error,no_priv_dir_in_config}};
{make_priv_dir,From} ->
@@ -772,10 +808,12 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
end
end,
From ! {self(),make_priv_dir,Result},
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
{'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} ->
RetVal = {Time/1000000,Value,mod_loc(Loc),Opts,Comment},
- run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment,undefined);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},
+ Comment,undefined,Status);
{'EXIT',Pid,Reason} ->
case Reason of
{timetrap_timeout,TVal,Loc} ->
@@ -786,36 +824,42 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
{framework_error,{timetrap,TVal}},
unknown,self()),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
- Comment,undefined);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,
+ Terminate,Comment,
+ undefined,Status);
Loc1 ->
%% call end_per_testcase on a separate process,
- %% only so that the user has a chance to clean up
- %% after init_per_testcase, even after a timetrap timeout
+ %% only so that the user has a chance to
+ %% clean up after init_per_testcase, even after
+ %% a timetrap timeout
NewCurrConf =
case CurrConf of
{{Mod,Func},Conf} ->
EndConfPid =
- call_end_conf(Mod,Func,Pid,
- {timetrap_timeout,TVal},
- Loc1,[{tc_status,
- {failed,
- timetrap_timeout}}|Conf],
- TVal),
+ call_end_conf(
+ Mod,Func,Pid,
+ {timetrap_timeout,TVal},
+ Loc1,[{tc_status,
+ {failed,
+ timetrap_timeout}}|Conf],
+ TVal),
{EndConfPid,{Mod,Func},Conf};
_ ->
{Mod,Func} = get_mf(Loc1),
- %% The framework functions mustn't execute on this
- %% group leader process or io will cause deadlock,
- %% so we spawn a dedicated process for the operation
- %% and let the group leader go back to handle io.
+ %% The framework functions mustn't
+ %% execute on this group leader process
+ %% or io will cause deadlock, so we
+ %% spawn a dedicated process for the
+ %% operation and let the group leader
+ %% go back to handle io.
spawn_fw_call(Mod,Func,CurrConf,Pid,
{timetrap_timeout,TVal},
Loc1,self()),
undefined
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
- Comment,NewCurrConf)
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,
+ Terminate,Comment,
+ NewCurrConf,Status)
end;
{timetrap_timeout,TVal,Loc,InitOrEnd} ->
case mod_loc(Loc) of
@@ -830,7 +874,17 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
{timetrap_timeout,TVal},
Loc1,self())
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
+ {testcase_aborted,ErrorMsg={user_timetrap_error,_},AbortLoc} ->
+ %% user timetrap function caused exit
+ %% during start of test case
+ {Mod,Func} = get_mf(mod_loc(AbortLoc)),
+ spawn_fw_call(Mod,Func,CurrConf,Pid,
+ ErrorMsg,unknown,self()),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,
+ Terminate,Comment,
+ undefined,Status);
{testcase_aborted,AbortReason,AbortLoc} ->
ErrorMsg = {testcase_aborted,AbortReason},
case mod_loc(AbortLoc) of
@@ -839,33 +893,41 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
{framework_error,ErrorMsg},
unknown,self()),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
- Comment,undefined);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,
+ Terminate,Comment,
+ undefined,Status);
Loc1 ->
- %% call end_per_testcase on a separate process, only so
- %% that the user has a chance to clean up after init_per_testcase,
- %% even after abortion
+ %% call end_per_testcase on a separate process,
+ %% only so that the user has a chance to clean up
+ %% after init_per_testcase, even after abortion
NewCurrConf =
case CurrConf of
{{Mod,Func},Conf} ->
- TVal = case lists:keysearch(default_timeout,1,Conf) of
- {value,{default_timeout,Tmo}} -> Tmo;
- _ -> ?DEFAULT_TIMETRAP_SECS*1000
- end,
+ TVal =
+ case lists:keysearch(default_timeout,
+ 1,
+ Conf) of
+ {value,{default_timeout,Tmo}} ->
+ Tmo;
+ _ ->
+ ?DEFAULT_TIMETRAP_SECS*1000
+ end,
EndConfPid =
- call_end_conf(Mod,Func,Pid,ErrorMsg,
- Loc1,
- [{tc_status,{failed,ErrorMsg}}|Conf],
- TVal),
+ call_end_conf(
+ Mod,Func,Pid,
+ ErrorMsg,Loc1,
+ [{tc_status,
+ {failed,ErrorMsg}}|Conf],TVal),
{EndConfPid,{Mod,Func},Conf};
_ ->
{Mod,Func} = get_mf(Loc1),
- spawn_fw_call(Mod,Func,CurrConf,Pid,ErrorMsg,
- Loc1,self()),
+ spawn_fw_call(Mod,Func,CurrConf,Pid,
+ ErrorMsg,Loc1,self()),
undefined
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
- Comment,NewCurrConf)
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,
+ Terminate,Comment,
+ NewCurrConf,Status)
end;
killed ->
%% result of an exit(TestCase,kill) call, which is the
@@ -878,11 +940,14 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
spawn_fw_call(Mod,Func,CurrConf,Pid,
testcase_aborted_or_killed,
unknown,self()),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
{fw_error,{FwMod,FwFunc,FwError}} ->
- spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,{framework_error,FwError},
+ spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
+ {framework_error,FwError},
unknown,self()),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
_Other ->
%% the testcase has terminated because of Reason (e.g. an exit
%% because a linked process failed)
@@ -890,17 +955,22 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
{MF,_} -> MF;
_ -> {undefined,undefined}
end,
- spawn_fw_call(Mod,Func,CurrConf,Pid,Reason,unknown,self()),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf)
+ spawn_fw_call(Mod,Func,CurrConf,Pid,
+ Reason,unknown,self()),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status)
end;
{EndConfPid,{call_end_conf,Data,_Result}} ->
case CurrConf of
{EndConfPid,{Mod,Func},_Conf} ->
{_Mod,_Func,TCPid,TCExitReason,Loc} = Data,
- spawn_fw_call(Mod,Func,CurrConf,TCPid,TCExitReason,Loc,self()),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,undefined);
+ spawn_fw_call(Mod,Func,CurrConf,TCPid,
+ TCExitReason,Loc,self()),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,undefined,Status);
_ ->
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf)
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status)
end;
{_FwCallPid,fw_notify_done,{T,Value,Loc,Opts,AddToComment}} ->
%% the framework has been notified, we're finished
@@ -920,7 +990,8 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
end,
{T,Value,Loc,Opts,Comment1}
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment,undefined);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},
+ Comment,undefined,Status);
{'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} ->
%% a framework function failed
CB = os:getenv("TEST_SERVER_FRAMEWORK"),
@@ -931,20 +1002,46 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
{list_to_atom(CB),Func}
end,
RetVal = {died,{framework_error,Loc,Error},Loc,"Framework error"},
- run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment,undefined);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},
+ Comment,undefined,Status);
{failed,File,Line} ->
put(test_server_detected_fail,
[{File, Line}| get(test_server_detected_fail)]),
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
+
+ {user_timetrap,Pid,_TrapTime,Error={user_timetrap_error,_}} ->
+ self() ! {abort_current_testcase,Error,Pid},
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
+ {user_timetrap,Pid,0,ElapsedTime} ->
+ %% a user timetrap is triggered, use the test case execution
+ %% time as timeout value for the error report
+ timetrap(0, ElapsedTime, Pid),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
+ {user_timetrap,Pid,TrapTime,ElapsedTime} ->
+ TotalTime = if is_integer(TrapTime) -> TrapTime + ElapsedTime;
+ true -> TrapTime
+ end,
+ timetrap(TrapTime, TotalTime, Pid),
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
+ {user_timetrap,_OldPid,_TrapTime,_} ->
+ %% a timetrap for a previous test case triggered, ignore
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
_Other when not is_tuple(_Other) ->
%% ignore anything not generated by test server
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status);
_Other when element(1, _Other) /= 'EXIT',
element(1, _Other) /= started,
element(1, _Other) /= finished,
element(1, _Other) /= print ->
%% ignore anything not generated by test server
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf)
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
+ Comment,CurrConf,Status)
after Timeout ->
ReturnValue
end.
@@ -1177,9 +1274,11 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit,
put(test_server_multiply_timetraps, TimetrapData),
put(test_server_logopts, LogOpts),
+ FWInitResult = test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0],
+ {ok,Args0}),
+ group_leader() ! {test_case_initialized,self()},
{{Time,Value},Loc,Opts} =
- case test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0],
- {ok,Args0}) of
+ case FWInitResult of
{ok,Args} ->
run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback);
Error = {error,_Reason} ->
@@ -2020,24 +2119,44 @@ timetrap_scale_factor() ->
%%
%% Creates a time trap, that will kill the calling process if the
%% trap is not cancelled with timetrap_cancel/1, within Timeout milliseconds.
-timetrap(Timeout0) ->
- Timeout = time_ms(Timeout0),
+timetrap(Timeout) ->
+ timetrap(Timeout, self()).
+
+timetrap(Timeout, TCPid) ->
+ timetrap(Timeout, Timeout, TCPid).
+
+timetrap(Timeout0, TimeToReport0, TCPid) ->
+ Timeout = time_ms(Timeout0, TCPid),
+ TimeToReport = if Timeout0 == TimeToReport0 ->
+ Timeout;
+ true ->
+ time_ms_check(TimeToReport0)
+ end,
cancel_default_timetrap(),
case get(test_server_multiply_timetraps) of
- undefined -> timetrap1(Timeout, true);
- {undefined,false} -> timetrap1(Timeout, false);
- {undefined,_} -> timetrap1(Timeout, true);
- {infinity,_} -> infinity;
- {_Int,_Scale} when Timeout == infinity -> infinity;
- {Int,Scale} -> timetrap1(Timeout*Int, Scale)
+ undefined -> timetrap1(Timeout, TimeToReport, TCPid, true);
+ {undefined,false} -> timetrap1(Timeout, TimeToReport, TCPid, false);
+ {undefined,_} -> timetrap1(Timeout, TimeToReport, TCPid, true);
+ {infinity,_} -> timetrap1(infinity, TimeToReport, TCPid, false);
+ {_Int,_Scale} when Timeout == infinity ->
+ timetrap1(infinity, TimeToReport, TCPid, false);
+ {Int,Scale} -> timetrap1(Timeout*Int, TimeToReport*Int, TCPid, Scale)
end.
-timetrap1(Timeout, Scale) ->
- TCPid = self(),
- Ref = spawn_link(test_server_sup,timetrap,[Timeout,Scale,TCPid]),
+timetrap1(Timeout, TimeToReport, TCPid, Scale) ->
+ Ref = case Timeout of
+ infinity ->
+ infinity;
+ _ ->
+ spawn_link(test_server_sup,timetrap,[Timeout,TimeToReport,
+ Scale,TCPid])
+ end,
case get(test_server_timetraps) of
- undefined -> put(test_server_timetraps,[{Ref,TCPid,{Timeout,Scale}}]);
- List -> put(test_server_timetraps,[{Ref,TCPid,{Timeout,Scale}}|List])
+ undefined ->
+ put(test_server_timetraps,[{Ref,TCPid,{TimeToReport,Scale}}]);
+ List ->
+ List1 = lists:delete({infinity,TCPid,{infinity,false}}, List),
+ put(test_server_timetraps,[{Ref,TCPid,{TimeToReport,Scale}}|List1])
end,
Ref.
@@ -2082,61 +2201,95 @@ cancel_default_timetrap() ->
error
end.
-
-time_ms({hours,N}) -> hours(N);
-time_ms({minutes,N}) -> minutes(N);
-time_ms({seconds,N}) -> seconds(N);
-time_ms({Other,_N}) ->
+time_ms({hours,N}, _) -> hours(N);
+time_ms({minutes,N}, _) -> minutes(N);
+time_ms({seconds,N}, _) -> seconds(N);
+time_ms({Other,_N}, _) ->
format("=== ERROR: Invalid time specification: ~p. "
"Should be seconds, minutes, or hours.~n", [Other]),
exit({invalid_time_format,Other});
-time_ms(Ms) when is_integer(Ms) -> Ms;
-time_ms(infinity) -> infinity;
-time_ms(Fun) when is_function(Fun) ->
- time_ms_apply(Fun);
-time_ms({M,F,A}=MFA) when is_atom(M), is_atom(F), is_list(A) ->
- time_ms_apply(MFA);
-time_ms(Other) -> exit({invalid_time_format,Other}).
-
-time_ms_apply(Func) ->
- time_ms_apply(Func, [5000,30000,60000,infinity]).
-
-time_ms_apply(Func, TOs) ->
- Apply = fun() ->
- case Func of
- {M,F,A} ->
- exit({self(),apply(M, F, A)});
- Fun ->
- exit({self(),Fun()})
- end
- end,
- Pid = spawn(Apply),
- Ref = monitor(process, Pid),
- time_ms_wait(Func, Pid, Ref, TOs).
-
-time_ms_wait(Func, Pid, Ref, [TO|TOs]) ->
- receive
- {'DOWN',Ref,process,Pid,{Pid,Result}} ->
- time_ms_check(Result);
- {'DOWN',Ref,process,Pid,Error} ->
- exit({timetrap_error,Error})
- after
- TO ->
- format("=== WARNING: No return from timetrap function ~p~n", [Func]),
- time_ms_wait(Func, Pid, Ref, TOs)
- end;
-%% this clause will never execute if 'infinity' is in TOs list, that's ok!
-time_ms_wait(Func, Pid, Ref, []) ->
- demonitor(Ref),
- exit(Pid, kill),
- exit({timetrap_error,{no_return_from_timetrap_function,Func}}).
+time_ms(Ms, _) when is_integer(Ms) -> Ms;
+time_ms(infinity, _) -> infinity;
+time_ms(Fun, TCPid) when is_function(Fun) ->
+ time_ms_apply(Fun, TCPid);
+time_ms({M,F,A}=MFA, TCPid) when is_atom(M), is_atom(F), is_list(A) ->
+ time_ms_apply(MFA, TCPid);
+time_ms(Other, _) -> exit({invalid_time_format,Other}).
time_ms_check(MFA = {M,F,A}) when is_atom(M), is_atom(F), is_list(A) ->
- exit({invalid_time_format,MFA});
+ MFA;
time_ms_check(Fun) when is_function(Fun) ->
- exit({invalid_time_format,Fun});
+ Fun;
time_ms_check(Other) ->
- time_ms(Other).
+ time_ms(Other, undefined).
+
+time_ms_apply(Func, TCPid) ->
+ {_,GL} = process_info(TCPid, group_leader),
+ WhoAmI = self(), % either TC or IO server
+ UserTTSup =
+ spawn_link(fun() ->
+ user_timetrap_supervisor(Func, WhoAmI, TCPid, GL)
+ end),
+ receive
+ {UserTTSup,infinity} ->
+ %% we need to make sure the user timetrap function
+ %% gets time to execute and return
+ timetrap(infinity, TCPid)
+ after 5000 ->
+ exit(UserTTSup, kill),
+ if WhoAmI /= GL ->
+ exit({user_timetrap_error,time_ms_apply});
+ true ->
+ format("=== ERROR: User timetrap execution failed!", []),
+ ignore
+ end
+ end.
+
+user_timetrap_supervisor(Func, Spawner, TCPid, GL) ->
+ process_flag(trap_exit, true),
+ Spawner ! {self(),infinity},
+ MonRef = monitor(process, TCPid),
+ UserTTSup = self(),
+ group_leader(GL, UserTTSup),
+ UserTT = spawn_link(fun() -> call_user_timetrap(Func, UserTTSup) end),
+ T0 = now(),
+ receive
+ {UserTT,Result} ->
+ demonitor(MonRef, [flush]),
+ Elapsed = trunc(timer:now_diff(now(), T0) / 1000),
+ try time_ms_check(Result) of
+ TimeVal ->
+ %% this is the new timetrap value to set (return value
+ %% from a fun or an MFA)
+ GL ! {user_timetrap,TCPid,TimeVal,Elapsed}
+ catch _:_ ->
+ %% when other than a legal timetrap value is returned
+ %% which will be the normal case for user timetraps
+ GL ! {user_timetrap,TCPid,0,Elapsed}
+ end;
+ {'EXIT',UserTT,Error} when Error /= normal ->
+ demonitor(MonRef, [flush]),
+ GL ! {user_timetrap,TCPid,0,{user_timetrap_error,Error}};
+
+ {'DOWN',MonRef,_,_,_} ->
+ demonitor(MonRef, [flush]),
+ exit(UserTT, kill)
+ end.
+
+call_user_timetrap(Func, Sup) when is_function(Func) ->
+ try Func() of
+ Result ->
+ Sup ! {self(),Result}
+ catch _:Error ->
+ exit({Error,erlang:get_stacktrace()})
+ end;
+call_user_timetrap({M,F,A}, Sup) ->
+ try apply(M,F,A) of
+ Result ->
+ Sup ! {self(),Result}
+ catch _:Error ->
+ exit({Error,erlang:get_stacktrace()})
+ end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timetrap_cancel(Handle) -> ok
diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl
index 875f45eea6..d85d1658c3 100644
--- a/lib/test_server/src/test_server_sup.erl
+++ b/lib/test_server/src/test_server_sup.erl
@@ -21,7 +21,8 @@
%%% Purpose: Test server support functions.
%%%-------------------------------------------------------------------
-module(test_server_sup).
--export([timetrap/2, timetrap/3, timetrap_cancel/1, capture_get/1, messages_get/1,
+-export([timetrap/2, timetrap/3, timetrap/4,
+ timetrap_cancel/1, capture_get/1, messages_get/1,
timecall/3, call_crash/5, app_test/2, check_new_crash_dumps/0,
cleanup_crash_dumps/0, crash_dump_dir/0, tar_crash_dumps/0,
get_username/0, get_os_family/0,
@@ -44,9 +45,12 @@
%% delays during the test (e.g. if cover is running).
timetrap(Timeout0, Pid) ->
- timetrap(Timeout0, true, Pid).
+ timetrap(Timeout0, Timeout0, true, Pid).
timetrap(Timeout0, Scale, Pid) ->
+ timetrap(Timeout0, Timeout0, Scale, Pid).
+
+timetrap(Timeout0, ReportTVal, Scale, Pid) ->
process_flag(priority, max),
Timeout = if not Scale -> Timeout0;
true -> test_server:timetrap_scale_factor() * Timeout0
@@ -54,28 +58,36 @@ timetrap(Timeout0, Scale, Pid) ->
TruncTO = trunc(Timeout),
receive
after TruncTO ->
- MFLs = test_server:get_loc(Pid),
- Mon = erlang:monitor(process, Pid),
- Trap =
- case get(test_server_init_or_end_conf) of
- undefined ->
- {timetrap_timeout,TruncTO,MFLs};
- InitOrEnd ->
- {timetrap_timeout,TruncTO,MFLs,InitOrEnd}
- end,
- exit(Pid, Trap),
- receive
- {'DOWN', Mon, process, Pid, _} ->
+ case is_process_alive(Pid) of
+ true ->
+ TimeToReport = if Timeout0 == ReportTVal -> TruncTO;
+ true -> ReportTVal end,
+ MFLs = test_server:get_loc(Pid),
+ Mon = erlang:monitor(process, Pid),
+ Trap =
+ case get(test_server_init_or_end_conf) of
+ undefined ->
+ {timetrap_timeout,TimeToReport,MFLs};
+ InitOrEnd ->
+ {timetrap_timeout,TimeToReport,MFLs,InitOrEnd}
+ end,
+ exit(Pid, Trap),
+ receive
+ {'DOWN', Mon, process, Pid, _} ->
+ ok
+ after 10000 ->
+ %% Pid is probably trapping exits, hit it harder...
+ catch error_logger:warning_msg(
+ "Testcase process ~p not "
+ "responding to timetrap "
+ "timeout:~n"
+ " ~p.~n"
+ "Killing testcase...~n",
+ [Pid, Trap]),
+ exit(Pid, kill)
+ end;
+ false ->
ok
- after 10000 ->
- %% Pid is probably trapping exits, hit it harder...
- catch error_logger:warning_msg("Testcase process ~p not "
- "responding to timetrap "
- "timeout:~n"
- " ~p.~n"
- "Killing testcase...~n",
- [Pid, Trap]),
- exit(Pid, kill)
end
end.