diff options
Diffstat (limited to 'lib/common_test/src/ct_framework.erl')
| -rw-r--r-- | lib/common_test/src/ct_framework.erl | 299 |
1 files changed, 232 insertions, 67 deletions
diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 3dd1026f13..f2ca023cff 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -27,8 +27,12 @@ -export([init_tc/3, end_tc/3, get_suite/2, report/2, warn/1]). -export([error_notification/4]). +-export([overview_html_header/1]). + -export([error_in_suite/1, ct_init_per_group/2, ct_end_per_group/2]). +-export([make_all_conf/3, make_conf/5]). + -include("ct_event.hrl"). -include("ct_util.hrl"). @@ -101,7 +105,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 +654,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 +669,193 @@ 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]]}]; + [] -> + {error,{invalid_group_spec,Name}}; 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 + case lists:member(skipped, Props) of + true -> + %% 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 + Name -> % top group + ConfTests; + _ -> + [] + end; + false -> + ConfTests end 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); -check_groups(Mod, [BadTerm | _Gs], _Defs, Levels) -> - Where = if length(Levels) == 0 -> +find(Mod, Name, TCs, [TC | Gs], Known, Defs, true) when is_atom(TC) -> + [TC | find(Mod, Name, TCs, Gs, Known, Defs, true)]; + +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) -> + []. + +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([]) -> []. -find_group(Mod, Name, Defs) -> +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 +865,48 @@ find_group(Mod, Name, Defs) -> throw({error,list_to_atom(E)}) end. +make_all_conf(Dir, Mod, _Props) -> + case code:is_loaded(Mod) of + false -> + code:load_abs(filename:join(Dir,atom_to_list(Mod))); + _ -> + ok + end, + make_all_conf(Mod). + +make_all_conf(Mod) -> + case catch apply(Mod, groups, []) of + {'EXIT',_} -> + {error,{invalid_group_definition,Mod}}; + GroupDefs when is_list(GroupDefs) -> + 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 + [{?MODULE,error_in_suite,[[Error]]}]; + [] -> + {error,{invalid_group_spec,Mod}}; + ConfTests -> + [{conf,Props,Init,all,End} || {conf,Props,Init,_,End} <- ConfTests] + end + 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 +917,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 @@ -1095,4 +1233,31 @@ add_data_dir(File,Config) when is_list(File) -> File end. +%%%----------------------------------------------------------------- +%%% @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"]. |