From 34cf18550ff792ed9da884b00a49d6accd1bd5f5 Mon Sep 17 00:00:00 2001
From: Peter Andersson <peppe@erlang.org>
Date: Fri, 4 Jun 2010 15:34:42 +0200
Subject: Add support for dynamic timetrap handling

---
 lib/common_test/src/ct.erl        | 14 +++++++++++++-
 lib/common_test/src/ct_config.erl | 35 ++++++++++++++++++++++-------------
 lib/common_test/src/ct_run.erl    | 25 ++++++++++++++++++-------
 3 files changed, 53 insertions(+), 21 deletions(-)

(limited to 'lib/common_test/src')

diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl
index 307d10428d..77bcf34981 100644
--- a/lib/common_test/src/ct.erl
+++ b/lib/common_test/src/ct.erl
@@ -65,7 +65,7 @@
 	 pal/1, pal/2, pal/3,
 	 fail/1, comment/1,
 	 testcases/2, userdata/2, userdata/3,
-	 sleep/1]).
+	 timetrap/1, sleep/1]).
 
 %% New API for manipulating with config handlers
 -export([add_config/2, remove_config/2]).
@@ -843,6 +843,18 @@ add_config(Callback, Config)->
 remove_config(Callback, Config) ->
     ct_config:remove_config(Callback, Config).
 
+%%%-----------------------------------------------------------------
+%%% @spec timetrap(Time) -> ok
+%%%       Time = {hours,Hours} | {minutes,Mins} | {seconds,Secs} | Millisecs | infinity
+%%%       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>
+timetrap(Time) ->
+    test_server:timetrap(Time).
+
 %%%-----------------------------------------------------------------
 %%% @spec sleep(Time) -> ok
 %%%       Time = {hours,Hours} | {minutes,Mins} | {seconds,Secs} | Millisecs | infinity
diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl
index a6ade3f66b..dc6fcc66e5 100644
--- a/lib/common_test/src/ct_config.erl
+++ b/lib/common_test/src/ct_config.erl
@@ -694,39 +694,48 @@ random_bytes_1(N, Acc) -> random_bytes_1(N-1, [random:uniform(255)|Acc]).
 check_callback_load(Callback) ->
     case code:is_loaded(Callback) of
 	{file, _Filename}->
-	     {ok, Callback};
+	    check_exports(Callback);
 	false->
 	    case code:load_file(Callback) of
 		{module, Callback}->
-		    {ok, Callback};
+		    check_exports(Callback);
 		{error, Error}->
 		    {error, Error}
 	    end
     end.
 
+check_exports(Callback) ->
+    Fs = Callback:module_info(exports),
+    case {lists:member({check_parameter,1},Fs),
+	  lists:member({read_config,1},Fs)} of
+	{true, true} ->
+	    {ok, Callback};
+	_ ->
+	    {error, missing_callback_functions}
+    end.
+
 check_config_files(Configs) ->
     ConfigChecker = fun
 	({Callback, [F|_R]=Files}) ->
 	    case check_callback_load(Callback) of
-		{ok, Callback}->
-			if
-			    is_integer(F) ->
+		{ok, Callback} ->
+			if is_integer(F) ->
 				Callback:check_parameter(Files);
-			    is_list(F) ->
+			   is_list(F) ->
 				lists:map(fun(File) ->
-				    Callback:check_parameter(File)
-				end,
-				Files)
+						  Callback:check_parameter(File)
+					  end,
+					  Files)
 			end;
-		{error, _}->
-		    {error, {callback, Callback}}
+		{error, Why}->
+		    {error, {callback, {Callback,Why}}}
 	    end;
 	({Callback, []}) ->
 	    case check_callback_load(Callback) of
 		{ok, Callback}->
 		     Callback:check_parameter([]);
-		{error, _}->
-		     {error, {callback, Callback}}
+		{error, Why}->
+		     {error, {callback, {Callback,Why}}}
 	    end
     end,
     lists:keysearch(error, 1, lists:flatten(lists:map(ConfigChecker, Configs))).
diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl
index f993985f52..ab900734f2 100644
--- a/lib/common_test/src/ct_run.erl
+++ b/lib/common_test/src/ct_run.erl
@@ -152,10 +152,12 @@ script_start1(Parent, Args) ->
     %% read general start flags
     Vts = get_start_opt(vts, true, Args),
     Shell = get_start_opt(shell, true, Args),
-    Cover = get_start_opt(cover, fun(CoverFile) -> ?abs(CoverFile) end, Args),
+    Cover = get_start_opt(cover, fun([CoverFile]) -> ?abs(CoverFile) end, Args),
     LogDir = get_start_opt(logdir, fun([LogD]) -> LogD end, Args),
-    MultTT = get_start_opt(multiply_timetraps, fun(MT) -> MT end, 1, Args),
-    ScaleTT = get_start_opt(scale_timetraps, fun(CT) -> CT end, false, Args),
+    MultTT = get_start_opt(multiply_timetraps,
+			   fun([MT]) -> list_to_integer(MT) end, 1, Args),
+    ScaleTT = get_start_opt(scale_timetraps,
+			    fun([CT]) -> list_to_atom(CT) end, false, Args),
     EvHandlers = event_handler_args2opts(Args),
 
     %% check flags and set corresponding application env variables
@@ -335,8 +337,8 @@ check_and_install_configfiles(Configs, LogDir, EvHandlers) ->
 	    {error,{cant_read_config_file,File}};
 	{value,{error,{wrong_config,Message}}}->
 	    {error,{wrong_config,Message}};
-	{value,{error,{callback,File}}} ->
-	    {error,{cant_load_callback_module,File}}
+	{value,{error,{callback,Info}}} ->
+	    {error,{cant_load_callback_module,Info}}
     end.
 
 script_start3(StartOpts, Args) ->
@@ -745,14 +747,23 @@ run_prepared(Run, Skip, Opts = #opts{logdir = LogDir,
     end.
 
 check_config_file(Callback, File)->
+    case code:is_loaded(Callback) of
+	false ->
+	    case code:load_file(Callback) of
+		{module,_} -> ok;
+		{error,Why} -> exit({cant_load_callback_module,Why})
+	    end;
+	_ ->
+	    ok
+    end,
     case Callback:check_parameter(File) of
 	{ok,{file,File}}->
 	    ?abs(File);
 	{ok,{config,_}}->
 	    File;
-	{nok,{wrong_config,Message}}->
+	{error,{wrong_config,Message}}->
 	    exit({wrong_config,{Callback,Message}});
-	{nok,{nofile,File}}->
+	{error,{nofile,File}}->
 	    exit({no_such_file,?abs(File)})
     end.
 
-- 
cgit v1.2.3