aboutsummaryrefslogtreecommitdiffstats
path: root/lib/common_test/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/common_test/src')
-rw-r--r--lib/common_test/src/Makefile7
-rw-r--r--lib/common_test/src/common_test.app.src3
-rw-r--r--lib/common_test/src/ct.erl179
-rw-r--r--lib/common_test/src/ct_config.erl2
-rw-r--r--lib/common_test/src/ct_config_plain.erl2
-rw-r--r--lib/common_test/src/ct_config_xml.erl2
-rw-r--r--lib/common_test/src/ct_framework.erl532
-rw-r--r--lib/common_test/src/ct_hooks.erl50
-rw-r--r--lib/common_test/src/ct_line.erl266
-rw-r--r--lib/common_test/src/ct_logs.erl660
-rw-r--r--lib/common_test/src/ct_make.erl2
-rw-r--r--lib/common_test/src/ct_run.erl120
-rw-r--r--lib/common_test/src/ct_telnet.erl2
-rw-r--r--lib/common_test/src/ct_testspec.erl13
-rw-r--r--lib/common_test/src/ct_util.hrl1
-rw-r--r--lib/common_test/src/cth_log_redirect.erl111
16 files changed, 1274 insertions, 678 deletions
diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile
index 84b122b5e4..125aa828fb 100644
--- a/lib/common_test/src/Makefile
+++ b/lib/common_test/src/Makefile
@@ -40,7 +40,6 @@ RELSYSDIR = $(RELEASE_PATH)/lib/common_test-$(VSN)
# ----------------------------------------------------
MODULES= \
- ct_line \
ct \
ct_logs \
ct_framework \
@@ -69,9 +68,11 @@ MODULES= \
ct_config_xml \
ct_slave \
ct_hooks\
- ct_hooks_lock
+ ct_hooks_lock\
+ cth_log_redirect
TARGET_MODULES= $(MODULES:%=$(EBIN)/%)
+BEAM_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
ERL_FILES= $(MODULES:=.erl)
HRL_FILES = \
@@ -97,7 +98,7 @@ ERL_COMPILE_FLAGS += -pa ../ebin -I../include -I $(ERL_TOP)/lib/snmp/include/ \
# ----------------------------------------------------
TARGET_FILES = \
$(GEN_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \
- $(MODULES:%=$(EBIN)/%.$(EMULATOR)) \
+ $(BEAM_FILES) \
$(APP_TARGET) $(APPUP_TARGET)
APP_FILE= common_test.app
diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src
index b42173f412..7fba484b18 100644
--- a/lib/common_test/src/common_test.app.src
+++ b/lib/common_test/src/common_test.app.src
@@ -1,7 +1,7 @@
% This is an -*- erlang -*- file.
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2009-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -25,7 +25,6 @@
ct_framework,
ct_ftp,
ct_gen_conn,
- ct_line,
ct_logs,
ct_make,
ct_master,
diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl
index f3c2029734..e0e82283c4 100644
--- a/lib/common_test/src/ct.erl
+++ b/lib/common_test/src/ct.erl
@@ -63,9 +63,10 @@
log/1, log/2, log/3,
print/1, print/2, print/3,
pal/1, pal/2, pal/3,
- fail/1, comment/1,
+ capture_start/0, capture_stop/0, capture_get/0, capture_get/1,
+ fail/1, fail/2, comment/1, comment/2,
testcases/2, userdata/2, userdata/3,
- timetrap/1, sleep/1]).
+ timetrap/1, get_timetrap_info/0, sleep/1]).
%% New API for manipulating with config handlers
-export([add_config/2, remove_config/2]).
@@ -108,7 +109,7 @@ install(Opts) ->
%%% Cases = atom() | [atom()]
%%% Result = [TestResult] | {error,Reason}
%%%
-%%% @doc Run the given testcase(s).
+%%% @doc Run the given test case(s).
%%%
%%% <p>Requires that <code>ct:install/1</code> has been run first.</p>
%%%
@@ -121,7 +122,7 @@ run(TestDir,Suite,Cases) ->
%%%-----------------------------------------------------------------
%%% @spec run(TestDir,Suite) -> Result
%%%
-%%% @doc Run all testcases in the given suite.
+%%% @doc Run all test cases in the given suite.
%%% @see run/3.
run(TestDir,Suite) ->
ct_run:run(TestDir,Suite).
@@ -130,7 +131,7 @@ run(TestDir,Suite) ->
%%% @spec run(TestDirs) -> Result
%%% TestDirs = TestDir | [TestDir]
%%%
-%%% @doc Run all testcases in all suites in the given directories.
+%%% @doc Run all test cases in all suites in the given directories.
%%% @see run/3.
run(TestDirs) ->
ct_run:run(TestDirs).
@@ -148,8 +149,8 @@ run(TestDirs) ->
%%% {auto_compile,Bool} | {multiply_timetraps,M} | {scale_timetraps,Bool} |
%%% {repeat,N} | {duration,DurTime} | {until,StopTime} |
%%% {force_stop,Bool} | {decrypt,DecryptKeyOrFile} |
-%%% {refresh_logs,LogDir} | {logopts,LogOpts} | {basic_html,Bool} |
-%%% {ct_hooks, CTHs}
+%%% {refresh_logs,LogDir} | {logopts,LogOpts} | {basic_html,Bool} |
+%%% {ct_hooks, CTHs} | {enable_builtin_hooks,Bool}
%%% TestDirs = [string()] | string()
%%% Suites = [string()] | [atom()] | string() | atom()
%%% Cases = [atom()] | atom()
@@ -440,11 +441,10 @@ log(X1,X2) ->
%%% Format = string()
%%% Args = list()
%%%
-%%% @doc Printout from a testcase to the log.
+%%% @doc Printout from a test case to the log file.
%%%
-%%% <p>This function is meant for printing stuff directly from a
-%%% testcase (i.e. not from within the CT framework) in the test
-%%% log.</p>
+%%% <p>This function is meant for printing a string directly from a
+%%% test case to the test case log file.</p>
%%%
%%% <p>Default <code>Category</code> is <code>default</code> and
%%% default <code>Args</code> is <code>[]</code>.</p>
@@ -473,10 +473,10 @@ print(X1,X2) ->
%%% Format = string()
%%% Args = list()
%%%
-%%% @doc Printout from a testcase to the console.
+%%% @doc Printout from a test case to the console.
%%%
-%%% <p>This function is meant for printing stuff from a testcase on
-%%% the console.</p>
+%%% <p>This function is meant for printing a string from a test case
+%%% to the console.</p>
%%%
%%% <p>Default <code>Category</code> is <code>default</code> and
%%% default <code>Args</code> is <code>[]</code>.</p>
@@ -508,16 +508,75 @@ pal(X1,X2) ->
%%% Format = string()
%%% Args = list()
%%%
-%%% @doc Print and log from a testcase.
+%%% @doc Print and log from a test case.
%%%
-%%% <p>This function is meant for printing stuff from a testcase both
-%%% in the log and on the console.</p>
+%%% <p>This function is meant for printing a string from a test case,
+%%% both to the test case log file and to the console.</p>
%%%
%%% <p>Default <code>Category</code> is <code>default</code> and
%%% default <code>Args</code> is <code>[]</code>.</p>
pal(Category,Format,Args) ->
ct_logs:tc_pal(Category,Format,Args).
+%%%-----------------------------------------------------------------
+%%% @spec capture_start() -> ok
+%%%
+%%% @doc Start capturing all text strings printed to stdout during
+%%% execution of the test case.
+%%%
+%%% @see capture_stop/0
+%%% @see capture_get/1
+capture_start() ->
+ test_server:capture_start().
+
+%%%-----------------------------------------------------------------
+%%% @spec capture_stop() -> ok
+%%%
+%%% @doc Stop capturing text strings (a session started with
+%%% <code>capture_start/0</code>).
+%%%
+%%% @see capture_start/0
+%%% @see capture_get/1
+capture_stop() ->
+ test_server:capture_stop().
+
+%%%-----------------------------------------------------------------
+%%% @spec capture_get() -> ListOfStrings
+%%% ListOfStrings = [string()]
+%%%
+%%% @equiv capture_get([default])
+capture_get() ->
+ %% remove default log printouts (e.g. ct:log/2 printouts)
+ capture_get([default]).
+
+%%%-----------------------------------------------------------------
+%%% @spec capture_get(ExclCategories) -> ListOfStrings
+%%% ExclCategories = [atom()]
+%%% ListOfStrings = [string()]
+%%%
+%%% @doc Return and purge the list of text strings buffered
+%%% during the latest session of capturing printouts to stdout.
+%%% With <code>ExclCategories</code> it's possible to specify
+%%% log categories that should be ignored in <code>ListOfStrings</code>.
+%%% If <code>ExclCategories = []</code>, no filtering takes place.
+%%%
+%%% @see capture_start/0
+%%% @see capture_stop/0
+%%% @see log/3
+capture_get([ExclCat | ExclCategories]) ->
+ Strs = test_server:capture_get(),
+ CatsStr = [atom_to_list(ExclCat) |
+ [[$| | atom_to_list(EC)] || EC <- ExclCategories]],
+ {ok,MP} = re:compile("<div class=\"(" ++ lists:flatten(CatsStr) ++ ")\">.*"),
+ lists:flatmap(fun(Str) ->
+ case re:run(Str, MP) of
+ {match,_} -> [];
+ nomatch -> [Str]
+ end
+ end, Strs);
+
+capture_get([]) ->
+ test_server:capture_get().
%%%-----------------------------------------------------------------
%%% @spec fail(Reason) -> void()
@@ -528,18 +587,35 @@ pal(Category,Format,Args) ->
fail(Reason) ->
exit({test_case_failed,Reason}).
+
+%%%-----------------------------------------------------------------
+%%% @spec fail(Format, Args) -> void()
+%%% Format = string()
+%%% Args = list()
+%%%
+%%% @doc Terminate a test case with an error message specified
+%%% by a format string and a list of values (used as arguments to
+%%% <code>io_lib:format/2</code>).
+fail(Format, Args) ->
+ try io_lib:format(Format, Args) of
+ Str ->
+ exit({test_case_failed,lists:flatten(Str)})
+ catch
+ _:BadArgs ->
+ exit({BadArgs,{?MODULE,fail,[Format,Args]}})
+ end.
+
+
%%%-----------------------------------------------------------------
%%% @spec comment(Comment) -> void()
%%% Comment = term()
%%%
-%%% @doc Print the given <code>Comment</code> in the comment field of
+%%% @doc Print the given <code>Comment</code> in the comment field in
%%% the table on the test suite result page.
%%%
%%% <p>If called several times, only the last comment is printed.
-%%% <code>comment/1</code> is also overwritten by the return value
-%%% <code>{comment,Comment}</code> or by the function
-%%% <code>fail/1</code> (which prints <code>Reason</code> as a
-%%% comment).</p>
+%%% The test case return value <code>{comment,Comment}</code>
+%%% overwrites the string set by this function.</p>
comment(Comment) when is_list(Comment) ->
Formatted =
case (catch io_lib:format("~s",[Comment])) of
@@ -553,6 +629,29 @@ comment(Comment) ->
Formatted = io_lib:format("~p",[Comment]),
send_html_comment(lists:flatten(Formatted)).
+%%%-----------------------------------------------------------------
+%%% @spec comment(Format, Args) -> void()
+%%% Format = string()
+%%% Args = list()
+%%%
+%%% @doc Print the formatted string in the comment field in
+%%% the table on the test suite result page.
+%%%
+%%% <p>The <code>Format</code> and <code>Args</code> arguments are
+%%% used in call to <code>io_lib:format/2</code> in order to create
+%%% the comment string. The behaviour of <code>comment/2</code> is
+%%% otherwise the same as the <code>comment/1</code> function (see
+%%% above for details).</p>
+comment(Format, Args) when is_list(Format), is_list(Args) ->
+ Formatted =
+ case (catch io_lib:format(Format, Args)) of
+ {'EXIT',Reason} -> % bad args
+ exit({Reason,{?MODULE,comment,[Format,Args]}});
+ String ->
+ lists:flatten(String)
+ end,
+ send_html_comment(Formatted).
+
send_html_comment(Comment) ->
Html = "<font color=\"green\">" ++ Comment ++ "</font>",
ct_util:set_testdata({comment,Html}),
@@ -606,7 +705,7 @@ listenv(Telnet) ->
%%% Testcases = list()
%%% Reason = term()
%%%
-%%% @doc Returns all testcases in the specified suite.
+%%% @doc Returns all test cases in the specified suite.
testcases(TestDir, Suite) ->
case make_and_load(TestDir, Suite) of
E = {error,_} ->
@@ -664,7 +763,8 @@ userdata(TestDir, Suite) ->
get_userdata(Info, "suite/0")
end.
-get_userdata({'EXIT',{undef,_}}, Spec) ->
+get_userdata({'EXIT',{Undef,_}}, Spec) when Undef == undef;
+ Undef == function_clause ->
{error,list_to_atom(Spec ++ " is not defined")};
get_userdata({'EXIT',Reason}, Spec) ->
{error,{list_to_atom("error in " ++ Spec),Reason}};
@@ -680,16 +780,27 @@ get_userdata(_BadTerm, Spec) ->
{error,list_to_atom(Spec ++ " must return a list")}.
%%%-----------------------------------------------------------------
-%%% @spec userdata(TestDir, Suite, Case) -> TCUserData | {error,Reason}
+%%% @spec userdata(TestDir, Suite, GroupOrCase) -> TCUserData | {error,Reason}
%%% TestDir = string()
%%% Suite = atom()
-%%% Case = atom()
+%%% GroupOrCase = {group,GroupName} | atom()
+%%% GroupName = atom()
%%% TCUserData = [term()]
%%% Reason = term()
%%%
%%% @doc Returns any data specified with the tag <code>userdata</code>
-%%% in the list of tuples returned from <code>Suite:Case/0</code>.
-userdata(TestDir, Suite, Case) ->
+%%% in the list of tuples returned from <code>Suite:group(GroupName)</code>
+%%% or <code>Suite:Case()</code>.
+userdata(TestDir, Suite, {group,GroupName}) ->
+ case make_and_load(TestDir, Suite) of
+ E = {error,_} ->
+ E;
+ _ ->
+ Info = (catch apply(Suite, group, [GroupName])),
+ get_userdata(Info, "group("++atom_to_list(GroupName)++")")
+ end;
+
+userdata(TestDir, Suite, Case) when is_atom(Case) ->
case make_and_load(TestDir, Suite) of
E = {error,_} ->
E;
@@ -867,6 +978,18 @@ timetrap(Time) ->
test_server:timetrap(Time).
%%%-----------------------------------------------------------------
+%%% @spec get_timetrap_info() -> {Time,Scale}
+%%% Time = integer() | infinity
+%%% Scale = true | false
+%%%
+%%% @doc <p>Read info about the timetrap set for the current test case.
+%%% <c>Scale</c> indicates if Common Test will attempt to automatically
+%%% compensate timetraps for runtime delays introduced by e.g. tools like
+%%% cover.</p>
+get_timetrap_info() ->
+ test_server:get_timetrap_info().
+
+%%%-----------------------------------------------------------------
%%% @spec sleep(Time) -> ok
%%% Time = {hours,Hours} | {minutes,Mins} | {seconds,Secs} | Millisecs | infinity
%%% Hours = integer()
diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl
index fc51aea7f3..9277af5bc1 100644
--- a/lib/common_test/src/ct_config.erl
+++ b/lib/common_test/src/ct_config.erl
@@ -1,7 +1,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
diff --git a/lib/common_test/src/ct_config_plain.erl b/lib/common_test/src/ct_config_plain.erl
index 6698332379..237df5c8f3 100644
--- a/lib/common_test/src/ct_config_plain.erl
+++ b/lib/common_test/src/ct_config_plain.erl
@@ -1,7 +1,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
diff --git a/lib/common_test/src/ct_config_xml.erl b/lib/common_test/src/ct_config_xml.erl
index 794174e663..6e0a016161 100644
--- a/lib/common_test/src/ct_config_xml.erl
+++ b/lib/common_test/src/ct_config_xml.erl
@@ -1,7 +1,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl
index 482c5242ce..c24a7c238b 100644
--- a/lib/common_test/src/ct_framework.erl
+++ b/lib/common_test/src/ct_framework.erl
@@ -27,7 +27,7 @@
-export([init_tc/3, end_tc/3, end_tc/4, get_suite/2, get_all_cases/1]).
-export([report/2, warn/1, error_notification/4]).
--export([get_logopts/0, format_comment/1, overview_html_header/1]).
+-export([get_logopts/0, format_comment/1, get_html_wrapper/3]).
-export([error_in_suite/1, ct_init_per_group/2, ct_end_per_group/2]).
@@ -36,6 +36,10 @@
-include("ct_event.hrl").
-include("ct_util.hrl").
+-define(val(Key, List), proplists:get_value(Key, List)).
+-define(val(Key, List, Def), proplists:get_value(Key, List, Def)).
+-define(rev(L), lists:reverse(L)).
+
%%%-----------------------------------------------------------------
%%% @spec init_tc(Mod,Func,Args) -> {ok,NewArgs} | {error,Reason} |
%%% {skip,Reason} | {auto_skip,Reason}
@@ -48,6 +52,8 @@
%%% @doc Test server framework callback, called by the test_server
%%% when a new test case is started.
init_tc(Mod,Func,Config) ->
+ %% in case Mod == ct_framework, lookup the suite name
+ Suite = get_suite_name(Mod, Config),
%% check if previous testcase was interpreted and has left
%% a "dead" trace window behind - if so, kill it
case ct_util:get_testdata(interpret) of
@@ -57,34 +63,36 @@ init_tc(Mod,Func,Config) ->
_ ->
ok
end,
-
%% check if we need to add defaults explicitly because
%% there's no init_per_suite exported from Mod
{InitFailed,DoInit} =
case ct_util:get_testdata(curr_tc) of
- {Mod,{suite0_failed,_}=Failure} ->
+ {Suite,{suite0_failed,_}=Failure} ->
{Failure,false};
- {Mod,_} ->
+ {?MODULE,_} -> % should not really happen
{false,false};
- _ when Func == init_per_suite ->
+ {Suite,_} -> % Func is not 1st case in suite
{false,false};
- _ ->
+ _ when Func == init_per_suite -> % defaults will be added anyway
+ {false,false};
+ _ -> % first case in suite
{false,true}
end,
case InitFailed of
false ->
- ct_util:set_testdata({curr_tc,{Mod,Func}}),
- case ct_util:read_suite_data({seq,Mod,Func}) of
+ ct_util:set_testdata({curr_tc,{Suite,Func}}),
+ case ct_util:read_suite_data({seq,Suite,Func}) of
undefined ->
init_tc1(Mod,Func,Config,DoInit);
Seq when is_atom(Seq) ->
- case ct_util:read_suite_data({seq,Mod,Seq}) of
+ case ct_util:read_suite_data({seq,Suite,Seq}) of
[Func|TCs] -> % this is the 1st case in Seq
%% make sure no cases in this seq are marked as failed
%% from an earlier execution in the same suite
- lists:foreach(fun(TC) ->
- ct_util:save_suite_data({seq,Mod,TC},Seq)
- end, TCs);
+ lists:foreach(
+ fun(TC) ->
+ ct_util:save_suite_data({seq,Suite,TC},Seq)
+ end, TCs);
_ ->
ok
end,
@@ -98,6 +106,17 @@ init_tc(Mod,Func,Config) ->
{skip,InitFailed}
end.
+init_tc1(?MODULE,error_in_suite,[Config0],_) when is_list(Config0) ->
+ ct_logs:init_tc(false),
+ ct_event:notify(#event{name=tc_start,
+ node=node(),
+ data={?MODULE,error_in_suite}}),
+ case ?val(error, Config0) of
+ undefined ->
+ {skip,"unknown_error_in_suite"};
+ Reason ->
+ {skip,Reason}
+ end;
init_tc1(Mod,Func,[Config0],DoInit) when is_list(Config0) ->
Config1 =
case ct_util:read_suite_data(last_saved_config) of
@@ -122,35 +141,40 @@ init_tc1(Mod,Func,[Config0],DoInit) when is_list(Config0) ->
%% release all name -> key bindings (once per suite)
ct_config:release_allocated()
end,
- TestCaseInfo =
- case catch apply(Mod,Func,[]) of
- Result when is_list(Result) -> Result;
- _ -> []
- end,
+
+ GroupPath = ?val(tc_group_path, Config, []),
+ AllGroups = [?val(tc_group_properties, Config, []) | GroupPath],
+
%% clear all config data default values set by previous
%% testcase info function (these should only survive the
%% testcase, not the whole suite)
- ct_config:delete_default_config(testcase),
- case add_defaults(Mod,Func,TestCaseInfo,DoInit) of
+ FuncSpec = group_or_func(Func,Config0),
+ if is_tuple(FuncSpec) -> % group
+ ok;
+ true ->
+ ct_config:delete_default_config(testcase)
+ end,
+ %% in case Mod == ct_framework, lookup the suite name
+ Suite = get_suite_name(Mod, Config),
+ case add_defaults(Mod,Func,AllGroups,DoInit) of
Error = {suite0_failed,_} ->
ct_logs:init_tc(false),
- FuncSpec = group_or_func(Func,Config0),
ct_event:notify(#event{name=tc_start,
node=node(),
data={Mod,FuncSpec}}),
- ct_util:set_testdata({curr_tc,{Mod,Error}}),
+ ct_util:set_testdata({curr_tc,{Suite,Error}}),
{error,Error};
{SuiteInfo,MergeResult} ->
case MergeResult of
{error,Reason} when DoInit == false ->
ct_logs:init_tc(false),
- FuncSpec = group_or_func(Func,Config0),
ct_event:notify(#event{name=tc_start,
node=node(),
data={Mod,FuncSpec}}),
{skip,Reason};
_ ->
- init_tc2(Mod,Func,SuiteInfo,MergeResult,Config,DoInit)
+ init_tc2(Mod,Func,SuiteInfo,MergeResult,
+ Config,DoInit)
end
end;
init_tc1(_Mod,_Func,Args,_DoInit) ->
@@ -203,8 +227,9 @@ init_tc2(Mod,Func,SuiteInfo,MergeResult,Config,DoInit) ->
ct_event:notify(#event{name=tc_start,
node=node(),
data={Mod,FuncSpec}}),
-
- case catch configure(MergedInfo1,MergedInfo1,SuiteInfo,{Func,DoInit},Config) of
+
+ case catch configure(MergedInfo1,MergedInfo1,SuiteInfo,
+ {FuncSpec,DoInit},Config) of
{suite0_failed,Reason} ->
ct_util:set_testdata({curr_tc,{Mod,{suite0_failed,{require,Reason}}}}),
{skip,{require_failed_in_suite0,Reason}};
@@ -212,7 +237,7 @@ init_tc2(Mod,Func,SuiteInfo,MergeResult,Config,DoInit) ->
{auto_skip,{require_failed,Reason}};
{'EXIT',Reason} ->
{auto_skip,Reason};
- {ok, FinalConfig} ->
+ {ok,FinalConfig} ->
case MergeResult of
{error,Reason} ->
%% suite0 configure finished now, report that
@@ -241,19 +266,20 @@ ct_suite_init(Mod, Func, [Config]) when is_list(Config) ->
Else
end.
-add_defaults(Mod,Func,FuncInfo,DoInit) ->
- case (catch Mod:suite()) of
+add_defaults(Mod,Func, GroupPath, DoInit) ->
+ Suite = get_suite_name(Mod, GroupPath),
+ case (catch Suite:suite()) of
{'EXIT',{undef,_}} ->
- SuiteInfo = merge_with_suite_defaults(Mod,[]),
+ SuiteInfo = merge_with_suite_defaults(Suite,[]),
SuiteInfoNoCTH = [I || I <- SuiteInfo, element(1,I) =/= ct_hooks],
- case add_defaults1(Mod,Func,FuncInfo,SuiteInfoNoCTH,DoInit) of
+ case add_defaults1(Mod,Func, GroupPath, SuiteInfoNoCTH, DoInit) of
Error = {error,_} -> {SuiteInfo,Error};
MergedInfo -> {SuiteInfo,MergedInfo}
end;
{'EXIT',Reason} ->
ErrStr = io_lib:format("~n*** ERROR *** "
"~w:suite/0 failed: ~p~n",
- [Mod,Reason]),
+ [Suite,Reason]),
io:format(ErrStr, []),
io:format(user, ErrStr, []),
{suite0_failed,{exited,Reason}};
@@ -262,18 +288,18 @@ add_defaults(Mod,Func,FuncInfo,DoInit) ->
(_) -> false
end, SuiteInfo) of
true ->
- SuiteInfo1 = merge_with_suite_defaults(Mod,SuiteInfo),
+ SuiteInfo1 = merge_with_suite_defaults(Suite, SuiteInfo),
SuiteInfoNoCTH = [I || I <- SuiteInfo1,
element(1,I) =/= ct_hooks],
- case add_defaults1(Mod,Func,FuncInfo,
- SuiteInfoNoCTH,DoInit) of
+ case add_defaults1(Mod,Func, GroupPath,
+ SuiteInfoNoCTH, DoInit) of
Error = {error,_} -> {SuiteInfo1,Error};
MergedInfo -> {SuiteInfo1,MergedInfo}
end;
false ->
ErrStr = io_lib:format("~n*** ERROR *** "
"Invalid return value from "
- "~w:suite/0: ~p~n", [Mod,SuiteInfo]),
+ "~w:suite/0: ~p~n", [Suite,SuiteInfo]),
io:format(ErrStr, []),
io:format(user, ErrStr, []),
{suite0_failed,bad_return_value}
@@ -281,57 +307,178 @@ add_defaults(Mod,Func,FuncInfo,DoInit) ->
SuiteInfo ->
ErrStr = io_lib:format("~n*** ERROR *** "
"Invalid return value from "
- "~w:suite/0: ~p~n", [Mod,SuiteInfo]),
+ "~w:suite/0: ~p~n", [Suite,SuiteInfo]),
io:format(ErrStr, []),
io:format(user, ErrStr, []),
{suite0_failed,bad_return_value}
end.
-add_defaults1(_Mod,init_per_suite,[],SuiteInfo,_DoInit) ->
- SuiteInfo;
-
-add_defaults1(Mod,Func,FuncInfo,SuiteInfo,DoInit) ->
- %% mustn't re-require suite variables in test case info function,
- %% can result in weird behaviour (suite values get overwritten)
+add_defaults1(Mod,Func, GroupPath, SuiteInfo, DoInit) ->
+ Suite = get_suite_name(Mod, GroupPath),
+ %% GroupPathInfo (for subgroup on level X) =
+ %% [LevelXGroupInfo, LevelX-1GroupInfo, ..., TopLevelGroupInfo]
+ GroupPathInfo =
+ lists:map(fun(GroupProps) ->
+ Name = ?val(name, GroupProps),
+ case catch Suite:group(Name) of
+ GrInfo when is_list(GrInfo) -> GrInfo;
+ _ -> []
+ end
+ end, GroupPath),
+ Args = if Func == init_per_group; Func == ct_init_per_group;
+ Func == end_per_group; Func == ct_end_per_group ->
+ [?val(name, hd(GroupPath))];
+ true ->
+ []
+ end,
+ TestCaseInfo =
+ case catch apply(Mod,Func,Args) of
+ TCInfo when is_list(TCInfo) -> TCInfo;
+ _ -> []
+ end,
+ %% let test case info (also for all config funcs) override group info,
+ %% and lower level group info override higher level info
+ TCAndGroupInfo = [TestCaseInfo | remove_info_in_prev(TestCaseInfo,
+ GroupPathInfo)],
+ %% find and save require terms found in suite info
SuiteReqs =
[SDDef || SDDef <- SuiteInfo,
((require == element(1,SDDef)) or
(default_config == element(1,SDDef)))],
- FuncReqs =
- [FIDef || FIDef <- FuncInfo,
- require == element(1,FIDef)],
- case [element(2,Clash) || Clash <- SuiteReqs,
- require == element(1, Clash),
- true == lists:keymember(element(2,Clash),2,
- FuncReqs)] of
+ case check_for_clashes(TestCaseInfo, GroupPathInfo, SuiteReqs) of
[] ->
- add_defaults2(Mod,Func,FuncInfo,SuiteInfo,SuiteReqs,DoInit);
+ add_defaults2(Mod,Func, TCAndGroupInfo,SuiteInfo,SuiteReqs, DoInit);
Clashes ->
{error,{config_name_already_in_use,Clashes}}
end.
-add_defaults2(Mod,init_per_suite,IPSInfo,SuiteInfo,SuiteReqs,false) ->
- %% not common practise to use a test case info function for
- %% init_per_suite (usually handled by suite/0), but let's support
- %% it just in case...
- add_defaults2(Mod,init_per_suite,IPSInfo,SuiteInfo,SuiteReqs,true);
-
-add_defaults2(_Mod,_Func,FuncInfo,SuiteInfo,_,false) ->
- %% include require elements from test case info, but not from suite/0
- %% (since we've already required those vars)
- FuncInfo ++
- [SFDef || SFDef <- SuiteInfo,
- require /= element(1,SFDef),
- false == lists:keymember(element(1,SFDef),1,FuncInfo)];
-
-add_defaults2(_Mod,_Func,FuncInfo,SuiteInfo,SuiteReqs,true) ->
- %% We must include require elements from suite/0 here since
- %% there's no init_per_suite call before this first test case.
- %% Let other test case info elements override those from suite/0.
- FuncInfo ++ SuiteReqs ++
- [SDDef || SDDef <- SuiteInfo,
- require /= element(1,SDDef),
- false == lists:keymember(element(1,SDDef),1,FuncInfo)].
+get_suite_name(?MODULE, [Cfg|_]) when is_list(Cfg), Cfg /= [] ->
+ get_suite_name(?MODULE, Cfg);
+
+get_suite_name(?MODULE, Cfg) when is_list(Cfg), Cfg /= [] ->
+ case ?val(tc_group_properties, Cfg) of
+ undefined ->
+ case ?val(suite, Cfg) of
+ undefined -> ?MODULE;
+ Suite -> Suite
+ end;
+ GrProps ->
+ case ?val(suite, GrProps) of
+ undefined -> ?MODULE;
+ Suite -> Suite
+ end
+ end;
+get_suite_name(Mod, _) ->
+ Mod.
+
+%% Check that alias names are not already in use
+check_for_clashes(TCInfo, GrPathInfo, SuiteInfo) ->
+ {CurrGrInfo,SearchIn} = case GrPathInfo of
+ [] -> {[],[SuiteInfo]};
+ [Curr|Path] -> {Curr,[SuiteInfo|Path]}
+ end,
+ ReqNames = fun(Info) -> [element(2,R) || R <- Info,
+ size(R) == 3,
+ require == element(1,R)]
+ end,
+ ExistingNames = lists:flatten([ReqNames(L) || L <- SearchIn]),
+ CurrGrReqNs = ReqNames(CurrGrInfo),
+ GrClashes = [Name || Name <- CurrGrReqNs,
+ true == lists:member(Name, ExistingNames)],
+ AllReqNs = CurrGrReqNs ++ ExistingNames,
+ TCClashes = [Name || Name <- ReqNames(TCInfo),
+ true == lists:member(Name, AllReqNs)],
+ TCClashes ++ GrClashes.
+
+%% Delete the info terms in Terms from all following info lists
+remove_info_in_prev(Terms, [[] | Rest]) ->
+ [[] | remove_info_in_prev(Terms, Rest)];
+remove_info_in_prev(Terms, [Info | Rest]) ->
+ UniqueInInfo = [U || U <- Info,
+ ((timetrap == element(1,U)) and
+ (not lists:keymember(timetrap,1,Terms))) or
+ ((require == element(1,U)) and
+ (not lists:member(U,Terms))) or
+ ((default_config == element(1,U)) and
+ (not keysmember([default_config,1,
+ element(2,U),2], Terms)))],
+ OtherTermsInInfo = [T || T <- Info,
+ timetrap /= element(1,T),
+ require /= element(1,T),
+ default_config /= element(1,T),
+ false == lists:keymember(element(1,T),1,
+ Terms)],
+ KeptInfo = UniqueInInfo ++ OtherTermsInInfo,
+ [KeptInfo | remove_info_in_prev(Terms ++ KeptInfo, Rest)];
+remove_info_in_prev(_, []) ->
+ [].
+
+keysmember([Key,Pos|Next], List) ->
+ case [Elem || Elem <- List, Key == element(Pos,Elem)] of
+ [] -> false;
+ Found -> keysmember(Next, Found)
+ end;
+keysmember([], _) -> true.
+
+
+add_defaults2(Mod,init_per_suite, IPSInfo, SuiteInfo,SuiteReqs, false) ->
+ add_defaults2(Mod,init_per_suite, IPSInfo, SuiteInfo,SuiteReqs, true);
+
+add_defaults2(_Mod,IPG, IPGAndGroupInfo, SuiteInfo,SuiteReqs, DoInit) when
+ IPG == init_per_group ; IPG == ct_init_per_group ->
+ %% If DoInit == true, we have to process the suite() list, otherwise
+ %% it has already been handled (see clause for init_per_suite)
+ case DoInit of
+ true ->
+ %% note: we know for sure this is a top level group
+ Info = lists:flatten([IPGAndGroupInfo, SuiteReqs]),
+ Info ++ remove_info_in_prev(Info, [SuiteInfo]);
+ false ->
+ SuiteInfo1 =
+ remove_info_in_prev(lists:flatten([IPGAndGroupInfo,
+ SuiteReqs]), [SuiteInfo]),
+ %% don't require terms in prev groups (already processed)
+ case IPGAndGroupInfo of
+ [IPGInfo] ->
+ lists:flatten([IPGInfo,SuiteInfo1]);
+ [IPGInfo | [CurrGroupInfo | PrevGroupInfo]] ->
+ PrevGroupInfo1 = delete_require_terms(PrevGroupInfo),
+ lists:flatten([IPGInfo,CurrGroupInfo,PrevGroupInfo1,
+ SuiteInfo1])
+ end
+ end;
+
+add_defaults2(_Mod,_Func, TCAndGroupInfo, SuiteInfo,SuiteReqs, false) ->
+ %% Include require elements from test case info and current group,
+ %% but not from previous groups or suite/0 (since we've already required
+ %% those vars). Let test case info elements override group and suite
+ %% info elements.
+ SuiteInfo1 = remove_info_in_prev(lists:flatten([TCAndGroupInfo,
+ SuiteReqs]), [SuiteInfo]),
+ %% don't require terms in prev groups (already processed)
+ case TCAndGroupInfo of
+ [TCInfo] ->
+ lists:flatten([TCInfo,SuiteInfo1]);
+ [TCInfo | [CurrGroupInfo | PrevGroupInfo]] ->
+ PrevGroupInfo1 = delete_require_terms(PrevGroupInfo),
+ lists:flatten([TCInfo,CurrGroupInfo,PrevGroupInfo1,
+ SuiteInfo1])
+ end;
+
+add_defaults2(_Mod,_Func, TCInfo, SuiteInfo,SuiteReqs, true) ->
+ %% Here we have to process the suite info list also (no call to
+ %% init_per_suite before this first test case). This TC can't belong
+ %% to a group, or the clause for (ct_)init_per_group would've caught this.
+ Info = lists:flatten([TCInfo, SuiteReqs]),
+ lists:flatten([Info,remove_info_in_prev(Info, [SuiteInfo])]).
+
+delete_require_terms([Info | Prev]) ->
+ Info1 = [T || T <- Info,
+ require /= element(1,T),
+ default_config /= element(1,T)],
+ [Info1 | delete_require_terms(Prev)];
+delete_require_terms([]) ->
+ [].
merge_with_suite_defaults(Mod,SuiteInfo) ->
case lists:keysearch(suite_defaults,1,Mod:module_info(attributes)) of
@@ -355,16 +502,17 @@ timetrap_first([Trap = {timetrap,_} | Rest],Info,Found) ->
timetrap_first([Other | Rest],Info,Found) ->
timetrap_first(Rest,[Other | Info],Found);
timetrap_first([],Info,[]) ->
- [{timetrap,{minutes,30}} | lists:reverse(Info)];
+ [{timetrap,{minutes,30}} | ?rev(Info)];
timetrap_first([],Info,Found) ->
- lists:reverse(Found) ++ lists:reverse(Info).
+ ?rev(Found) ++ ?rev(Info).
configure([{require,Required}|Rest],Info,SuiteInfo,Scope,Config) ->
case ct:require(Required) of
ok ->
configure(Rest,Info,SuiteInfo,Scope,Config);
Error = {error,Reason} ->
- case required_default('_UNDEF',Required,Info,SuiteInfo,Scope) of
+ case required_default('_UNDEF',Required,Info,
+ SuiteInfo,Scope) of
ok ->
configure(Rest,Info,SuiteInfo,Scope,Config);
_ ->
@@ -406,18 +554,24 @@ configure([],_,_,_,Config) ->
{ok,[Config]}.
%% the require element in Info may come from suite/0 and
-%% should be scoped 'suite', or come from the testcase info
-%% function and should then be scoped 'testcase'
-required_default(Name,Key,Info,SuiteInfo,{Func,true}) ->
+%% should be scoped 'suite', or come from the group info
+%% function and be scoped 'group', or come from the testcase
+%% info function and then be scoped 'testcase'
+
+required_default(Name,Key,Info,SuiteInfo,{FuncSpec,true}) ->
case try_set_default(Name,Key,SuiteInfo,suite) of
ok ->
ok;
_ ->
- required_default(Name,Key,Info,[],{Func,false})
+ required_default(Name,Key,Info,[],{FuncSpec,false})
end;
required_default(Name,Key,Info,_,{init_per_suite,_}) ->
try_set_default(Name,Key,Info,suite);
-required_default(Name,Key,Info,_,_) ->
+required_default(Name,Key,Info,_,{{init_per_group,GrName,_},_}) ->
+ try_set_default(Name,Key,Info,{group,GrName});
+required_default(Name,Key,Info,_,{{ct_init_per_group,GrName,_},_}) ->
+ try_set_default(Name,Key,Info,{group,GrName});
+required_default(Name,Key,Info,_,_FuncSpec) ->
try_set_default(Name,Key,Info,testcase).
try_set_default(Name,Key,Info,Where) ->
@@ -484,7 +638,11 @@ end_tc(Mod,Func,TCPid,Result,Args,Return) ->
ct_util:delete_suite_data(last_saved_config),
FuncSpec =
case group_or_func(Func,Args) of
- {_,GroupName,_Props} = Group ->
+ {_,GroupName,_Props} = Group ->
+ if Func == end_per_group; Func == ct_end_per_group ->
+ ct_config:delete_default_config({group,GroupName});
+ true -> ok
+ end,
case lists:keysearch(save_config,1,Args) of
{value,{save_config,SaveConfig}} ->
ct_util:save_suite_data(
@@ -703,12 +861,14 @@ mark_as_failed1(_,_,_,[]) ->
ok.
group_or_func(Func, Config) when Func == init_per_group;
- Func == end_per_group ->
- case proplists:get_value(tc_group_properties,Config) of
+ Func == end_per_group;
+ Func == ct_init_per_group;
+ Func == ct_end_per_group ->
+ case ?val(tc_group_properties, Config) of
undefined ->
{Func,unknown,[]};
GrProps ->
- GrName = proplists:get_value(name,GrProps),
+ GrName = ?val(name,GrProps),
{Func,GrName,proplists:delete(name,GrProps)}
end;
group_or_func(Func, _Config) ->
@@ -732,7 +892,7 @@ get_suite(Mod, all) ->
%% (and only) test case so we can report Error properly
[{?MODULE,error_in_suite,[[Error]]}];
ConfTests ->
- get_all(Mod, ConfTests)
+ get_all(Mod, ConfTests)
end;
_ ->
E = "Bad return value from "++atom_to_list(Mod)++":groups/0",
@@ -746,7 +906,7 @@ get_suite(Mod, all) ->
%% group
get_suite(Mod, Group={conf,Props,_Init,TCs,_End}) ->
- Name = proplists:get_value(name, Props),
+ Name = ?val(name, Props),
case catch apply(Mod, groups, []) of
{'EXIT',_} ->
[Group];
@@ -764,14 +924,25 @@ get_suite(Mod, Group={conf,Props,_Init,TCs,_End}) ->
%% a *subgroup* specified *only* as skipped (and not
%% as an explicit test) should not be returned, or
%% init/end functions for top groups will be executed
- case catch proplists:get_value(name, element(2, hd(ConfTests))) of
+ case catch ?val(name, element(2, hd(ConfTests))) of
Name -> % top group
delete_subs(ConfTests, ConfTests);
_ ->
[]
end;
false ->
- delete_subs(ConfTests, ConfTests)
+ ConfTests1 = delete_subs(ConfTests, ConfTests),
+ case ?val(override, Props) of
+ undefined ->
+ ConfTests1;
+ [] ->
+ ConfTests1;
+ ORSpec ->
+ ORSpec1 = if is_tuple(ORSpec) -> [ORSpec];
+ true -> ORSpec end,
+ search_and_override(ConfTests1,
+ ORSpec1, Mod)
+ end
end
end;
_ ->
@@ -793,13 +964,12 @@ get_all_cases(Suite) ->
{error,Error};
Tests ->
Cases = get_all_cases1(Suite, Tests),
- lists:reverse(
- lists:foldl(fun(TC, TCs) ->
- case lists:member(TC, TCs) of
+ ?rev(lists:foldl(fun(TC, TCs) ->
+ case lists:member(TC, TCs) of
true -> TCs;
- false -> [TC | TCs]
- end
- end, [], Cases))
+ false -> [TC | TCs]
+ end
+ end, [], Cases))
end.
get_all_cases1(Suite, [{conf,_Props,_Init,GrTests,_End} | Tests]) ->
@@ -918,14 +1088,14 @@ delete_subs([], All) ->
All.
delete_conf({conf,Props,_,_,_}, Confs) ->
- Name = proplists:get_value(name, Props),
+ Name = ?val(name, Props),
[Conf || Conf = {conf,Props0,_,_,_} <- Confs,
- Name =/= proplists:get_value(name, Props0)].
+ Name =/= ?val(name, Props0)].
is_sub({conf,Props,_,_,_}=Conf, [{conf,_,_,Tests,_} | Confs]) ->
- Name = proplists:get_value(name, Props),
+ Name = ?val(name, Props),
case lists:any(fun({conf,Props0,_,_,_}) ->
- case proplists:get_value(name, Props0) of
+ case ?val(name, Props0) of
N when N == Name ->
true;
_ ->
@@ -1078,29 +1248,116 @@ expand_groups([H | T], ConfTests, Mod) ->
expand_groups([], _ConfTests, _Mod) ->
[];
expand_groups({group,Name}, ConfTests, Mod) ->
- FindConf =
- fun({conf,Props,_,_,_}) ->
- case proplists:get_value(name, Props) of
- Name -> true;
- _ -> false
+ expand_groups({group,Name,default,[]}, ConfTests, Mod);
+expand_groups({group,Name,default}, ConfTests, Mod) ->
+ expand_groups({group,Name,default,[]}, ConfTests, Mod);
+expand_groups({group,Name,ORProps}, ConfTests, Mod) when is_list(ORProps) ->
+ expand_groups({group,Name,ORProps,[]}, ConfTests, Mod);
+expand_groups({group,Name,ORProps,SubORSpec}, ConfTests, Mod) ->
+ FindConf =
+ fun(Conf = {conf,Props,Init,Ts,End}) ->
+ case ?val(name, Props) of
+ Name when ORProps == default ->
+ [Conf];
+ Name ->
+ [{conf,[{name,Name}|ORProps],Init,Ts,End}];
+ _ ->
+ []
end
end,
- case lists:filter(FindConf, ConfTests) of
- [ConfTest|_] ->
- expand_groups(ConfTest, ConfTests, Mod);
+ case lists:flatmap(FindConf, ConfTests) of
[] ->
- E = "Invalid reference to group "++
- atom_to_list(Name)++" in "++
- atom_to_list(Mod)++":all/0",
- throw({error,list_to_atom(E)})
+ throw({error,invalid_ref_msg(Name, Mod)});
+ Matching when SubORSpec == [] ->
+ Matching;
+ Matching ->
+ override_props(Matching, SubORSpec, Name,Mod)
end;
expand_groups(SeqOrTC, _ConfTests, _Mod) ->
SeqOrTC.
+%% search deep for the matching conf test and modify it and any
+%% sub tests according to the override specification
+search_and_override([Conf = {conf,Props,Init,Tests,End}], ORSpec, Mod) ->
+ Name = ?val(name, Props),
+ case lists:keysearch(Name, 1, ORSpec) of
+ {value,{Name,default}} ->
+ [Conf];
+ {value,{Name,ORProps}} ->
+ [{conf,[{name,Name}|ORProps],Init,Tests,End}];
+ {value,{Name,default,[]}} ->
+ [Conf];
+ {value,{Name,default,SubORSpec}} ->
+ override_props([Conf], SubORSpec, Name,Mod);
+ {value,{Name,ORProps,SubORSpec}} ->
+ override_props([{conf,[{name,Name}|ORProps],
+ Init,Tests,End}], SubORSpec, Name,Mod);
+ _ ->
+ [{conf,Props,Init,search_and_override(Tests,ORSpec,Mod),End}]
+ end.
+
+%% Modify the Tests element according to the override specification
+override_props([{conf,Props,Init,Tests,End} | Confs], SubORSpec, Name,Mod) ->
+ {Subs,SubORSpec1} = override_sub_props(Tests, [], SubORSpec, Mod),
+ [{conf,Props,Init,Subs,End} | override_props(Confs, SubORSpec1, Name,Mod)];
+override_props([], [], _,_) ->
+ [];
+override_props([], SubORSpec, Name,Mod) ->
+ Es = [invalid_ref_msg(Name, element(1,Spec), Mod) || Spec <- SubORSpec],
+ throw({error,Es}).
+
+override_sub_props([], New, ORSpec, _) ->
+ {?rev(New),ORSpec};
+override_sub_props([T = {conf,Props,Init,Tests,End} | Ts],
+ New, ORSpec, Mod) ->
+ Name = ?val(name, Props),
+ case lists:keysearch(Name, 1, ORSpec) of
+ {value,Spec} -> % group found in spec
+ Props1 =
+ case element(2, Spec) of
+ default -> Props;
+ ORProps -> [{name,Name} | ORProps]
+ end,
+ case catch element(3, Spec) of
+ Undef when Undef == [] ; 'EXIT' == element(1, Undef) ->
+ override_sub_props(Ts, [{conf,Props1,Init,Tests,End} | New],
+ lists:keydelete(Name, 1, ORSpec), Mod);
+ SubORSpec when is_list(SubORSpec) ->
+ case override_sub_props(Tests, [], SubORSpec, Mod) of
+ {Subs,[]} ->
+ override_sub_props(Ts, [{conf,Props1,Init,
+ Subs,End} | New],
+ lists:keydelete(Name, 1, ORSpec),
+ Mod);
+ {_,NonEmptySpec} ->
+ Es = [invalid_ref_msg(Name, element(1, GrRef),
+ Mod) || GrRef <- NonEmptySpec],
+ throw({error,Es})
+ end;
+ BadGrSpec ->
+ throw({error,{invalid_form,BadGrSpec}})
+ end;
+ _ -> % not a group in spec
+ override_sub_props(Ts, [T | New], ORSpec, Mod)
+ end;
+override_sub_props([TC | Ts], New, ORSpec, Mod) ->
+ override_sub_props(Ts, [TC | New], ORSpec, Mod).
+
+invalid_ref_msg(Name, Mod) ->
+ E = "Invalid reference to group "++
+ atom_to_list(Name)++" in "++
+ atom_to_list(Mod)++":all/0",
+ list_to_atom(E).
+
+invalid_ref_msg(Name0, Name1, Mod) ->
+ E = "Invalid reference to group "++
+ atom_to_list(Name1)++" from "++atom_to_list(Name0)++
+ " in "++atom_to_list(Mod)++":all/0",
+ list_to_atom(E).
%%!============================================================
%%! The support for sequences by means of using sequences/0
-%%! will be removed in OTP R14. The code below is only kept
+%%! will be removed in OTP R15. The code below is only kept
%%! for backwards compatibility. From OTP R13 groups with
%%! sequence property should be used instead!
%%!============================================================
@@ -1234,8 +1491,8 @@ report(What,Data) ->
loginfo ->
%% logfiles and direcories have been created for a test and the
%% top level test index page needs to be refreshed
- TestName = filename:basename(proplists:get_value(topdir, Data), ".logs"),
- RunDir = proplists:get_value(rundir, Data),
+ TestName = filename:basename(?val(topdir, Data), ".logs"),
+ RunDir = ?val(rundir, Data),
ct_logs:make_all_suites_index({TestName,RunDir}),
ok;
tests_start ->
@@ -1274,6 +1531,10 @@ report(What,Data) ->
tests_done ->
ok;
tc_start ->
+ %% Data = {{Suite,Func},LogFileName}
+ ct_event:sync_notify(#event{name=tc_logfile,
+ node=node(),
+ data=Data}),
ok;
tc_done ->
{_Suite,Case,Result} = Data,
@@ -1337,11 +1598,24 @@ report(What,Data) ->
node=node(),
data=Data}),
ct_hooks:on_tc_skip(What, Data),
- if Case /= end_per_suite, Case /= end_per_group ->
+ if Case /= end_per_suite,
+ Case /= end_per_group,
+ Case /= ct_end_per_group ->
add_to_stats(auto_skipped);
true ->
ok
end;
+ framework_error ->
+ case Data of
+ {{M,F},E} ->
+ ct_event:sync_notify(#event{name=tc_done,
+ node=node(),
+ data={M,F,{framework_error,E}}});
+ _ ->
+ ct_event:sync_notify(#event{name=tc_done,
+ node=node(),
+ data=Data})
+ end;
_ ->
ok
end,
@@ -1411,30 +1685,6 @@ format_comment(Comment) ->
"<font color=\"green\">" ++ Comment ++ "</font>".
%%%-----------------------------------------------------------------
-%%% @spec overview_html_header(TestName) -> Header
-overview_html_header(TestName) ->
- TestName1 = lists:flatten(io_lib:format("~p", [TestName])),
- Label = case application:get_env(common_test, test_label) of
- {ok,Lbl} when Lbl =/= undefined ->
- "<H1><FONT color=\"green\">" ++ Lbl ++ "</FONT></H1>\n";
- _ ->
- ""
- end,
- Bgr = case ct_logs:basic_html() of
- true ->
- "";
- false ->
- CTPath = code:lib_dir(common_test),
- TileFile = filename:join(filename:join(CTPath,"priv"),"tile1.jpg"),
- " background=\"" ++ TileFile ++ "\""
- end,
-
- ["<html>\n",
- "<head><title>Test ", TestName1, " results</title>\n",
- "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n",
- "</head>\n",
- "<body", Bgr, " bgcolor=\"white\" text=\"black\" ",
- "link=\"blue\" vlink=\"purple\" alink=\"red\">\n",
- Label,
- "<H2>Results from test ", TestName1, "</H2>\n"].
-
+%%% @spec get_html_wrapper(TestName, PrintLabel, Cwd) -> Header
+get_html_wrapper(TestName, PrintLabel, Cwd) ->
+ ct_logs:get_ts_html_wrapper(TestName, PrintLabel, Cwd).
diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl
index f243b87f54..c42adbbdd9 100644
--- a/lib/common_test/src/ct_hooks.erl
+++ b/lib/common_test/src/ct_hooks.erl
@@ -34,6 +34,12 @@
%% If you change this, remember to update ct_util:look -> stop clause as well.
-define(config_name, ct_hooks).
+%% All of the hooks which are to be started by default. Remove by issuing
+%% -enable_builtin_hooks false to when starting common test.
+-define(BUILTIN_HOOKS,[#ct_hook_config{ module = cth_log_redirect,
+ opts = [],
+ prio = ctfirst }]).
+
-record(ct_hook_config, {id, module, prio, scope, opts = [], state = []}).
%% -------------------------------------------------------------------------
@@ -44,7 +50,8 @@
-spec init(State :: term()) -> ok |
{error, Reason :: term()}.
init(Opts) ->
- call(get_new_hooks(Opts, undefined), ok, init, []).
+ call(get_new_hooks(Opts, undefined) ++ get_builtin_hooks(Opts),
+ ok, init, []).
%% @doc Called after all suites are done.
@@ -171,8 +178,9 @@ call_generic(#ct_hook_config{ module = Mod, state = State} = Hook,
call(Fun, Config, Meta) ->
maybe_lock(),
Hooks = get_hooks(),
- Res = call(get_new_hooks(Config, Fun) ++
- [{HookId,Fun} || #ct_hook_config{id = HookId} <- Hooks],
+ Calls = get_new_hooks(Config, Fun) ++
+ [{HookId,Fun} || #ct_hook_config{id = HookId} <- Hooks],
+ Res = call(resort(Calls,Hooks,Meta),
remove(?config_name,Config), Meta, Hooks),
maybe_unlock(),
Res.
@@ -198,7 +206,7 @@ call([{Hook, call_id, NextFun} | Rest], Config, Meta, Hooks) ->
{Hooks ++ [NewHook],
[{NewId, call_init}, {NewId,NextFun} | Rest]}
end,
- call(resort(NewRest,NewHooks), Config, Meta, NewHooks)
+ call(resort(NewRest,NewHooks,Meta), Config, Meta, NewHooks)
catch Error:Reason ->
Trace = erlang:get_stacktrace(),
ct_logs:log("Suite Hook","Failed to start a CTH: ~p:~p",
@@ -214,7 +222,7 @@ call([{HookId, Fun} | Rest], Config, Meta, Hooks) ->
{NewConf, NewHook} = Fun(Hook, Config, Meta),
NewCalls = get_new_hooks(NewConf, Fun),
NewHooks = lists:keyreplace(HookId, #ct_hook_config.id, Hooks, NewHook),
- call(resort(NewCalls ++ Rest,NewHooks), %% Resort if call_init changed prio
+ call(resort(NewCalls ++ Rest,NewHooks,Meta), %% Resort if call_init changed prio
remove(?config_name, NewConf), Meta,
terminate_if_scope_ends(HookId, Meta, NewHooks))
catch throw:{error_in_cth_call,Reason} ->
@@ -283,6 +291,14 @@ get_new_hooks(Config) when is_list(Config) ->
get_new_hooks(_Config) ->
[].
+get_builtin_hooks(Opts) ->
+ case proplists:get_value(enable_builtin_hooks,Opts) of
+ false ->
+ [];
+ _Else ->
+ [{HookConf, call_id, undefined} || HookConf <- ?BUILTIN_HOOKS]
+ end.
+
save_suite_data_async(Hooks) ->
ct_util:save_suite_data_async(?config_name, Hooks).
@@ -290,9 +306,21 @@ get_hooks() ->
lists:keysort(#ct_hook_config.prio,ct_util:read_suite_data(?config_name)).
%% Sort all calls in this order:
-%% call_id < call_init < Hook Priority 1 < .. < Hook Priority N
+%% call_id < call_init < ctfirst < Priority 1 < .. < Priority N < ctlast
%% If Hook Priority is equal, check when it has been installed and
%% sort on that instead.
+%% If we are doing a cleanup call i.e. {post,pre}_end_per_*, all priorities
+%% are reversed. Probably want to make this sorting algorithm pluginable
+%% as some point...
+resort(Calls,Hooks,[F|_R]) when F == post_end_per_testcase;
+ F == pre_end_per_group;
+ F == post_end_per_group;
+ F == pre_end_per_suite;
+ F == post_end_per_suite ->
+ lists:reverse(resort(Calls,Hooks));
+resort(Calls,Hooks,_Meta) ->
+ resort(Calls,Hooks).
+
resort(Calls, Hooks) ->
lists:sort(
fun({_,_,_},_) ->
@@ -311,6 +339,14 @@ resort(Calls, Hooks) ->
%% If priorities are equal, we check the position in the
%% hooks list
pos(Id1,Hooks) < pos(Id2,Hooks);
+ P1 == ctfirst ->
+ true;
+ P2 == ctfirst ->
+ false;
+ P1 == ctlast ->
+ false;
+ P2 == ctlast ->
+ true;
true ->
P1 < P2
end
@@ -331,7 +367,7 @@ catch_apply(M,F,A, Default) ->
catch error:Reason ->
case erlang:get_stacktrace() of
%% Return the default if it was the CTH module which did not have the function.
- [{M,F,A}|_] when Reason == undef ->
+ [{M,F,A,_}|_] when Reason == undef ->
Default;
Trace ->
ct_logs:log("Suite Hook","Call to CTH failed: ~p:~p",
diff --git a/lib/common_test/src/ct_line.erl b/lib/common_test/src/ct_line.erl
deleted file mode 100644
index 4af9da5463..0000000000
--- a/lib/common_test/src/ct_line.erl
+++ /dev/null
@@ -1,266 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
-%%
-%% The contents of this file are subject to the Erlang Public License,
-%% Version 1.1, (the "License"); you may not use this file except in
-%% compliance with the License. You should have received a copy of the
-%% Erlang Public License along with this software. If not, it can be
-%% retrieved online at http://www.erlang.org/.
-%%
-%% Software distributed under the License is distributed on an "AS IS"
-%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
-%% the License for the specific language governing rights and limitations
-%% under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%% @doc Parse transform for inserting line numbers
-
--module(ct_line).
-
--record(vars, {module, % atom() Module name
- vsn, % atom()
-
- init_info=[], % [{M,F,A,C,L}]
-
- function, % atom()
- arity, % int()
- clause, % int()
- lines, % [int()]
- depth, % int()
- is_guard=false % boolean
- }).
-
--export([parse_transform/2,
- line/1]).
-
-line(LOC={{Mod,Func},_Line}) ->
- Lines = case get(test_server_loc) of
- [{{Mod,Func},_}|Ls] ->
- Ls;
- Ls when is_list(Ls) ->
- case length(Ls) of
- 10 ->
- [_|T]=lists:reverse(Ls),
- lists:reverse(T);
- _ ->
- Ls
- end;
- _ ->
- []
- end,
- put(test_server_loc,[LOC|Lines]).
-
-parse_transform(Forms, _Options) ->
- transform(Forms, _Options).
-
-%% forms(Fs) -> lists:map(fun (F) -> form(F) end, Fs).
-
-transform(Forms, _Options)->
- Vars0 = #vars{},
- {ok, MungedForms, _Vars} = transform(Forms, [], Vars0),
- MungedForms.
-
-
-transform([Form|Forms], MungedForms, Vars) ->
- case munge(Form, Vars) of
- ignore ->
- transform(Forms, MungedForms, Vars);
- {MungedForm, Vars2} ->
- transform(Forms, [MungedForm|MungedForms], Vars2)
- end;
-transform([], MungedForms, Vars) ->
- {ok, lists:reverse(MungedForms), Vars}.
-
-%% This code traverses the abstract code, stored as the abstract_code
-%% chunk in the BEAM file, as described in absform(3) for Erlang/OTP R8B
-%% (Vsn=abstract_v2).
-%% The abstract format after preprocessing differs slightly from the abstract
-%% format given eg using epp:parse_form, this has been noted in comments.
-munge(Form={attribute,_,module,Module}, Vars) ->
- Vars2 = Vars#vars{module=Module},
- {Form, Vars2};
-
-munge({function,0,module_info,_Arity,_Clauses}, _Vars) ->
- ignore; % module_info will be added again when the forms are recompiled
-munge({function,Line,Function,Arity,Clauses}, Vars) ->
- Vars2 = Vars#vars{function=Function,
- arity=Arity,
- clause=1,
- lines=[],
- depth=1},
- {MungedClauses, Vars3} = munge_clauses(Clauses, Vars2, []),
- {{function,Line,Function,Arity,MungedClauses}, Vars3};
-munge(Form, Vars) -> % attributes
- {Form, Vars}.
-
-munge_clauses([{clause,Line,Pattern,Guards,Body}|Clauses], Vars, MClauses) ->
- {MungedGuards, _Vars} = munge_exprs(Guards, Vars#vars{is_guard=true},[]),
-
- case Vars#vars.depth of
- 1 -> % function clause
- {MungedBody, Vars2} = munge_body(Body, Vars#vars{depth=2}, []),
- ClauseInfo = {Vars2#vars.module,
- Vars2#vars.function,
- Vars2#vars.arity,
- Vars2#vars.clause,
- length(Vars2#vars.lines)},
- InitInfo = [ClauseInfo | Vars2#vars.init_info],
- Vars3 = Vars2#vars{init_info=InitInfo,
- clause=(Vars2#vars.clause)+1,
- lines=[],
- depth=1},
- munge_clauses(Clauses, Vars3,
- [{clause,Line,Pattern,MungedGuards,MungedBody}|
- MClauses]);
-
- 2 -> % receive-, case- or if clause
- {MungedBody, Vars2} = munge_body(Body, Vars, []),
- munge_clauses(Clauses, Vars2,
- [{clause,Line,Pattern,MungedGuards,MungedBody}|
- MClauses])
- end;
-munge_clauses([], Vars, MungedClauses) ->
- {lists:reverse(MungedClauses), Vars}.
-
-munge_body([Expr|Body], Vars, MungedBody) ->
- %% Here is the place to add a call to cover:bump/6!
- Line = element(2, Expr),
- Lines = Vars#vars.lines,
- case lists:member(Line,Lines) of
- true -> % already a bump at this line!
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- munge_body(Body, Vars2, [MungedExpr|MungedBody]);
- false ->
- Bump = {call, 0, {remote,0,{atom,0,?MODULE},{atom,0,line}},
- [{tuple,0,[{tuple,0,[{atom,0,Vars#vars.module},
- {atom, 0, Vars#vars.function}]},
- {integer, 0, Line}]}]},
- Lines2 = [Line|Lines],
-
- {MungedExpr, Vars2} = munge_expr(Expr, Vars#vars{lines=Lines2}),
- munge_body(Body, Vars2, [MungedExpr,Bump|MungedBody])
- end;
-munge_body([], Vars, MungedBody) ->
- {lists:reverse(MungedBody), Vars}.
-
-munge_expr({match,Line,ExprL,ExprR}, Vars) ->
- {MungedExprL, Vars2} = munge_expr(ExprL, Vars),
- {MungedExprR, Vars3} = munge_expr(ExprR, Vars2),
- {{match,Line,MungedExprL,MungedExprR}, Vars3};
-munge_expr({tuple,Line,Exprs}, Vars) ->
- {MungedExprs, Vars2} = munge_exprs(Exprs, Vars, []),
- {{tuple,Line,MungedExprs}, Vars2};
-munge_expr({record,Line,Expr,Exprs}, Vars) ->
- %% Only for Vsn=raw_abstract_v1
- {MungedExprName, Vars2} = munge_expr(Expr, Vars),
- {MungedExprFields, Vars3} = munge_exprs(Exprs, Vars2, []),
- {{record,Line,MungedExprName,MungedExprFields}, Vars3};
-munge_expr({record_field,Line,ExprL,ExprR}, Vars) ->
- %% Only for Vsn=raw_abstract_v1
- {MungedExprL, Vars2} = munge_expr(ExprL, Vars),
- {MungedExprR, Vars3} = munge_expr(ExprR, Vars2),
- {{record_field,Line,MungedExprL,MungedExprR}, Vars3};
-munge_expr({cons,Line,ExprH,ExprT}, Vars) ->
- {MungedExprH, Vars2} = munge_expr(ExprH, Vars),
- {MungedExprT, Vars3} = munge_expr(ExprT, Vars2),
- {{cons,Line,MungedExprH,MungedExprT}, Vars3};
-munge_expr({op,Line,Op,ExprL,ExprR}, Vars) ->
- {MungedExprL, Vars2} = munge_expr(ExprL, Vars),
- {MungedExprR, Vars3} = munge_expr(ExprR, Vars2),
- {{op,Line,Op,MungedExprL,MungedExprR}, Vars3};
-munge_expr({op,Line,Op,Expr}, Vars) ->
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- {{op,Line,Op,MungedExpr}, Vars2};
-munge_expr({'catch',Line,Expr}, Vars) ->
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- {{'catch',Line,MungedExpr}, Vars2};
-munge_expr({call,Line1,{remote,Line2,ExprM,ExprF},Exprs},
- Vars) when Vars#vars.is_guard==false->
- {MungedExprM, Vars2} = munge_expr(ExprM, Vars),
- {MungedExprF, Vars3} = munge_expr(ExprF, Vars2),
- {MungedExprs, Vars4} = munge_exprs(Exprs, Vars3, []),
- {{call,Line1,{remote,Line2,MungedExprM,MungedExprF},MungedExprs}, Vars4};
-munge_expr({call,Line1,{remote,_Line2,_ExprM,ExprF},Exprs},
- Vars) when Vars#vars.is_guard==true ->
- %% Difference in abstract format after preprocessing: BIF calls in guards
- %% are translated to {remote,...} (which is not allowed as source form)
- %% NOT NECESSARY FOR Vsn=raw_abstract_v1
- munge_expr({call,Line1,ExprF,Exprs}, Vars);
-munge_expr({call,Line,Expr,Exprs}, Vars) ->
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- {MungedExprs, Vars3} = munge_exprs(Exprs, Vars2, []),
- {{call,Line,MungedExpr,MungedExprs}, Vars3};
-munge_expr({lc,Line,Expr,LC}, Vars) ->
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- {MungedLC, Vars3} = munge_lc(LC, Vars2, []),
- {{lc,Line,MungedExpr,MungedLC}, Vars3};
-munge_expr({block,Line,Body}, Vars) ->
- {MungedBody, Vars2} = munge_body(Body, Vars, []),
- {{block,Line,MungedBody}, Vars2};
-munge_expr({'if',Line,Clauses}, Vars) ->
- {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []),
- {{'if',Line,MungedClauses}, Vars2};
-munge_expr({'case',Line,Expr,Clauses}, Vars) ->
- {MungedExpr,Vars2} = munge_expr(Expr,Vars),
- {MungedClauses,Vars3} = munge_clauses(Clauses, Vars2, []),
- {{'case',Line,MungedExpr,MungedClauses}, Vars3};
-munge_expr({'receive',Line,Clauses}, Vars) ->
- {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []),
- {{'receive',Line,MungedClauses}, Vars2};
-munge_expr({'receive',Line,Clauses,Expr,Body}, Vars) ->
- {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []),
- {MungedExpr, Vars3} = munge_expr(Expr, Vars2),
- {MungedBody, Vars4} = munge_body(Body, Vars3, []),
- {{'receive',Line,MungedClauses,MungedExpr,MungedBody}, Vars4};
-munge_expr({'try',Line,Exprs,Clauses,CatchClauses}, Vars) ->
- {MungedExprs, Vars1} = munge_exprs(Exprs, Vars, []),
- {MungedClauses, Vars2} = munge_clauses(Clauses, Vars1, []),
- {MungedCatchClauses, Vars3} = munge_clauses(CatchClauses, Vars2, []),
- {{'try',Line,MungedExprs,MungedClauses,MungedCatchClauses}, Vars3};
-%% Difference in abstract format after preprocessing: Funs get an extra
-%% element Extra.
-%% NOT NECESSARY FOR Vsn=raw_abstract_v1
-munge_expr({'fun',Line,{function,Name,Arity},_Extra}, Vars) ->
- {{'fun',Line,{function,Name,Arity}}, Vars};
-munge_expr({'fun',Line,{clauses,Clauses},_Extra}, Vars) ->
- {MungedClauses,Vars2}=munge_clauses(Clauses, Vars, []),
- {{'fun',Line,{clauses,MungedClauses}}, Vars2};
-munge_expr({'fun',Line,{clauses,Clauses}}, Vars) ->
- %% Only for Vsn=raw_abstract_v1
- {MungedClauses,Vars2}=munge_clauses(Clauses, Vars, []),
- {{'fun',Line,{clauses,MungedClauses}}, Vars2};
-munge_expr(Form, Vars) -> % var|char|integer|float|string|atom|nil|bin|eof
- {Form, Vars}.
-
-munge_exprs([Expr|Exprs], Vars, MungedExprs) when Vars#vars.is_guard==true,
- is_list(Expr) ->
- {MungedExpr, _Vars} = munge_exprs(Expr, Vars, []),
- munge_exprs(Exprs, Vars, [MungedExpr|MungedExprs]);
-munge_exprs([Expr|Exprs], Vars, MungedExprs) ->
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- munge_exprs(Exprs, Vars2, [MungedExpr|MungedExprs]);
-munge_exprs([], Vars, MungedExprs) ->
- {lists:reverse(MungedExprs), Vars}.
-
-munge_lc([{generate,Line,Pattern,Expr}|LC], Vars, MungedLC) ->
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- munge_lc(LC, Vars2, [{generate,Line,Pattern,MungedExpr}|MungedLC]);
-munge_lc([Expr|LC], Vars, MungedLC) ->
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- munge_lc(LC, Vars2, [MungedExpr|MungedLC]);
-munge_lc([], Vars, MungedLC) ->
- {lists:reverse(MungedLC), Vars}.
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl
index faec461775..19ad7b26d8 100644
--- a/lib/common_test/src/ct_logs.erl
+++ b/lib/common_test/src/ct_logs.erl
@@ -29,14 +29,16 @@
-module(ct_logs).
-export([init/1,close/2,init_tc/1,end_tc/1]).
--export([get_log_dir/0,log/3,start_log/1,cont_log/2,end_log/0]).
+-export([get_log_dir/0,get_log_dir/1]).
+-export([log/3,start_log/1,cont_log/2,end_log/0]).
-export([set_stylesheet/2,clear_stylesheet/1]).
-export([add_external_logs/1,add_link/3]).
-export([make_last_run_index/0]).
-export([make_all_suites_index/1,make_all_runs_index/1]).
+-export([get_ts_html_wrapper/3]).
%% Logging stuff directly from testcase
--export([tc_log/3,tc_print/3,tc_pal/3,
+-export([tc_log/3,tc_print/3,tc_pal/3,ct_log/3,
basic_html/0]).
%% Simulate logger process for use without ct environment running
@@ -53,6 +55,7 @@
-define(all_runs_name, "all_runs.html").
-define(index_name, "index.html").
-define(totals_name, "totals.info").
+-define(css_default, "ct_default.css").
-define(table_color1,"#ADD8E6").
-define(table_color2,"#E4F0FE").
@@ -162,7 +165,12 @@ clear_stylesheet(TC) ->
%%%-----------------------------------------------------------------
%%% @spec get_log_dir() -> {ok,Dir} | {error,Reason}
get_log_dir() ->
- call(get_log_dir).
+ call({get_log_dir,false}).
+
+%%%-----------------------------------------------------------------
+%%% @spec get_log_dir(ReturnAbsName) -> {ok,Dir} | {error,Reason}
+get_log_dir(ReturnAbsName) ->
+ call({get_log_dir,ReturnAbsName}).
%%%-----------------------------------------------------------------
%%% make_last_run_index() -> ok
@@ -205,6 +213,7 @@ cast(Msg) ->
%%% <p>This function is called by ct_framework:init_tc/3</p>
init_tc(RefreshLog) ->
call({init_tc,self(),group_leader(),RefreshLog}),
+ io:format(xhtml("", "<br />")),
ok.
%%%-----------------------------------------------------------------
@@ -374,6 +383,23 @@ tc_pal(Category,Format,Args) ->
ok.
+%%%-----------------------------------------------------------------
+%%% @spec tc_pal(Category,Format,Args) -> ok
+%%% Category = atom()
+%%% Format = string()
+%%% Args = list()
+%%%
+%%% @doc Print and log to the ct framework log
+%%%
+%%% <p>This function is called by internal ct functions to
+%%% force logging to the ct framework log</p>
+ct_log(Category,Format,Args) ->
+ cast({ct_log,[{div_header(Category),[]},
+ {Format,Args},
+ {div_footer(),[]}]}),
+ ok.
+
+
%%%=================================================================
%%% Internal functions
int_header() ->
@@ -431,7 +457,6 @@ logger(Parent,Mode) ->
timer:sleep(1000),
Time1 = calendar:local_time(),
Dir1 = make_dirname(Time1),
-
{Time1,Dir1};
false ->
{Time0,Dir0}
@@ -439,8 +464,44 @@ logger(Parent,Mode) ->
%%! <---
file:make_dir(Dir),
+ AbsDir = ?abs(Dir),
+ put(ct_run_dir, AbsDir),
+
+ case basic_html() of
+ true ->
+ put(basic_html, true);
+ BasicHtml ->
+ put(basic_html, BasicHtml),
+ %% copy stylesheet to log dir (both top dir and test run
+ %% dir) so logs are independent of Common Test installation
+ {ok,Cwd} = file:get_cwd(),
+ CTPath = code:lib_dir(common_test),
+ CSSFileSrc = filename:join(filename:join(CTPath, "priv"),
+ ?css_default),
+ CSSFileDestTop = filename:join(Cwd, ?css_default),
+ CSSFileDestRun = filename:join(AbsDir, ?css_default),
+ case file:copy(CSSFileSrc, CSSFileDestTop) of
+ {error,Reason0} ->
+ io:format(user, "ERROR! "++
+ "CSS file ~p could not be copied to ~p. "++
+ "Reason: ~p~n",
+ [CSSFileSrc,CSSFileDestTop,Reason0]),
+ exit({css_file_error,CSSFileDestTop});
+ _ ->
+ case file:copy(CSSFileSrc, CSSFileDestRun) of
+ {error,Reason1} ->
+ io:format(user, "ERROR! "++
+ "CSS file ~p could not be copied to ~p. "++
+ "Reason: ~p~n",
+ [CSSFileSrc,CSSFileDestRun,Reason1]),
+ exit({css_file_error,CSSFileDestRun});
+ _ ->
+ ok
+ end
+ end
+ end,
ct_event:notify(#event{name=start_logging,node=node(),
- data=?abs(Dir)}),
+ data=AbsDir}),
make_all_runs_index(start),
make_all_suites_index(start),
case Mode of
@@ -455,7 +516,7 @@ logger(Parent,Mode) ->
Parent ! {started,self(),{Time,filename:absname("")}},
set_evmgr_gl(CtLogFd),
logger_loop(#logger_state{parent=Parent,
- log_dir=Dir,
+ log_dir=AbsDir,
start_time=Time,
orig_GL=group_leader(),
ct_log_fd=CtLogFd,
@@ -519,12 +580,15 @@ logger_loop(State) ->
set_evmgr_gl(State#logger_state.ct_log_fd),
return(From,ok),
logger_loop(State#logger_state{tc_groupleaders=rm_tc_gl(TCPid,State)});
- {get_log_dir,From} ->
+ {{get_log_dir,true},From} ->
return(From,{ok,State#logger_state.log_dir}),
logger_loop(State);
+ {{get_log_dir,false},From} ->
+ return(From,{ok,filename:basename(State#logger_state.log_dir)}),
+ logger_loop(State);
{make_last_run_index,From} ->
make_last_run_index(State#logger_state.start_time),
- return(From,State#logger_state.log_dir),
+ return(From,filename:basename(State#logger_state.log_dir)),
logger_loop(State);
{set_stylesheet,_,SSFile} when State#logger_state.stylesheet == SSFile ->
logger_loop(State);
@@ -535,7 +599,12 @@ logger_loop(State) ->
{clear_stylesheet,_} when State#logger_state.stylesheet == undefined ->
logger_loop(State);
{clear_stylesheet,_} ->
- logger_loop(State#logger_state{stylesheet=undefined});
+ logger_loop(State#logger_state{stylesheet=undefined});
+ {ct_log, List} ->
+ Fd = State#logger_state.ct_log_fd,
+ [begin io:format(Fd,Str,Args),io:nl(Fd) end ||
+ {Str,Args} <- List],
+ logger_loop(State);
stop ->
io:format(State#logger_state.ct_log_fd,
int_header()++int_footer(),
@@ -635,7 +704,7 @@ set_evmgr_gl(GL) ->
open_ctlog() ->
{ok,Fd} = file:open(?ct_log_name,[write]),
- io:format(Fd,header("Common Test Framework"),[]),
+ io:format(Fd, header("Common Test Framework Log"), []),
case file:consult(ct_run:variables_file_name("../")) of
{ok,Vars} ->
io:format(Fd, config_table(Vars), []);
@@ -650,17 +719,22 @@ open_ctlog() ->
end,
print_style(Fd,undefined),
io:format(Fd,
- "<br><br><h2>Progress Log</h2>\n"
- "<pre>\n",[]),
+ xhtml("<br><br><h2>Progress Log</h2>\n<pre>\n",
+ "<br /><br /><h4>PROGRESS LOG</h4>\n<pre>\n"), []),
Fd.
print_style(Fd,undefined) ->
- io:format(Fd,
- "<style>\n"
- "div.ct_internal { background:lightgrey; color:black }\n"
- "div.default { background:lightgreen; color:black }\n"
- "</style>\n",
- []);
+ case basic_html() of
+ true ->
+ io:format(Fd,
+ "<style>\n"
+ "div.ct_internal { background:lightgrey; color:black; }\n"
+ "div.default { background:lightgreen; color:black; }\n"
+ "</style>\n",
+ []);
+ _ ->
+ ok
+ end;
print_style(Fd,StyleSheet) ->
case file:read_file(StyleSheet) of
@@ -670,20 +744,19 @@ print_style(Fd,StyleSheet) ->
0 -> string:str(Str,"<STYLE>");
N0 -> N0
end,
- case Pos0 of
- 0 -> print_style_error(Fd,StyleSheet,missing_style_tag);
- _ ->
- Pos1 = case string:str(Str,"</style>") of
- 0 -> string:str(Str,"</STYLE>");
- N1 -> N1
- end,
- case Pos1 of
- 0 ->
- print_style_error(Fd,StyleSheet,missing_style_end_tag);
- _ ->
- Style = string:sub_string(Str,Pos0,Pos1+7),
- io:format(Fd,"~s\n",[Style])
- end
+ Pos1 = case string:str(Str,"</style>") of
+ 0 -> string:str(Str,"</STYLE>");
+ N1 -> N1
+ end,
+ if (Pos0 == 0) and (Pos1 /= 0) ->
+ print_style_error(Fd,StyleSheet,missing_style_start_tag);
+ (Pos0 /= 0) and (Pos1 == 0) ->
+ print_style_error(Fd,StyleSheet,missing_style_end_tag);
+ Pos0 /= 0 ->
+ Style = string:sub_string(Str,Pos0,Pos1+7),
+ io:format(Fd,"~s\n",[Style]);
+ Pos0 == 0 ->
+ io:format(Fd,"<style>~s</style>\n",[Str])
end;
{error,Reason} ->
print_style_error(Fd,StyleSheet,Reason)
@@ -701,7 +774,7 @@ print_style_error(Fd,StyleSheet,Reason) ->
print_style(Fd,undefined).
close_ctlog(Fd) ->
- io:format(Fd,"</pre>",[]),
+ io:format(Fd,"\n</pre>\n",[]),
io:format(Fd,footer(),[]),
file:close(Fd).
@@ -832,8 +905,8 @@ make_one_index_entry1(SuiteName, Link, Label, Success, Fail, UserSkip, AutoSkip,
CrashDumpName = SuiteName ++ "_erl_crash.dump",
case filelib:is_file(CrashDumpName) of
true ->
- ["&nbsp;<A HREF=\"", CrashDumpName,
- "\">(CrashDump)</A>"];
+ ["&nbsp;<a href=\"", CrashDumpName,
+ "\">(CrashDump)</a>"];
false ->
""
end
@@ -847,32 +920,41 @@ make_one_index_entry1(SuiteName, Link, Label, Success, Fail, UserSkip, AutoSkip,
0 -> "-";
_ -> NodeOrDate
end,
- N = ["<TD ALIGN=right><FONT SIZE=-1>",Node1,"</FONT></TD>\n"],
- L = ["<TD ALIGN=center><FONT SIZE=-1><B>",Label,"</FONT></B></TD>\n"],
- T = ["<TD><FONT SIZE=-1>",timestamp(CtRunDir),"</FONT></TD>\n"],
+ TS = timestamp(CtRunDir),
+ N = xhtml(["<td align=right><font size=\"-1\">",Node1,
+ "</font></td>\n"],
+ ["<td align=right>",Node1,"</td>\n"]),
+ L = xhtml(["<td align=center><font size=\"-1\"><b>",Label,
+ "</font></b></td>\n"],
+ ["<td align=center><b>",Label,"</b></td>\n"]),
+ T = xhtml(["<td><font size=\"-1\">",TS,"</font></td>\n"],
+ ["<td>",TS,"</td>\n"]),
CtLogFile = filename:join(CtRunDir,?ct_log_name),
OldRunsLink =
case OldRuns of
[] -> "none";
- _ -> "<A HREF=\""++?all_runs_name++"\">Old Runs</A>"
+ _ -> "<a href=\""++?all_runs_name++"\">Old Runs</a>"
end,
- A=["<TD><FONT SIZE=-1><A HREF=\"",CtLogFile,"\">CT Log</A></FONT></TD>\n",
- "<TD><FONT SIZE=-1>",OldRunsLink,"</FONT></TD>\n"],
+ A = xhtml(["<td><font size=\"-1\"><a href=\"",CtLogFile,
+ "\">CT Log</a></font></td>\n",
+ "<td><font size=\"-1\">",OldRunsLink,"</font></td>\n"],
+ ["<td><a href=\"",CtLogFile,"\">CT Log</a></td>\n",
+ "<td>",OldRunsLink,"</td>\n"]),
{L,T,N,A};
false ->
{"","","",""}
end,
NotBuiltStr =
if NotBuilt == 0 ->
- ["<TD ALIGN=right>",integer_to_list(NotBuilt),"</TD>\n"];
+ ["<td align=right>",integer_to_list(NotBuilt),"</td>\n"];
true ->
- ["<TD ALIGN=right><A HREF=\"",filename:join(CtRunDir,?ct_log_name),"\">",
- integer_to_list(NotBuilt),"</A></TD>\n"]
+ ["<td align=right><a href=\"",filename:join(CtRunDir,?ct_log_name),"\">",
+ integer_to_list(NotBuilt),"</a></td>\n"]
end,
FailStr =
if Fail > 0 ->
- ["<FONT color=\"red\">",
- integer_to_list(Fail),"</FONT>"];
+ ["<font color=\"red\">",
+ integer_to_list(Fail),"</font>"];
true ->
integer_to_list(Fail)
end,
@@ -880,31 +962,33 @@ make_one_index_entry1(SuiteName, Link, Label, Success, Fail, UserSkip, AutoSkip,
if AutoSkip == undefined -> {UserSkip,"?","?"};
true ->
ASStr = if AutoSkip > 0 ->
- ["<FONT color=\"brown\">",
- integer_to_list(AutoSkip),"</FONT>"];
+ ["<font color=\"brown\">",
+ integer_to_list(AutoSkip),"</font>"];
true -> integer_to_list(AutoSkip)
end,
{UserSkip+AutoSkip,integer_to_list(UserSkip),ASStr}
end,
- ["<TR valign=top>\n",
- "<TD><FONT SIZE=-1><A HREF=\"",LogFile,"\">",SuiteName,"</A>",CrashDumpLink,"</FONT></TD>\n",
- Lbl,
- Timestamp,
- "<TD ALIGN=right>",integer_to_list(Success),"</TD>\n",
- "<TD ALIGN=right>",FailStr,"</TD>\n",
- "<TD ALIGN=right>",integer_to_list(AllSkip),
- " (",UserSkipStr,"/",AutoSkipStr,")</TD>\n",
- NotBuiltStr,
- Node,
- AllInfo,
- "</TR>\n"].
+ [xhtml("<tr valign=top>\n",
+ ["<tr class=\"",odd_or_even(),"\">\n"]),
+ xhtml("<td><font size=\"-1\"><a href=\"", "<td><a href=\""),
+ LogFile,"\">",SuiteName,"</a>", CrashDumpLink,
+ xhtml("</font></td>\n", "</td>\n"),
+ Lbl, Timestamp,
+ "<td align=right>",integer_to_list(Success),"</td>\n",
+ "<td align=right>",FailStr,"</td>\n",
+ "<td align=right>",integer_to_list(AllSkip),
+ " (",UserSkipStr,"/",AutoSkipStr,")</td>\n",
+ NotBuiltStr, Node, AllInfo, "</tr>\n"].
+
total_row(Success, Fail, UserSkip, AutoSkip, NotBuilt, All) ->
{Label,TimestampCell,AllInfo} =
case All of
true ->
- {"<TD>&nbsp;</TD>\n",
- "<TD>&nbsp;</TD>\n",
- "<TD>&nbsp;</TD>\n<TD>&nbsp;</TD>\n"};
+ {"<td>&nbsp;</td>\n",
+ "<td>&nbsp;</td>\n",
+ "<td>&nbsp;</td>\n"
+ "<td>&nbsp;</td>\n"
+ "<td>&nbsp;</td>\n"};
false ->
{"","",""}
end,
@@ -914,17 +998,15 @@ total_row(Success, Fail, UserSkip, AutoSkip, NotBuilt, All) ->
true -> {UserSkip+AutoSkip,
integer_to_list(UserSkip),integer_to_list(AutoSkip)}
end,
- ["<TR valign=top>\n",
- "<TD><B>Total</B></TD>",
- Label,
- TimestampCell,
- "<TD ALIGN=right><B>",integer_to_list(Success),"<B></TD>\n",
- "<TD ALIGN=right><B>",integer_to_list(Fail),"<B></TD>\n",
- "<TD ALIGN=right>",integer_to_list(AllSkip),
- " (",UserSkipStr,"/",AutoSkipStr,")</TD>\n",
- "<TD ALIGN=right><B>",integer_to_list(NotBuilt),"<B></TD>\n",
- AllInfo,
- "</TR>\n"].
+ [xhtml("<tr valign=top>\n",
+ ["<tr class=\"",odd_or_even(),"\">\n"]),
+ "<td><b>Total</b></td>\n", Label, TimestampCell,
+ "<td align=right><b>",integer_to_list(Success),"<b></td>\n",
+ "<td align=right><b>",integer_to_list(Fail),"<b></td>\n",
+ "<td align=right>",integer_to_list(AllSkip),
+ " (",UserSkipStr,"/",AutoSkipStr,")</td>\n",
+ "<td align=right><b>",integer_to_list(NotBuilt),"<b></td>\n",
+ AllInfo, "</tr>\n"].
not_built(_BaseName,_LogDir,_All,[]) ->
0;
@@ -983,41 +1065,52 @@ index_header(Label, StartTime) ->
undefined ->
header("Test Results", format_time(StartTime));
_ ->
- header("Test Results for \"" ++ Label ++ "\"",
+ header("Test Results for '" ++ Label ++ "'",
format_time(StartTime))
end,
[Head |
- ["<CENTER>\n",
- "<P><A HREF=\"",?ct_log_name,"\">Common Test Framework Log</A></P>",
- "<TABLE border=\"3\" cellpadding=\"5\" "
- "BGCOLOR=\"",?table_color3,"\">\n"
- "<th><B>Test Name</B></th>\n",
- "<th><font color=\"",?table_color3,"\">_</font>Ok"
- "<font color=\"",?table_color3,"\">_</font></th>\n"
+ ["<center>\n",
+ xhtml(["<p><a href=\"",?ct_log_name,
+ "\">Common Test Framework Log</a></p>"],
+ ["<br />"
+ "<div id=\"button_holder\" class=\"btn\">\n"
+ "<a href=\"",?ct_log_name,
+ "\">COMMON TEST FRAMEWORK LOG</a>\n</div>"]),
+ xhtml("<br>\n", "<br /><br /><br />\n"),
+ xhtml(["<table border=\"3\" cellpadding=\"5\" "
+ "bgcolor=\"",?table_color3,"\">\n"], "<table>\n"),
+ "<th><b>Test Name</b></th>\n",
+ xhtml(["<th><font color=\"",?table_color3,"\">_</font>Ok"
+ "<font color=\"",?table_color3,"\">_</font></th>\n"],
+ "<th>Ok</th>\n"),
"<th>Failed</th>\n",
- "<th>Skipped<br>(User/Auto)</th>\n"
- "<th>Missing<br>Suites</th>\n"
+ "<th>Skipped", xhtml("<br>", "<br />"), "(User/Auto)</th>\n"
+ "<th>Missing", xhtml("<br>", "<br />"), "Suites</th>\n"
"\n"]].
-
all_suites_index_header() ->
{ok,Cwd} = file:get_cwd(),
all_suites_index_header(Cwd).
all_suites_index_header(IndexDir) ->
LogDir = filename:basename(IndexDir),
- AllRuns = "All test runs in \"" ++ LogDir ++ "\"",
+ AllRuns = xhtml(["All test runs in \"" ++ LogDir ++ "\""],
+ "ALL RUNS"),
+ AllRunsLink = xhtml(["<a href=\"",?all_runs_name,"\">",AllRuns,"</a>\n"],
+ ["<div id=\"button_holder\" class=\"btn\">\n"
+ "<a href=\"",?all_runs_name,"\">",AllRuns,"</a>\n</div>"]),
[header("Test Results") |
- ["<CENTER>\n",
- "<A HREF=\"",?all_runs_name,"\">",AllRuns,"</A>\n",
- "<br><br>\n",
- "<TABLE border=\"3\" cellpadding=\"5\" "
- "BGCOLOR=\"",?table_color2,"\">\n"
+ ["<center>\n",
+ AllRunsLink,
+ xhtml("<br><br>\n", "<br /><br />\n"),
+ xhtml(["<table border=\"3\" cellpadding=\"5\" "
+ "bgcolor=\"",?table_color2,"\">\n"], "<table>\n"),
"<th>Test Name</th>\n",
"<th>Label</th>\n",
"<th>Test Run Started</th>\n",
- "<th><font color=\"",?table_color2,"\">_</font>Ok"
- "<font color=\"",?table_color2,"\">_</font></th>\n"
+ xhtml(["<th><font color=\"",?table_color2,"\">_</font>Ok"
+ "<font color=\"",?table_color2,"\">_</font></th>\n"],
+ "<th>Ok</th>\n"),
"<th>Failed</th>\n",
"<th>Skipped<br>(User/Auto)</th>\n"
"<th>Missing<br>Suites</th>\n"
@@ -1030,17 +1123,25 @@ all_runs_header() ->
{ok,Cwd} = file:get_cwd(),
LogDir = filename:basename(Cwd),
Title = "All test runs in \"" ++ LogDir ++ "\"",
+ IxLink = [xhtml(["<p><a href=\"",?index_name,
+ "\">Test Index Page</a></p>"],
+ ["<div id=\"button_holder\" class=\"btn\">\n"
+ "<a href=\"",?index_name,
+ "\">TEST INDEX PAGE</a>\n</div>"]),
+ xhtml("<br>\n", "<br /><br />\n")],
[header(Title) |
- ["<CENTER><TABLE border=\"3\" cellpadding=\"5\" "
- "BGCOLOR=\"",?table_color1,"\">\n"
- "<th><B>History</B></th>\n"
- "<th><B>Node</B></th>\n"
- "<th><B>Label</B></th>\n"
+ ["<center>\n", IxLink,
+ xhtml(["<table border=\"3\" cellpadding=\"5\" "
+ "bgcolor=\"",?table_color1,"\">\n"], "<table>\n"),
+ "<th><b>History</b></th>\n"
+ "<th><b>Node</b></th>\n"
+ "<th><b>Label</b></th>\n"
"<th>Tests</th>\n"
- "<th><B>Test Names</B></th>\n"
- "<th>Total</th>\n"
- "<th><font color=\"",?table_color1,"\">_</font>Ok"
- "<font color=\"",?table_color1,"\">_</font></th>\n"
+ "<th><b>Test Names</b></th>\n"
+ "<th>Total</th>\n",
+ xhtml(["<th><font color=\"",?table_color1,"\">_</font>Ok"
+ "<font color=\"",?table_color1,"\">_</font></th>\n"],
+ "<th>Ok</th>\n"),
"<th>Failed</th>\n"
"<th>Skipped<br>(User/Auto)</th>\n"
"<th>Missing<br>Suites</th>\n"
@@ -1053,60 +1154,56 @@ header(Title, SubTitle) ->
header1(Title, SubTitle) ->
SubTitleHTML = if SubTitle =/= "" ->
- ["<CENTER>\n",
- "<H2>" ++ SubTitle ++ "</H2>\n",
- "</CENTER>\n<BR>\n"];
- true -> "<BR>\n"
+ ["<center>\n",
+ "<h3>" ++ SubTitle ++ "</h3>\n",
+ xhtml("</center>\n<br>\n", "</center>\n<br />\n")];
+ true -> xhtml("<br>\n", "<br />\n")
end,
- ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n"
- "<!-- autogenerated by '"++atom_to_list(?MODULE)++"'. -->\n"
- "<HTML>\n",
- "<HEAD>\n",
-
- "<TITLE>" ++ Title ++ " " ++ SubTitle ++ "</TITLE>\n",
- "<META HTTP-EQUIV=\"CACHE-CONTROL\" CONTENT=\"NO-CACHE\">\n",
-
- "</HEAD>\n",
-
- body_tag(),
-
- "<!-- ---- DOCUMENT TITLE ---- -->\n",
-
- "<CENTER>\n",
- "<H1>" ++ Title ++ "</H1>\n",
- "</CENTER>\n",
- SubTitleHTML,
-
- "<!-- ---- CONTENT ---- -->\n"].
+ CSSFile = xhtml(fun() -> "" end,
+ fun() -> make_relative(locate_default_css_file()) end),
+ [xhtml(["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n",
+ "<html>\n"],
+ ["<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"\n",
+ "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n",
+ "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">\n"]),
+ "<!-- autogenerated by '"++atom_to_list(?MODULE)++"' -->\n",
+ "<head>\n",
+ "<title>" ++ Title ++ " " ++ SubTitle ++ "</title>\n",
+ "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n",
+ xhtml("",
+ ["<link rel=\"stylesheet\" href=\"",CSSFile,"\" type=\"text/css\">"]),
+ "</head>\n",
+ body_tag(),
+ "<center>\n",
+ "<h1>" ++ Title ++ "</h1>\n",
+ "</center>\n",
+ SubTitleHTML,"\n"].
index_footer() ->
- ["</TABLE>\n"
- "</CENTER>\n" | footer()].
+ ["</table>\n"
+ "</center>\n" | footer()].
footer() ->
- ["<P><CENTER>\n"
- "<BR><BR>\n"
- "<HR>\n"
- "<P><FONT SIZE=-1>\n"
+ ["<center>\n",
+ xhtml("<br><br>\n<hr>\n", "<br /><br />\n"),
+ xhtml("<p><font size=\"-1\">\n", "<div class=\"copyright\">"),
"Copyright &copy; ", year(),
- " <A HREF=\"http://erlang.ericsson.se\">Open Telecom Platform</A><BR>\n"
- "Updated: <!date>", current_time(), "<!/date><BR>\n"
- "</FONT>\n"
- "</CENTER>\n"
+ " <a href=\"http://www.erlang.org\">Open Telecom Platform</a>",
+ xhtml("<br>\n", "<br />\n"),
+ "Updated: <!date>", current_time(), "<!/date>",
+ xhtml("<br>\n", "<br />\n"),
+ xhtml("</font></p>\n", "</div>\n"),
+ "</center>\n"
"</body>\n"].
body_tag() ->
- case basic_html() of
- true ->
- "<body bgcolor=\"#FFFFFF\" text=\"#000000\" link=\"#0000FF\" "
- "vlink=\"#800080\" alink=\"#FF0000\">\n";
- false ->
- CTPath = code:lib_dir(common_test),
- TileFile = filename:join(filename:join(CTPath,"priv"),"tile1.jpg"),
- "<body background=\"" ++ TileFile ++ "\" bgcolor=\"#FFFFFF\" text=\"#000000\" link=\"#0000FF\" "
- "vlink=\"#800080\" alink=\"#FF0000\">\n"
- end.
+ CTPath = code:lib_dir(common_test),
+ TileFile = filename:join(filename:join(CTPath,"priv"),"tile1.jpg"),
+ xhtml("<body background=\"" ++ TileFile ++
+ "\" bgcolor=\"#FFFFFF\" text=\"#000000\" link=\"#0000FF\" "
+ "vlink=\"#800080\" alink=\"#FF0000\">\n",
+ "<body>\n").
current_time() ->
format_time(calendar:local_time()).
@@ -1236,20 +1333,25 @@ config_table(Vars) ->
[config_table_header()|config_table1(Vars)].
config_table_header() ->
- ["<h2>Configuration</h2>\n",
- "<table border=\"3\" cellpadding=\"5\" bgcolor=\"",?table_color1,
- "\"\n",
+ [
+ xhtml(["<h2>Configuration</h2>\n"
+ "<table border=\"3\" cellpadding=\"5\" bgcolor=\"",?table_color1,"\"\n"],
+ "<h4>CONFIGURATION</h4>\n<table>\n"),
"<tr><th>Key</th><th>Value</th></tr>\n"].
config_table1([{Key,Value}|Vars]) ->
- ["<tr><td>", atom_to_list(Key), "</td>\n",
- "<td><pre>",io_lib:format("~p",[Value]),"</pre></td></tr>\n" |
+ [xhtml(["<tr><td>", atom_to_list(Key), "</td>\n",
+ "<td><pre>",io_lib:format("~p",[Value]),"</pre></td></tr>\n"],
+ ["<tr class=\"", odd_or_even(), "\">\n",
+ "<td>", atom_to_list(Key), "</td>\n",
+ "<td>", io_lib:format("~p",[Value]), "</td>\n</tr>\n"]) |
config_table1(Vars)];
config_table1([]) ->
["</table>\n"].
make_all_runs_index(When) ->
+ put(basic_html, basic_html()),
AbsName = ?abs(?all_runs_name),
notify_and_lock_file(AbsName),
if When == start -> ok;
@@ -1258,8 +1360,7 @@ make_all_runs_index(When) ->
Dirs = filelib:wildcard(logdir_prefix()++"*.*"),
DirsSorted = (catch sort_all_runs(Dirs)),
Header = all_runs_header(),
- BasicHtml = basic_html(),
- Index = [runentry(Dir, BasicHtml) || Dir <- DirsSorted],
+ Index = [runentry(Dir) || Dir <- DirsSorted],
Result = file:write_file(AbsName,Header++Index++index_footer()),
if When == start -> ok;
true -> io:put_chars("done\n")
@@ -1287,22 +1388,22 @@ sort_all_runs(Dirs) ->
interactive_link() ->
[Dir|_] = lists:reverse(filelib:wildcard(logdir_prefix()++"*.*")),
CtLog = filename:join(Dir,"ctlog.html"),
- Body = ["Log from last interactive run: <A HREF=\"",CtLog,"\">",
- timestamp(Dir),"</A>"],
+ Body = ["Log from last interactive run: <a href=\"",CtLog,"\">",
+ timestamp(Dir),"</a>"],
file:write_file("last_interactive.html",Body),
io:format("~n~nUpdated ~s\n"
"Any CT activities will be logged here\n",
[?abs("last_interactive.html")]).
-runentry(Dir, BasicHtml) ->
+runentry(Dir) ->
TotalsFile = filename:join(Dir,?totals_name),
TotalsStr =
case read_totals_file(TotalsFile) of
{Node,Label,Logs,{TotSucc,TotFail,UserSkip,AutoSkip,NotBuilt}} ->
TotFailStr =
if TotFail > 0 ->
- ["<FONT color=\"red\">",
- integer_to_list(TotFail),"</FONT>"];
+ ["<font color=\"red\">",
+ integer_to_list(TotFail),"</font>"];
true ->
integer_to_list(TotFail)
end,
@@ -1310,8 +1411,8 @@ runentry(Dir, BasicHtml) ->
if AutoSkip == undefined -> {UserSkip,"?","?"};
true ->
ASStr = if AutoSkip > 0 ->
- ["<FONT color=\"brown\">",
- integer_to_list(AutoSkip),"</FONT>"];
+ ["<font color=\"brown\">",
+ integer_to_list(AutoSkip),"</font>"];
true -> integer_to_list(AutoSkip)
end,
{UserSkip+AutoSkip,integer_to_list(UserSkip),ASStr}
@@ -1343,30 +1444,49 @@ runentry(Dir, BasicHtml) ->
lists:flatten(io_lib:format("~s...",[Trunc]))
end,
Total = TotSucc+TotFail+AllSkip,
- A = ["<TD ALIGN=center><FONT SIZE=-1>",Node,"</FONT></TD>\n",
- "<TD ALIGN=center><FONT SIZE=-1><B>",Label,"</B></FONT></TD>\n",
- "<TD ALIGN=right>",NoOfTests,"</TD>\n"],
- B = if BasicHtml ->
- ["<TD ALIGN=center><FONT SIZE=-1>",TestNamesTrunc,"</FONT></TD>\n"];
- true ->
- ["<TD ALIGN=center TITLE='",TestNames,"'><FONT SIZE=-1> ",
- TestNamesTrunc,"</FONT></TD>\n"]
- end,
- C = ["<TD ALIGN=right>",integer_to_list(Total),"</TD>\n",
- "<TD ALIGN=right>",integer_to_list(TotSucc),"</TD>\n",
- "<TD ALIGN=right>",TotFailStr,"</TD>\n",
- "<TD ALIGN=right>",integer_to_list(AllSkip),
- " (",UserSkipStr,"/",AutoSkipStr,")</TD>\n",
- "<TD ALIGN=right>",integer_to_list(NotBuilt),"</TD>\n"],
+ A = xhtml(["<td align=center><font size=\"-1\">",Node,
+ "</font></td>\n",
+ "<td align=center><font size=\"-1\"><b>",Label,
+ "</b></font></td>\n",
+ "<td align=right>",NoOfTests,"</td>\n"],
+ ["<td align=center>",Node,"</td>\n",
+ "<td align=center><b>",Label,"</b></td>\n",
+ "<td align=right>",NoOfTests,"</td>\n"]),
+ B = xhtml(["<td align=center title='",TestNames,"'><font size=\"-1\"> ",
+ TestNamesTrunc,"</font></td>\n"],
+ ["<td align=center title='",TestNames,"'> ",
+ TestNamesTrunc,"</td>\n"]),
+ C = ["<td align=right>",integer_to_list(Total),"</td>\n",
+ "<td align=right>",integer_to_list(TotSucc),"</td>\n",
+ "<td align=right>",TotFailStr,"</td>\n",
+ "<td align=right>",integer_to_list(AllSkip),
+ " (",UserSkipStr,"/",AutoSkipStr,")</td>\n",
+ "<td align=right>",integer_to_list(NotBuilt),"</td>\n"],
A++B++C;
_ ->
- ["<TD ALIGN=center><FONT size=-1 color=\"red\">",
- "Test data missing or corrupt","</FONT></TD>\n"]
+ A = xhtml(["<td align=center><font size=\"-1\" color=\"red\">"
+ "Test data missing or corrupt</font></td>\n",
+ "<td align=center><font size=\"-1\">?</font></td>\n",
+ "<td align=right>?</td>\n"],
+ ["<td align=center><font color=\"red\">"
+ "Test data missing or corrupt</font></td>\n",
+ "<td align=center>?</td>\n",
+ "<td align=right>?</td>\n"]),
+ B = xhtml(["<td align=center><font size=\"-1\">?</font></td>\n"],
+ ["<td align=center>?</td>\n"]),
+ C = ["<td align=right>?</td>\n",
+ "<td align=right>?</td>\n",
+ "<td align=right>?</td>\n",
+ "<td align=right>?</td>\n",
+ "<td align=right>?</td>\n"],
+ A++B++C
end,
Index = filename:join(Dir,?index_name),
- ["<TR>\n"
- "<TD><FONT SIZE=-1><A HREF=\"",Index,"\">",timestamp(Dir),"</A>",TotalsStr,"</FONT></TD>\n"
- "</TR>\n"].
+ [xhtml("<tr>\n", ["<tr class=\"",odd_or_even(),"\">\n"]),
+ xhtml(["<td><font size=\"-1\"><a href=\"",Index,"\">",timestamp(Dir),"</a>",
+ TotalsStr,"</font></td>\n"],
+ ["<td><a href=\"",Index,"\">",timestamp(Dir),"</a>",TotalsStr,"</td>\n"]),
+ "</tr>\n"].
write_totals_file(Name,Label,Logs,Totals) ->
AbsName = ?abs(Name),
@@ -1460,6 +1580,7 @@ timestamp(Dir) ->
%% Creates the top level index file. When == start | refresh.
%% A copy of the dir tree under logdir is cached as a result.
make_all_suites_index(When) when is_atom(When) ->
+ put(basic_html, basic_html()),
AbsIndexName = ?abs(?index_name),
notify_and_lock_file(AbsIndexName),
LogDirs = filelib:wildcard(logdir_prefix()++".*/*"++?logdir_ext),
@@ -1471,6 +1592,7 @@ make_all_suites_index(When) when is_atom(When) ->
%% This updates the top level index file using cached data from
%% the initial index file creation.
make_all_suites_index(NewTestData = {_TestName,DirName}) ->
+ put(basic_html, basic_html()),
%% AllLogDirs = [{TestName,Label,Missing,{LastLogDir,Summary},OldDirs}|...]
{AbsIndexName,LogDirData} = ct_util:get_testdata(test_index),
@@ -1828,6 +1950,38 @@ last_test([], Latest) ->
Latest.
%%%-----------------------------------------------------------------
+%%% @spec xhtml(HTML, XHTML) -> HTML | XHTML
+%%%
+%%% @doc
+%%%
+xhtml(HTML, XHTML) when is_function(HTML),
+ is_function(XHTML) ->
+ case get(basic_html) of
+ true -> HTML();
+ _ -> XHTML()
+ end;
+xhtml(HTML, XHTML) ->
+ case get(basic_html) of
+ true -> HTML;
+ _ -> XHTML
+ end.
+
+%%%-----------------------------------------------------------------
+%%% @spec odd_or_even() -> "odd" | "even"
+%%%
+%%% @doc
+%%%
+odd_or_even() ->
+ case get(odd_or_even) of
+ even ->
+ put(odd_or_even, odd),
+ "even";
+ _ ->
+ put(odd_or_even, even),
+ "odd"
+ end.
+
+%%%-----------------------------------------------------------------
%%% @spec basic_html() -> true | false
%%%
%%% @doc
@@ -1839,3 +1993,149 @@ basic_html() ->
_ ->
false
end.
+
+%%%-----------------------------------------------------------------
+%%% @spec locate_default_css_file() -> CSSFile
+%%%
+%%% @doc
+%%%
+locate_default_css_file() ->
+ {ok,CWD} = file:get_cwd(),
+ CSSFileInCwd = filename:join(CWD, ?css_default),
+ case filelib:is_file(CSSFileInCwd) of
+ true ->
+ CSSFileInCwd;
+ false ->
+ CSSResultFile =
+ case {whereis(?MODULE),self()} of
+ {Self,Self} ->
+ %% executed on the ct_logs process
+ filename:join(get(ct_run_dir), ?css_default);
+ _ ->
+ %% executed on other process than ct_logs
+ {ok,RunDir} = get_log_dir(true),
+ filename:join(RunDir, ?css_default)
+ end,
+ case filelib:is_file(CSSResultFile) of
+ true ->
+ CSSResultFile;
+ false ->
+ %% last resort, try use css file in CT installation
+ CTPath = code:lib_dir(common_test),
+ filename:join(filename:join(CTPath, "priv"), ?css_default)
+ end
+ end.
+
+%%%-----------------------------------------------------------------
+%%% @spec make_relative(AbsDir, Cwd) -> RelDir
+%%%
+%%% @doc Return directory path to File (last element of AbsDir), which
+%%% is the path relative to Cwd. Examples when Cwd == "/ldisk/test/logs":
+%%% make_relative("/ldisk/test/logs/run/trace.log") -> "run/trace.log"
+%%% make_relative("/ldisk/test/trace.log") -> "../trace.log"
+%%% make_relative("/ldisk/test/logs/trace.log") -> "trace.log"
+make_relative(AbsDir) ->
+ {ok,Cwd} = file:get_cwd(),
+ make_relative(AbsDir, Cwd).
+
+make_relative(AbsDir, Cwd) ->
+ DirTokens = filename:split(AbsDir),
+ CwdTokens = filename:split(Cwd),
+ filename:join(make_relative1(DirTokens, CwdTokens)).
+
+make_relative1([T | DirTs], [T | CwdTs]) ->
+ make_relative1(DirTs, CwdTs);
+make_relative1(Last = [_File], []) ->
+ Last;
+make_relative1(Last = [_File], CwdTs) ->
+ Ups = ["../" || _ <- CwdTs],
+ Ups ++ Last;
+make_relative1(DirTs, []) ->
+ DirTs;
+make_relative1(DirTs, CwdTs) ->
+ Ups = ["../" || _ <- CwdTs],
+ Ups ++ DirTs.
+
+%%%-----------------------------------------------------------------
+%%% @spec get_ts_html_wrapper(TestName, PrintLabel, Cwd) -> {Mode,Header,Footer}
+%%%
+%%% @doc
+%%%
+get_ts_html_wrapper(TestName, PrintLabel, Cwd) ->
+ TestName1 = if is_list(TestName) ->
+ lists:flatten(TestName);
+ true ->
+ lists:flatten(io_lib:format("~p", [TestName]))
+ end,
+ Basic = basic_html(),
+ LabelStr =
+ if not PrintLabel ->
+ "";
+ true ->
+ case {Basic,application:get_env(common_test, test_label)} of
+ {true,{ok,Lbl}} when Lbl =/= undefined ->
+ "<h1><font color=\"green\">" ++ Lbl ++ "</font></h1>\n";
+ {_,{ok,Lbl}} when Lbl =/= undefined ->
+ "<div class=\"label\">'" ++ Lbl ++ "'</div>\n";
+ _ ->
+ ""
+ end
+ end,
+ CTPath = code:lib_dir(common_test),
+ {ok,CtLogdir} = get_log_dir(true),
+ AllRuns = make_relative(filename:join(filename:dirname(CtLogdir),
+ ?all_runs_name), Cwd),
+ TestIndex = make_relative(filename:join(filename:dirname(CtLogdir),
+ ?index_name), Cwd),
+ case Basic of
+ true ->
+ TileFile = filename:join(filename:join(CTPath,"priv"),"tile1.jpg"),
+ Bgr = " background=\"" ++ TileFile ++ "\"",
+ Copyright =
+ ["<p><font size=\"-1\">\n",
+ "Copyright &copy; ", year(),
+ " <a href=\"http://www.erlang.org\">",
+ "Open Telecom Platform</a><br>\n",
+ "Updated: <!date>", current_time(), "<!/date>",
+ "<br>\n</font></p>\n"],
+ {basic_html,
+ ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n",
+ "<html>\n",
+ "<head><title>", TestName1, "</title>\n",
+ "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n",
+ "</head>\n",
+ "<body", Bgr, " bgcolor=\"white\" text=\"black\" ",
+ "link=\"blue\" vlink=\"purple\" alink=\"red\">\n",
+ LabelStr, "\n"],
+ ["<center>\n<br><hr><p>\n",
+ "<a href=\"", AllRuns,
+ "\">Test run history\n</a> | ",
+ "<a href=\"", TestIndex,
+ "\">Top level test index\n</a>\n</p>\n",
+ Copyright,"</center>\n</body>\n</html>\n"]};
+ _ ->
+ Copyright =
+ ["<div class=\"copyright\">",
+ "Copyright &copy; ", year(),
+ " <a href=\"http://www.erlang.org\">",
+ "Open Telecom Platform</a><br />\n",
+ "Updated: <!date>", current_time(), "<!/date>",
+ "<br />\n</div>\n"],
+ CSSFile = xhtml(fun() -> "" end,
+ fun() -> make_relative(locate_default_css_file(), Cwd) end),
+ {xhtml,
+ ["<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"\n",
+ "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n",
+ "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">\n",
+ "<head>\n<title>", TestName1, "</title>\n",
+ "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n",
+ "<link rel=\"stylesheet\" href=\"", CSSFile, "\" type=\"text/css\">",
+ "</head>\n","<body>\n",
+ LabelStr, "\n"],
+ ["<center>\n<br /><hr /><p>\n",
+ "<a href=\"", AllRuns,
+ "\">Test run history\n</a> | ",
+ "<a href=\"", TestIndex,
+ "\">Top level test index\n</a>\n</p>\n",
+ Copyright,"</center>\n</body>\n</html>\n"]}
+ end.
diff --git a/lib/common_test/src/ct_make.erl b/lib/common_test/src/ct_make.erl
index 40e9e99f37..8ddb91d355 100644
--- a/lib/common_test/src/ct_make.erl
+++ b/lib/common_test/src/ct_make.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009. All Rights Reserved.
+%% Copyright Ericsson AB 2009-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl
index 26ca4f3cb4..05b10bca32 100644
--- a/lib/common_test/src/ct_run.erl
+++ b/lib/common_test/src/ct_run.erl
@@ -57,6 +57,7 @@
config = [],
event_handlers = [],
ct_hooks = [],
+ enable_builtin_hooks = true,
include = [],
silent_connections,
stylesheet,
@@ -179,6 +180,10 @@ script_start1(Parent, Args) ->
end, false, Args),
EvHandlers = event_handler_args2opts(Args),
CTHooks = ct_hooks_args2opts(Args),
+ EnableBuiltinHooks = get_start_opt(enable_builtin_hooks,
+ fun([CT]) -> list_to_atom(CT);
+ ([]) -> true
+ end, true, Args),
%% check flags and set corresponding application env variables
@@ -245,6 +250,7 @@ script_start1(Parent, Args) ->
logdir = LogDir, logopts = LogOpts,
event_handlers = EvHandlers,
ct_hooks = CTHooks,
+ enable_builtin_hooks = EnableBuiltinHooks,
include = IncludeDirs,
silent_connections = SilentConns,
stylesheet = Stylesheet,
@@ -325,6 +331,11 @@ script_start2(StartOpts = #opts{vts = undefined,
AllCTHooks = merge_vals(
[StartOpts#opts.ct_hooks,
SpecStartOpts#opts.ct_hooks]),
+
+ EnableBuiltinHooks =
+ choose_val(
+ StartOpts#opts.enable_builtin_hooks,
+ SpecStartOpts#opts.enable_builtin_hooks),
AllInclude = merge_vals([StartOpts#opts.include,
SpecStartOpts#opts.include]),
@@ -339,6 +350,8 @@ script_start2(StartOpts = #opts{vts = undefined,
config = SpecStartOpts#opts.config,
event_handlers = AllEvHs,
ct_hooks = AllCTHooks,
+ enable_builtin_hooks =
+ EnableBuiltinHooks,
include = AllInclude,
multiply_timetraps = MultTT,
scale_timetraps = ScaleTT}}
@@ -355,9 +368,7 @@ script_start2(StartOpts = #opts{vts = undefined,
{[],_} ->
{error,no_testspec_specified};
{undefined,_} -> % no testspec used
- case check_and_install_configfiles(InitConfig, TheLogDir,
- Opts#opts.event_handlers,
- Opts#opts.ct_hooks) of
+ case check_and_install_configfiles(InitConfig, TheLogDir, Opts) of
ok -> % go on read tests from start flags
script_start3(Opts#opts{config=InitConfig,
logdir=TheLogDir}, Args);
@@ -367,9 +378,7 @@ script_start2(StartOpts = #opts{vts = undefined,
{_,_} -> % testspec used
%% merge config from start flags with config from testspec
AllConfig = merge_vals([InitConfig, Opts#opts.config]),
- case check_and_install_configfiles(AllConfig, TheLogDir,
- Opts#opts.event_handlers,
- Opts#opts.ct_hooks) of
+ case check_and_install_configfiles(AllConfig, TheLogDir, Opts) of
ok -> % read tests from spec
{Run,Skip} = ct_testspec:prepare_tests(Terms, node()),
do_run(Run, Skip, Opts#opts{config=AllConfig,
@@ -383,9 +392,7 @@ script_start2(StartOpts, Args) ->
%% read config/userconfig from start flags
InitConfig = ct_config:prepare_config_list(Args),
LogDir = which(logdir, StartOpts#opts.logdir),
- case check_and_install_configfiles(InitConfig, LogDir,
- StartOpts#opts.event_handlers,
- StartOpts#opts.ct_hooks) of
+ case check_and_install_configfiles(InitConfig, LogDir, StartOpts) of
ok -> % go on read tests from start flags
script_start3(StartOpts#opts{config=InitConfig,
logdir=LogDir}, Args);
@@ -393,12 +400,17 @@ script_start2(StartOpts, Args) ->
Error
end.
-check_and_install_configfiles(Configs, LogDir, EvHandlers, CTHooks) ->
+check_and_install_configfiles(
+ Configs, LogDir, #opts{
+ event_handlers = EvHandlers,
+ ct_hooks = CTHooks,
+ enable_builtin_hooks = EnableBuiltinHooks} ) ->
case ct_config:check_config_files(Configs) of
false ->
install([{config,Configs},
{event_handler,EvHandlers},
- {ct_hooks,CTHooks}], LogDir);
+ {ct_hooks,CTHooks},
+ {enable_builtin_hooks,EnableBuiltinHooks}], LogDir);
{value,{error,{nofile,File}}} ->
{error,{cant_read_config_file,File}};
{value,{error,{wrong_config,Message}}}->
@@ -490,23 +502,23 @@ script_start4(#opts{label = Label, profile = Profile,
shell = true, config = Config,
event_handlers = EvHandlers,
ct_hooks = CTHooks,
- logdir = LogDir,
logopts = LogOpts,
- testspecs = Specs}, _Args) ->
+ enable_builtin_hooks = EnableBuiltinHooks,
+ logdir = LogDir, testspecs = Specs}, _Args) ->
%% label - used by ct_logs
application:set_env(common_test, test_label, Label),
%% profile - used in ct_util
application:set_env(common_test, profile, Profile),
- InstallOpts = [{config,Config},{event_handler,EvHandlers},
- {ct_hooks, CTHooks}],
if Config == [] ->
ok;
true ->
io:format("\nInstalling: ~p\n\n", [Config])
end,
- case install(InstallOpts) of
+ case install([{config,Config},{event_handler,EvHandlers},
+ {ct_hooks, CTHooks},
+ {enable_builtin_hooks,EnableBuiltinHooks}]) of
ok ->
ct_util:start(interactive, LogDir),
ct_util:set_testdata({logopts, LogOpts}),
@@ -747,6 +759,11 @@ run_test2(StartOpts) ->
%% CT Hooks
CTHooks = get_start_opt(ct_hooks, value, [], StartOpts),
+ EnableBuiltinHooks = get_start_opt(enable_builtin_hooks,
+ fun(EBH) when EBH == true;
+ EBH == false ->
+ EBH
+ end, true, StartOpts),
%% silent connections
SilentConns = get_start_opt(silent_connections,
@@ -820,6 +837,7 @@ run_test2(StartOpts) ->
logopts = LogOpts, config = CfgFiles,
event_handlers = EvHandlers,
ct_hooks = CTHooks,
+ enable_builtin_hooks = EnableBuiltinHooks,
include = Include,
silent_connections = SilentConns,
stylesheet = Stylesheet,
@@ -878,26 +896,29 @@ run_spec_file(Relaxed,
AllCTHooks = merge_vals([Opts#opts.ct_hooks,
SpecOpts#opts.ct_hooks]),
+ EnableBuiltinHooks = choose_val(Opts#opts.enable_builtin_hooks,
+ SpecOpts#opts.enable_builtin_hooks),
application:set_env(common_test, include, AllInclude),
- case check_and_install_configfiles(AllConfig,
- which(logdir,LogDir),
- AllEvHs,
- AllCTHooks) of
+ Opts1 = Opts#opts{label = Label,
+ profile = Profile,
+ cover = Cover,
+ logdir = which(logdir, LogDir),
+ logopts = AllLogOpts,
+ config = AllConfig,
+ event_handlers = AllEvHs,
+ include = AllInclude,
+ testspecs = AbsSpecs,
+ multiply_timetraps = MultTT,
+ scale_timetraps = ScaleTT,
+ ct_hooks = AllCTHooks,
+ enable_builtin_hooks = EnableBuiltinHooks
+ },
+
+ case check_and_install_configfiles(AllConfig,Opts1#opts.logdir,
+ Opts1) of
ok ->
- Opts1 = Opts#opts{label = Label,
- profile = Profile,
- cover = Cover,
- logdir = which(logdir, LogDir),
- logopts = AllLogOpts,
- config = AllConfig,
- event_handlers = AllEvHs,
- include = AllInclude,
- testspecs = AbsSpecs,
- multiply_timetraps = MultTT,
- scale_timetraps = ScaleTT,
- ct_hooks = AllCTHooks},
{Run,Skip} = ct_testspec:prepare_tests(TS, node()),
reformat_result(catch do_run(Run, Skip, Opts1, StartOpts));
{error,GCFReason} ->
@@ -906,13 +927,10 @@ run_spec_file(Relaxed,
end.
run_prepared(Run, Skip, Opts = #opts{logdir = LogDir,
- config = CfgFiles,
- event_handlers = EvHandlers,
- ct_hooks = CTHooks},
+ config = CfgFiles },
StartOpts) ->
LogDir1 = which(logdir, LogDir),
- case check_and_install_configfiles(CfgFiles, LogDir1,
- EvHandlers, CTHooks) of
+ case check_and_install_configfiles(CfgFiles, LogDir1, Opts) of
ok ->
reformat_result(catch do_run(Run, Skip, Opts#opts{logdir = LogDir1},
StartOpts));
@@ -944,7 +962,8 @@ check_config_file(Callback, File)->
run_dir(Opts = #opts{logdir = LogDir,
config = CfgFiles,
event_handlers = EvHandlers,
- ct_hooks = CTHook }, StartOpts) ->
+ ct_hooks = CTHook,
+ enable_builtin_hooks = EnableBuiltinHooks }, StartOpts) ->
LogDir1 = which(logdir, LogDir),
Opts1 = Opts#opts{logdir = LogDir1},
AbsCfgFiles =
@@ -967,7 +986,8 @@ run_dir(Opts = #opts{logdir = LogDir,
end, CfgFiles),
case install([{config,AbsCfgFiles},
{event_handler,EvHandlers},
- {ct_hooks, CTHook}], LogDir1) of
+ {ct_hooks, CTHook},
+ {enable_builtin_hooks,EnableBuiltinHooks}], LogDir1) of
ok -> ok;
{error,IReason} -> exit(IReason)
end,
@@ -1125,9 +1145,8 @@ run_testspec2(TestSpec) ->
end,
application:set_env(common_test, include, AllInclude),
LogDir1 = which(logdir,Opts#opts.logdir),
- case check_and_install_configfiles(Opts#opts.config, LogDir1,
- Opts#opts.event_handlers,
- Opts#opts.ct_hooks) of
+ case check_and_install_configfiles(
+ Opts#opts.config, LogDir1, Opts) of
ok ->
Opts1 = Opts#opts{testspecs = [],
logdir = LogDir1,
@@ -1148,6 +1167,7 @@ get_data_for_node(#testspec{label = Labels,
userconfig = UsrCfgs,
event_handler = EvHs,
ct_hooks = CTHooks,
+ enable_builtin_hooks = EnableBuiltinHooks,
include = Incl,
multiply_timetraps = MTs,
scale_timetraps = STs}, Node) ->
@@ -1177,6 +1197,7 @@ get_data_for_node(#testspec{label = Labels,
config = ConfigFiles,
event_handlers = EvHandlers,
ct_hooks = FiltCTHooks,
+ enable_builtin_hooks = EnableBuiltinHooks,
include = Include,
multiply_timetraps = MT,
scale_timetraps = ST}.
@@ -1639,6 +1660,14 @@ final_tests1([{TestDir,Suite,GrsOrCs}|Tests], Final, Skip, Bad) when
({skipped,Group,TCs}) ->
[ct_framework:make_conf(TestDir, Suite,
Group, [skipped], TCs)];
+ ({GrSpec = {Group,_},TCs}) ->
+ Props = [{override,GrSpec}],
+ [ct_framework:make_conf(TestDir, Suite,
+ Group, Props, TCs)];
+ ({GrSpec = {Group,_,_},TCs}) ->
+ Props = [{override,GrSpec}],
+ [ct_framework:make_conf(TestDir, Suite,
+ Group, Props, TCs)];
({Group,TCs}) ->
[ct_framework:make_conf(TestDir, Suite,
Group, [], TCs)];
@@ -2254,8 +2283,11 @@ try_get_start_opt(Key, IfExists, IfNotExists, Args) ->
end.
ct_hooks_args2opts(Args) ->
- ct_hooks_args2opts(
- proplists:get_value(ct_hooks, Args, []),[]).
+ lists:foldl(fun({ct_hooks,Hooks}, Acc) ->
+ ct_hooks_args2opts(Hooks,Acc);
+ (_,Acc) ->
+ Acc
+ end,[],Args).
ct_hooks_args2opts([CTH,Arg,Prio,"and"| Rest],Acc) ->
ct_hooks_args2opts(Rest,[{list_to_atom(CTH),
diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl
index 71a784870c..f4a551e3ff 100644
--- a/lib/common_test/src/ct_telnet.erl
+++ b/lib/common_test/src/ct_telnet.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl
index 2cba1d8410..b68cbd3aa1 100644
--- a/lib/common_test/src/ct_testspec.erl
+++ b/lib/common_test/src/ct_testspec.erl
@@ -670,6 +670,10 @@ add_tests([{ct_hooks, _Node, []}|Ts], Spec) ->
add_tests([{ct_hooks, Hooks}|Ts], Spec) ->
add_tests([{ct_hooks, all_nodes, Hooks}|Ts], Spec);
+%% -- enable_builtin_hooks --
+add_tests([{enable_builtin_hooks,Bool}|Ts],Spec) ->
+ add_tests(Ts, Spec#testspec{ enable_builtin_hooks = Bool });
+
%% --- include ---
add_tests([{include,all_nodes,InclDirs}|Ts],Spec) ->
Tests = lists:map(fun(N) -> {include,N,InclDirs} end, list_nodes(Spec)),
@@ -874,7 +878,11 @@ separate([],_,_,_) ->
%% {Suite2,[GrOrCase21,GrOrCase22,...]},...]}
%% {{Node,Dir},[{Suite1,{skip,Cmt}},
%% {Suite2,[{GrOrCase21,{skip,Cmt}},GrOrCase22,...]},...]}
-%% GrOrCase = {GroupName,[Case1,Case2,...]} | Case
+%% GrOrCase = {GroupSpec,[Case1,Case2,...]} | Case
+%% GroupSpec = {GroupName,OverrideProps} |
+%% {GroupName,OverrideProps,SubGroupSpec}
+%% OverrideProps = Props | default
+%% SubGroupSpec = GroupSpec | []
insert_suites(Node,Dir,[S|Ss],Tests, MergeTests) ->
Tests1 = insert_cases(Node,Dir,S,all,Tests,MergeTests),
@@ -885,7 +893,7 @@ insert_suites(Node,Dir,S,Tests,MergeTests) ->
insert_suites(Node,Dir,[S],Tests,MergeTests).
insert_groups(Node,Dir,Suite,Group,Cases,Tests,MergeTests)
- when is_atom(Group) ->
+ when is_atom(Group); is_tuple(Group) ->
insert_groups(Node,Dir,Suite,[Group],Cases,Tests,MergeTests);
insert_groups(Node,Dir,Suite,Groups,Cases,Tests,false) when
((Cases == all) or is_list(Cases)) and is_list(Groups) ->
@@ -1130,6 +1138,7 @@ valid_terms() ->
{event_handler,4},
{ct_hooks,2},
{ct_hooks,3},
+ {enable_builtin_hooks,1},
{multiply_timetraps,2},
{multiply_timetraps,3},
{scale_timetraps,2},
diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl
index 73898fe371..bde832811a 100644
--- a/lib/common_test/src/ct_util.hrl
+++ b/lib/common_test/src/ct_util.hrl
@@ -39,6 +39,7 @@
userconfig=[],
event_handler=[],
ct_hooks=[],
+ enable_builtin_hooks=true,
include=[],
multiply_timetraps=[],
scale_timetraps=[],
diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl
new file mode 100644
index 0000000000..14663b7738
--- /dev/null
+++ b/lib/common_test/src/cth_log_redirect.erl
@@ -0,0 +1,111 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(cth_log_redirect).
+
+%%% @doc Common Test Framework functions handling test specifications.
+%%%
+%%% <p>This module redirects sasl and error logger info to common test log.</p>
+%%% @end
+
+
+%% CTH Callbacks
+-export([id/1, init/2, post_init_per_group/4, pre_end_per_group/3,
+ post_end_per_testcase/4]).
+
+%% Event handler Callbacks
+-export([init/1,
+ handle_event/2, handle_call/2, handle_info/2,
+ terminate/2]).
+
+id(_Opts) ->
+ ?MODULE.
+
+init(?MODULE, _Opts) ->
+ error_logger:add_report_handler(?MODULE),
+ tc_log.
+
+post_init_per_group(Group, Config, Result, tc_log) ->
+ case lists:member(parallel,proplists:get_value(
+ tc_group_properties,Config,[])) of
+ true ->
+ {Result, {set_log_func(ct_log),Group}};
+ false ->
+ {Result, tc_log}
+ end;
+post_init_per_group(_Group, _Config, Result, State) ->
+ {Result, State}.
+
+post_end_per_testcase(_TC, _Config, Result, State) ->
+ %% Make sure that the event queue is flushed
+ %% before ending this test case.
+ gen_event:call(error_logger, ?MODULE, flush),
+ {Result, State}.
+
+pre_end_per_group(Group, Config, {ct_log, Group}) ->
+ {Config, set_log_func(tc_log)};
+pre_end_per_group(_Group, Config, State) ->
+ {Config, State}.
+
+
+%% Copied and modified from sasl_report_tty_h.erl
+init(_Type) ->
+ {ok, tc_log}.
+
+handle_event({_Type, GL, _Msg}, State) when node(GL) /= node() ->
+ {ok, State};
+handle_event(Event, LogFunc) ->
+ case lists:keyfind(sasl, 1, application:which_applications()) of
+ false ->
+ sasl_not_started;
+ _Else ->
+ {ok, ErrLogType} = application:get_env(sasl, errlog_type),
+ SReport = sasl_report:format_report(group_leader(), ErrLogType,
+ tag_event(Event)),
+ if is_list(SReport) ->
+ ct_logs:LogFunc(sasl, SReport, []);
+ true -> %% Report is an atom if no logging is to be done
+ ignore
+ end
+ end,
+ EReport = error_logger_tty_h:write_event(
+ tag_event(Event),io_lib),
+ if is_list(EReport) ->
+ ct_logs:LogFunc(error_logger, EReport, []);
+ true -> %% Report is an atom if no logging is to be done
+ ignore
+ end,
+ {ok, LogFunc}.
+
+
+handle_info(_,State) -> {ok, State}.
+
+handle_call(flush,State) ->
+ {ok, ok, State};
+handle_call({set_logfunc,NewLogFunc},_) ->
+ {ok, NewLogFunc, NewLogFunc};
+handle_call(_Query, _State) -> {error, bad_query}.
+
+terminate(_Reason, _Type) ->
+ [].
+
+tag_event(Event) ->
+ {calendar:local_time(), Event}.
+
+set_log_func(Func) ->
+ gen_event:call(error_logger, ?MODULE, {set_logfunc, Func}).
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-08 21:57:13 +0000