Implement support for user controlled timetraps

OTP-9988

7 files changed, 186 insertions, 74 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(_, _) ->