Implement support for user controlled timetraps

OTP-9988

2 files changed, 324 insertions, 159 deletions

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.