From c2a3647e471bb08de24d867bc7c3f541e2f7a15d Mon Sep 17 00:00:00 2001
From: Peter Andersson <peppe@erlang.org>
Date: Tue, 20 Mar 2012 01:29:02 +0100
Subject: Implement support for user controlled timetraps

OTP-9988
---
 lib/test_server/src/test_server_sup.erl | 58 ++++++++++++++++++++-------------
 1 file changed, 35 insertions(+), 23 deletions(-)

(limited to 'lib/test_server/src/test_server_sup.erl')

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.
 
-- 
cgit v1.2.3


From 88c935d87a9878016e07b5a3f42bc8efe30b1eea Mon Sep 17 00:00:00 2001
From: Peter Andersson <peppe@erlang.org>
Date: Thu, 22 Mar 2012 18:46:41 +0100
Subject: Fix various problems with the user timetrap implementation

---
 lib/test_server/src/test_server_sup.erl | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

(limited to 'lib/test_server/src/test_server_sup.erl')

diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl
index d85d1658c3..68d6198bb7 100644
--- a/lib/test_server/src/test_server_sup.erl
+++ b/lib/test_server/src/test_server_sup.erl
@@ -100,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
@@ -111,7 +115,6 @@ capture_get(Msgs) ->
 	    lists:reverse(Msgs)
     end.
 
-
 messages_get(Msgs) ->
     receive
 	Msg ->
@@ -120,7 +123,6 @@ messages_get(Msgs) ->
 	    lists:reverse(Msgs)
     end.
 
-
 timecall(M, F, A) ->
     Befor = erlang:now(),
     Val = apply(M, F, A),
-- 
cgit v1.2.3