diff options
author | Peter Andersson <[email protected]> | 2010-06-08 02:55:45 +0200 |
---|---|---|
committer | Peter Andersson <[email protected]> | 2010-07-06 02:44:26 +0200 |
commit | 9cf7d07947600ca53e9ace32cdbe4a2554688d51 (patch) | |
tree | fea15760928e421f2a6ccc871a2c4d673490e38d | |
parent | fdf51bf4a7127883705d71dab1bbd4556b28e05a (diff) | |
download | otp-9cf7d07947600ca53e9ace32cdbe4a2554688d51.tar.gz otp-9cf7d07947600ca53e9ace32cdbe4a2554688d51.tar.bz2 otp-9cf7d07947600ca53e9ace32cdbe4a2554688d51.zip |
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.
-rw-r--r-- | lib/common_test/src/ct_framework.erl | 231 | ||||
-rw-r--r-- | lib/common_test/src/ct_run.erl | 59 | ||||
-rw-r--r-- | lib/test_server/src/test_server_ctrl.erl | 25 |
3 files changed, 231 insertions, 84 deletions
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 |