Skip to content

Commit

Permalink
Rewrite handling of group definitions in Common Test test suites
Browse files Browse the repository at this point in the history 
This is to enable execution of specific groups, and/or test cases within groups, by means of run_test options or test specifications.
  • Loading branch information
Peter Andersson committed Jul 6, 2010
1 parent fdf51bf commit 9cf7d07
Show file tree
Hide file tree
Showing 3 changed files with 231 additions and 84 deletions.
231 changes: 163 additions & 68 deletions lib/common_test/src/ct_framework.erl
View file
Expand Up @@ -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").

Expand Down Expand Up @@ -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 ->
Expand Down Expand Up @@ -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
Expand All @@ -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;
Expand All @@ -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 ->
Expand All @@ -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
Expand Down
59 changes: 48 additions & 11 deletions lib/common_test/src/ct_run.erl
View file
Expand Up @@ -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}.

Expand Down Expand Up @@ -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) ->
Expand Down

0 comments on commit 9cf7d07

Please sign in to comment.