From 9cf7d07947600ca53e9ace32cdbe4a2554688d51 Mon Sep 17 00:00:00 2001
From: Peter Andersson <peppe@erlang.org>
Date: Tue, 8 Jun 2010 02:55:45 +0200
Subject: Rewrite handling of group definitions in Common Test test suites
This is to enable execution of specific groups, and/or test cases within groups, by means of run_test options or test specifications.
---
lib/common_test/src/ct_framework.erl | 231 ++++++++++++++++++++++---------
lib/common_test/src/ct_run.erl | 59 ++++++--
lib/test_server/src/test_server_ctrl.erl | 25 +++-
3 files changed, 231 insertions(+), 84 deletions(-)
(limited to 'lib')
diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl
index 3dd1026f13..2a21985fdb 100644
--- a/lib/common_test/src/ct_framework.erl
+++ b/lib/common_test/src/ct_framework.erl
@@ -29,6 +29,8 @@
-export([error_in_suite/1, ct_init_per_group/2, ct_end_per_group/2]).
+-export([make_conf/5]).
+
-include("ct_event.hrl").
-include("ct_util.hrl").
@@ -101,7 +103,8 @@ init_tc1(Mod,Func,[Config0],DoInit) when is_list(Config0) ->
[{saved_config,{LastFunc,SavedConfig}} |
lists:keydelete(saved_config,1,Config0)];
{{LastSuite,InitOrEnd},SavedConfig} when InitOrEnd == init_per_suite ;
- InitOrEnd == end_per_suite -> % last suite
+ InitOrEnd == end_per_suite ->
+ %% last suite
[{saved_config,{LastSuite,SavedConfig}} |
lists:keydelete(saved_config,1,Config0)];
undefined ->
@@ -649,7 +652,7 @@ get_suite(Mod, all) ->
{'EXIT',_} ->
get_all(Mod, []);
GroupDefs when is_list(GroupDefs) ->
- case catch check_groups(Mod, GroupDefs) of
+ case catch find_groups(Mod, all, all, GroupDefs) of
{error,_} = Error ->
%% this makes test_server call error_in_suite as first
%% (and only) test case so we can report Error properly
@@ -664,102 +667,178 @@ get_suite(Mod, all) ->
%%!============================================================
%%! Note: The handling of sequences in get_suite/2 and get_all/2
-%%! is deprecated and should be removed after OTP R13!
+%%! is deprecated and should be removed at some point...
%%!============================================================
-get_suite(Mod, Name) ->
- %% Name may be name of a group or a test case. If it's a group,
- %% it should be expanded to list of cases (in a conf term)
+%% group
+get_suite(Mod, Group={conf,Props,_Init,TCs,_End}) ->
+ Name = proplists:get_value(name, Props),
case catch apply(Mod, groups, []) of
{'EXIT',_} ->
- get_seq(Mod, Name);
+ [Group];
GroupDefs when is_list(GroupDefs) ->
- case catch check_groups(Mod, GroupDefs) of
+ case catch find_groups(Mod, Name, TCs, GroupDefs) of
{error,_} = Error ->
%% this makes test_server call error_in_suite as first
%% (and only) test case so we can report Error properly
[{?MODULE,error_in_suite,[[Error]]}];
ConfTests ->
-
- %%! --- Thu Jun 3 19:13:22 2010 --- peppe was here!
- %%! HEERE!
- %%! Must be able to search recursively for group Name,
- %%! this only handles top level groups!
-
- FindConf = fun({conf,Props,_,_,_}) ->
- case proplists:get_value(name, Props) of
- Name -> true;
- _ -> false
- end
- end,
- case lists:filter(FindConf, ConfTests) of
- [] -> % must be a test case
- get_seq(Mod, Name);
- [ConfTest|_] ->
- ConfTest
- end
+ ConfTests
end;
_ ->
E = "Bad return value from "++atom_to_list(Mod)++":groups/0",
[{?MODULE,error_in_suite,[[{error,list_to_atom(E)}]]}]
- end.
+ end;
-check_groups(_Mod, []) ->
- [];
-check_groups(Mod, Defs) ->
- check_groups(Mod, Defs, Defs, []).
+%% testcase
+get_suite(Mod, Name) ->
+ get_seq(Mod, Name).
-check_groups(Mod, [TC | Gs], Defs, Levels) when is_atom(TC), length(Levels)>0 ->
- [TC | check_groups(Mod, Gs, Defs, Levels)];
+%%%-----------------------------------------------------------------
-check_groups(Mod, [{group,SubName} | Gs], Defs, Levels) when is_atom(SubName) ->
- case lists:member(SubName, Levels) of
- true ->
- E = "Cyclic reference to group "++atom_to_list(SubName)++
- " in "++atom_to_list(Mod)++":groups/0",
- throw({error,list_to_atom(E)});
- false ->
- case find_group(Mod, SubName, Defs) of
- {error,_} = Error ->
- throw(Error);
- G ->
- [check_groups(Mod, [G], Defs, Levels) |
- check_groups(Mod, Gs, Defs, Levels)]
- end
+find_groups(Mod, Name, TCs, GroupDefs) ->
+ Found = find(Mod, Name, TCs, GroupDefs, [], GroupDefs, false),
+ Trimmed = trim(Found),
+ delete_subs(Trimmed, Trimmed).
+
+find(Mod, all, _TCs, [{Name,Props,Tests} | Gs], Known, Defs, _) ->
+ cyclic_test(Mod, Name, Known),
+ [make_conf(Mod, Name, Props,
+ find(Mod, all, all, Tests, [Name | Known], Defs, true)) |
+ find(Mod, all, all, Gs, [], Defs, true)];
+
+find(Mod, Name, TCs, [{Name,Props,Tests} | _Gs], Known, Defs, false)
+ when is_atom(Name), is_list(Props), is_list(Tests) ->
+ cyclic_test(Mod, Name, Known),
+ case TCs of
+ all ->
+ [make_conf(Mod, Name, Props,
+ find(Mod, Name, TCs, Tests, [Name | Known], Defs, true))];
+ _ ->
+ Tests1 = [TC || TC <- TCs,
+ lists:member(TC, Tests) == true],
+ [make_conf(Mod, Name, Props, Tests1)]
end;
-check_groups(Mod, [{Name,Tests} | Gs], Defs, Levels) when is_atom(Name),
- is_list(Tests) ->
- check_groups(Mod, [{Name,[],Tests} | Gs], Defs, Levels);
-
-check_groups(Mod, [{Name,Props,Tests} | Gs], Defs, Levels) when is_atom(Name),
- is_list(Props),
- is_list(Tests) ->
- {TestSpec,Levels1} =
- case Levels of
- [] ->
- {check_groups(Mod, Tests, Defs, [Name]),[]};
- _ ->
- {check_groups(Mod, Tests, Defs, [Name|Levels]),Levels}
- end,
- [make_conf(Mod, Name, Props, TestSpec) |
- check_groups(Mod, Gs, Defs, Levels1)];
+find(Mod, Name, TCs, [{Name1,Props,Tests} | Gs], Known, Defs, false)
+ when is_atom(Name1), is_list(Props), is_list(Tests) ->
+ cyclic_test(Mod, Name1, Known),
+ [make_conf(Mod, Name1, Props,
+ find(Mod, Name, TCs, Tests, [Name1 | Known], Defs, false)) |
+ find(Mod, Name, TCs, Gs, [], Defs, false)];
+
+find(Mod, Name, _TCs, [{Name,_Props,_Tests} | _Gs], _Known, _Defs, true)
+ when is_atom(Name) ->
+ E = "Duplicate groups named "++atom_to_list(Name)++" in "++
+ atom_to_list(Mod)++":groups/0",
+ throw({error,list_to_atom(E)});
+
+find(Mod, Name, all, [{Name1,Props,Tests} | Gs], Known, Defs, true)
+ when is_atom(Name1), is_list(Props), is_list(Tests) ->
+ cyclic_test(Mod, Name1, Known),
+ [make_conf(Mod, Name1, Props,
+ find(Mod, Name, all, Tests, [Name1 | Known], Defs, true)) |
+ find(Mod, Name, all, Gs, [], Defs, true)];
+
+find(Mod, Name, TCs, [{group,Name1} | Gs], Known, Defs, Found) when is_atom(Name1) ->
+ find(Mod, Name, TCs, [expand(Mod, Name1, Defs) | Gs], Known, Defs, Found);
+
+find(Mod, Name, TCs, [{Name1,Tests} | Gs], Known, Defs, Found)
+ when is_atom(Name1), is_list(Tests) ->
+ find(Mod, Name, TCs, [{Name1,[],Tests} | Gs], Known, Defs, Found);
+
+find(Mod, Name, TCs, [TC | Gs], Known, Defs, false) when is_atom(TC) ->
+ find(Mod, Name, TCs, Gs, Known, Defs, false);
+
+find(Mod, Name, TCs, [TC | Gs], Known, Defs, true) when is_atom(TC) ->
+ [TC | find(Mod, Name, TCs, Gs, Known, Defs, true)];
-check_groups(Mod, [BadTerm | _Gs], _Defs, Levels) ->
- Where = if length(Levels) == 0 ->
+find(Mod, _Name, _TCs, [BadTerm | _Gs], Known, _Defs, _Found) ->
+ Where = if length(Known) == 0 ->
atom_to_list(Mod)++":groups/0";
true ->
- "group "++atom_to_list(lists:last(Levels))++
+ "group "++atom_to_list(lists:last(Known))++
" in "++atom_to_list(Mod)++":groups/0"
end,
Term = io_lib:format("~p", [BadTerm]),
E = "Bad term "++lists:flatten(Term)++" in "++Where,
throw({error,list_to_atom(E)});
-check_groups(_Mod, [], _Defs, _) ->
+find(_Mod, _Name, _TCs, [], _Known, _Defs, false) ->
+ ['$NOMATCH'];
+
+find(_Mod, _Name, _TCs, [], _Known, _Defs, _Found) ->
[].
-find_group(Mod, Name, Defs) ->
+delete_subs([Conf | Confs], All) ->
+ All1 = delete_conf(Conf, All),
+ case is_sub(Conf, All1) of
+ true ->
+ delete_subs(Confs, All1);
+ false ->
+ delete_subs(Confs, All)
+ end;
+
+delete_subs([], All) ->
+ All.
+
+delete_conf({conf,Props,_,_,_}, Confs) ->
+ Name = proplists:get_value(name, Props),
+ [Conf || Conf = {conf,Props0,_,_,_} <- Confs,
+ Name =/= proplists:get_value(name, Props0)].
+
+is_sub({conf,Props,_,_,_}=Conf, [{conf,_,_,Tests,_} | Confs]) ->
+ Name = proplists:get_value(name, Props),
+ case lists:any(fun({conf,Props0,_,_,_}) ->
+ case proplists:get_value(name, Props0) of
+ N when N == Name ->
+ true;
+ _ ->
+ false
+ end;
+ (_) ->
+ false
+ end, Tests) of
+ true ->
+ true;
+ false ->
+ is_sub(Conf, Tests) or is_sub(Conf, Confs)
+ end;
+
+is_sub(Conf, [_TC | Tests]) ->
+ is_sub(Conf, Tests);
+
+is_sub(_Conf, []) ->
+ false.
+
+trim(['$NOMATCH' | Tests]) ->
+ trim(Tests);
+
+trim([{conf,Props,Init,Tests,End} | Confs]) ->
+ case trim(Tests) of
+ [] ->
+ trim(Confs);
+ Trimmed ->
+ [{conf,Props,Init,Trimmed,End} | trim(Confs)]
+ end;
+
+trim([TC | Tests]) ->
+ [TC | trim(Tests)];
+
+trim([]) ->
+ [].
+
+cyclic_test(Mod, Name, Names) ->
+ case lists:member(Name, Names) of
+ true ->
+ E = "Cyclic reference to group "++atom_to_list(Name)++
+ " in "++atom_to_list(Mod)++":groups/0",
+ throw({error,list_to_atom(E)});
+ false ->
+ ok
+ end.
+
+expand(Mod, Name, Defs) ->
case lists:keysearch(Name, 1, Defs) of
{value,Def} ->
Def;
@@ -769,7 +848,22 @@ find_group(Mod, Name, Defs) ->
throw({error,list_to_atom(E)})
end.
+make_conf(Dir, Mod, Name, Props, TestSpec) ->
+ case code:is_loaded(Mod) of
+ false ->
+ code:load_abs(filename:join(Dir,atom_to_list(Mod)));
+ _ ->
+ ok
+ end,
+ make_conf(Mod, Name, Props, TestSpec).
+
make_conf(Mod, Name, Props, TestSpec) ->
+ case code:is_loaded(Mod) of
+ false ->
+ code:load_file(Mod);
+ _ ->
+ ok
+ end,
{InitConf,EndConf} =
case erlang:function_exported(Mod,init_per_group,2) of
true ->
@@ -780,6 +874,7 @@ make_conf(Mod, Name, Props, TestSpec) ->
end,
{conf,[{name,Name}|Props],InitConf,TestSpec,EndConf}.
+%%%-----------------------------------------------------------------
get_all(Mod, ConfTests) ->
case catch apply(Mod, all, []) of
diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl
index 6a9c42d1b9..28fc5ceb74 100644
--- a/lib/common_test/src/ct_run.erl
+++ b/lib/common_test/src/ct_run.erl
@@ -1354,17 +1354,31 @@ final_tests([{TestDir,Suite,Cases}|Tests],
Final, Skip, Bad) when Cases==[]; Cases==all ->
final_tests([{TestDir,[Suite],all}|Tests], Final, Skip, Bad);
-final_tests([{TestDir,Suite,Cases}|Tests], Final, Skip, Bad) ->
+final_tests([{TestDir,Suite,Groups}|Tests], Final, Skip, Bad) when
+ is_atom(element(1,hd(Groups))) ->
+ Confs =
+ lists:map(fun({Group,TCs}) ->
+ ct_framework:make_conf(TestDir, Suite,
+ Group, [], TCs)
+ end, Groups),
+ Do = {TestDir,Suite,Confs},
case lists:keymember({TestDir,Suite}, 1, Bad) of
false ->
- Do = {TestDir,Suite,Cases},
final_tests(Tests, [Do|Final], Skip, Bad);
true ->
- Do = {TestDir,Suite,Cases},
- Skip1 = Skip ++ [{TestDir,Suite,Cases,"Make failed"}],
+ Skip1 = Skip ++ [{TestDir,Suite,Confs,"Make failed"}],
final_tests(Tests, [Do|Final], Skip1, Bad)
end;
+final_tests([Do={TestDir,Suite,Cases}|Tests], Final, Skip, Bad) ->
+ case lists:keymember({TestDir,Suite}, 1, Bad) of
+ true ->
+ Skip1 = Skip ++ [{TestDir,Suite,Cases,"Make failed"}],
+ final_tests(Tests, [Do|Final], Skip1, Bad);
+ false ->
+ final_tests(Tests, [Do|Final], Skip, Bad)
+ end;
+
final_tests([], Final, Skip, _Bad) ->
{lists:reverse(Final),Skip}.
@@ -1604,13 +1618,36 @@ add_jobs([{TestDir,Suite,all}|Tests], Skip, Opts, CleanUp) ->
Error
end;
-%% group
-add_jobs([{TestDir,Suite,[{GroupName,_Cases}]}|Tests], Skip, Opts, CleanUp) when
- is_atom(GroupName) ->
- add_jobs([{TestDir,Suite,GroupName}|Tests], Skip, Opts, CleanUp);
-add_jobs([{TestDir,Suite,{GroupName,_Cases}}|Tests], Skip, Opts, CleanUp) when
- is_atom(GroupName) ->
- add_jobs([{TestDir,Suite,GroupName}|Tests], Skip, Opts, CleanUp);
+%% group (= conf case in test_server)
+add_jobs([{TestDir,Suite,Confs}|Tests], Skip, Opts, CleanUp) when
+ element(1, hd(Confs)) == conf ->
+ Group = fun(Conf) -> proplists:get_value(name, element(2, Conf)) end,
+ TestCases = fun(Conf) -> element(4, Conf) end,
+ TCTestName = fun(all) -> "";
+ ([C]) when is_atom(C) -> "." ++ atom_to_list(C);
+ (Cs) when is_list(Cs) -> ".cases"
+ end,
+ GrTestName =
+ case Confs of
+ [Conf] ->
+ "." ++ atom_to_list(Group(Conf)) ++ TCTestName(TestCases(Conf));
+ _ ->
+ ".groups"
+ end,
+ TestName = get_name(TestDir) ++ "." ++ atom_to_list(Suite) ++ GrTestName,
+ case maybe_interpret(Suite, init_per_group, Opts) of
+ ok ->
+ case catch test_server_ctrl:add_conf_with_skip(TestName, Suite, Confs,
+ skiplist(TestDir,Skip)) of
+ {'EXIT',_} ->
+ CleanUp;
+ _ ->
+ wait_for_idle(),
+ add_jobs(Tests, Skip, Opts, [Suite|CleanUp])
+ end;
+ Error ->
+ Error
+ end;
%% test case
add_jobs([{TestDir,Suite,[Case]}|Tests], Skip, Opts, CleanUp) when is_atom(Case) ->
diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl
index 1245c10a01..d1f53f3c39 100644
--- a/lib/test_server/src/test_server_ctrl.erl
+++ b/lib/test_server/src/test_server_ctrl.erl
@@ -151,10 +151,12 @@
%%% OPERATOR INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([add_spec/1, add_dir/2, add_dir/3]).
--export([add_module/1, add_module/2, add_case/2, add_case/3, add_cases/2,
- add_cases/3]).
+-export([add_module/1, add_module/2,
+ add_conf/3,
+ add_case/2, add_case/3, add_cases/2, add_cases/3]).
-export([add_dir_with_skip/3, add_dir_with_skip/4, add_tests_with_skip/3]).
-export([add_module_with_skip/2, add_module_with_skip/3,
+ add_conf_with_skip/4,
add_case_with_skip/3, add_case_with_skip/4,
add_cases_with_skip/3, add_cases_with_skip/4]).
-export([jobs/0, run_test/1, wait_finish/0, idle_notify/1,
@@ -236,9 +238,16 @@ add_dir(Name, Dir, Pattern) ->
add_module(Mod) when is_atom(Mod) ->
add_job(atom_to_list(Mod), {Mod,all}).
+
add_module(Name, Mods) when is_list(Mods) ->
add_job(cast_to_list(Name), lists:map(fun(Mod) -> {Mod,all} end, Mods)).
+add_conf(Name, Mod, Conf) when is_tuple(Conf) ->
+ add_job(cast_to_list(Name), {Mod,[Conf]});
+
+add_conf(Name, Mod, Confs) when is_list(Confs) ->
+ add_job(cast_to_list(Name), {Mod,Confs}).
+
add_case(Mod, Case) when is_atom(Mod), is_atom(Case) ->
add_job(atom_to_list(Mod), {Mod,Case}).
@@ -283,6 +292,12 @@ add_module_with_skip(Mod, Skip) when is_atom(Mod) ->
add_module_with_skip(Name, Mods, Skip) when is_list(Mods) ->
add_job(cast_to_list(Name), lists:map(fun(Mod) -> {Mod,all} end, Mods), Skip).
+add_conf_with_skip(Name, Mod, Conf, Skip) when is_tuple(Conf) ->
+ add_job(cast_to_list(Name), {Mod,[Conf]}, Skip);
+
+add_conf_with_skip(Name, Mod, Confs, Skip) when is_list(Confs) ->
+ add_job(cast_to_list(Name), {Mod,Confs}, Skip).
+
add_case_with_skip(Mod, Case, Skip) when is_atom(Mod), is_atom(Case) ->
add_job(atom_to_list(Mod), {Mod,Case}, Skip).
@@ -1549,7 +1564,7 @@ temp_nodename([Chr|Base], Acc) ->
%% of cases can not be calculated and NoOfCases = unknown.
count_test_cases(TopCases, SkipCases) when is_list(TopCases) ->
case collect_all_cases(TopCases, SkipCases) of
- {error,_} ->
+ {error,_Why} ->
error;
TestSpec ->
{get_suites(TestSpec, []),
@@ -4517,8 +4532,8 @@ collect_cases({_Mod,_Case,_Args}=Spec, St) ->
collect_case(Spec, St);
collect_cases(Case, St) when is_atom(Case), is_atom(St#cc.mod) ->
collect_case({St#cc.mod,Case}, St);
-collect_cases(Other, _St) ->
- {error,{bad_subtest_spec,Other}}.
+collect_cases(Other, St) ->
+ {error,{bad_subtest_spec,St#cc.mod,Other}}.
collect_case(MFA, St) ->
case in_skip_list(MFA, St#cc.skip) of
--
cgit v1.2.3