diff options
Diffstat (limited to 'lib/common_test/src')
| -rw-r--r-- | lib/common_test/src/Makefile | 7 | ||||
| -rw-r--r-- | lib/common_test/src/ct.erl | 8 | ||||
| -rw-r--r-- | lib/common_test/src/ct_config.erl | 5 | ||||
| -rw-r--r-- | lib/common_test/src/ct_conn_log_h.erl | 6 | ||||
| -rw-r--r-- | lib/common_test/src/ct_cover.erl | 32 | ||||
| -rw-r--r-- | lib/common_test/src/ct_framework.erl | 368 | ||||
| -rw-r--r-- | lib/common_test/src/ct_groups.erl | 599 | ||||
| -rw-r--r-- | lib/common_test/src/ct_master.erl | 2 | ||||
| -rw-r--r-- | lib/common_test/src/ct_master_logs.erl | 2 | ||||
| -rw-r--r-- | lib/common_test/src/ct_netconfc.erl | 41 | ||||
| -rw-r--r-- | lib/common_test/src/ct_run.erl | 196 | ||||
| -rw-r--r-- | lib/common_test/src/ct_slave.erl | 67 | ||||
| -rw-r--r-- | lib/common_test/src/ct_testspec.erl | 28 | ||||
| -rw-r--r-- | lib/common_test/src/ct_util.hrl | 1 | ||||
| -rw-r--r-- | lib/common_test/src/cth_conn_log.erl | 2 | ||||
| -rw-r--r-- | lib/common_test/src/cth_log_redirect.erl | 2 | ||||
| -rw-r--r-- | lib/common_test/src/cth_surefire.erl | 183 |
17 files changed, 1052 insertions, 497 deletions
diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index f7dce195d7..eb35a43d99 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -73,7 +73,8 @@ MODULES= \ cth_surefire \ ct_netconfc \ ct_conn_log_h \ - cth_conn_log + cth_conn_log \ + ct_groups TARGET_MODULES= $(MODULES:%=$(EBIN)/%) BEAM_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) @@ -126,10 +127,10 @@ clean: # Special Build Targets # ---------------------------------------------------- $(APP_TARGET): $(APP_SRC) ../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ + $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ + $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ # ---------------------------------------------------- # Release Target diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index 5014309c0f..8eafdff29f 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -148,7 +148,7 @@ run(TestDirs) -> %%% {config,CfgFiles} | {userconfig, UserConfig} | %%% {allow_user_terms,Bool} | {logdir,LogDir} | %%% {silent_connections,Conns} | {stylesheet,CSSFile} | -%%% {cover,CoverSpecFile} | {step,StepOpts} | +%%% {cover,CoverSpecFile} | {cover_stop,Bool} | {step,StepOpts} | %%% {event_handler,EventHandlers} | {include,InclDirs} | %%% {auto_compile,Bool} | {create_priv_dir,CreatePrivDir} | %%% {multiply_timetraps,M} | {scale_timetraps,Bool} | @@ -161,7 +161,8 @@ run(TestDirs) -> %%% TestDirs = [string()] | string() %%% Suites = [string()] | [atom()] | string() | atom() %%% Cases = [atom()] | atom() -%%% Groups = [atom()] | atom() +%%% Groups = GroupNameOrPath | [GroupNameOrPath] +%%% GroupNameOrPath = [atom()] | atom() | all %%% TestSpecs = [string()] | string() %%% Label = string() | atom() %%% CfgFiles = [string()] | string() @@ -987,8 +988,9 @@ get_testdata(Key) -> end. %%%----------------------------------------------------------------- -%%% @spec abort_current_testcase(Reason) -> ok | {error,no_testcase_running} +%%% @spec abort_current_testcase(Reason) -> ok | {error,ErrorReason} %%% Reason = term() +%%% ErrorReason = no_testcase_running | parallel_group %%% %%% @doc <p>When calling this function, the currently executing test case will be aborted. %%% It is the user's responsibility to know for sure which test case is currently diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl index 30bf5925c0..b1d709bc75 100644 --- a/lib/common_test/src/ct_config.erl +++ b/lib/common_test/src/ct_config.erl @@ -171,7 +171,7 @@ process_default_configs(Opts) -> lists:flatmap(fun({config,[_|_] = FileOrFiles}) -> case {io_lib:printable_list(FileOrFiles), io_lib:printable_list(hd(FileOrFiles))} of - {true,true} -> + {false,true} -> FileOrFiles; {true,false} -> [FileOrFiles]; @@ -532,7 +532,8 @@ do_require(Name,Key) -> case get_key_from_name(Name) of {error,_} -> allocate(Name,Key); - {ok,Key} -> + {ok,NameKey} when NameKey == Key; + is_tuple(Key) andalso element(1,Key) == NameKey -> %% already allocated - check that it has all required subkeys R = make_ref(), case get_config(Key,R,[]) of diff --git a/lib/common_test/src/ct_conn_log_h.erl b/lib/common_test/src/ct_conn_log_h.erl index bf27238121..d7bd18606b 100644 --- a/lib/common_test/src/ct_conn_log_h.erl +++ b/lib/common_test/src/ct_conn_log_h.erl @@ -64,10 +64,16 @@ do_open_files([],Acc) -> handle_event({_Type, GL, _Msg}, State) when node(GL) /= node() -> {ok, State}; handle_event({_Type,_GL,{Pid,{ct_connection,Action,ConnName},Report}},State) -> + %% NOTE: if the format of this event is changed + %% ({ct_connection,Action,ConnName}) then remember to change + %% test_server_h:report_receiver as well!!! Info = conn_info(Pid,#conn_log{name=ConnName,action=Action}), write_report(now(),Info,Report,State), {ok, State}; handle_event({_Type,_GL,{Pid,Info=#conn_log{},Report}},State) -> + %% NOTE: if the format of this event is changed + %% (Info=#conn_log{}) then remember to change + %% test_server_h:report_receiver as well!!! write_report(now(),conn_info(Pid,Info),Report,State), {ok, State}; handle_event({error_report,_,{Pid,_,[{ct_connection,ConnName}|R]}},State) -> diff --git a/lib/common_test/src/ct_cover.erl b/lib/common_test/src/ct_cover.erl index d39f50ba00..ae671c750a 100644 --- a/lib/common_test/src/ct_cover.erl +++ b/lib/common_test/src/ct_cover.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% Copyright Ericsson AB 2006-2012. 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 @@ -24,7 +24,7 @@ -module(ct_cover). --export([get_spec/1, add_nodes/1, remove_nodes/1]). +-export([get_spec/1, add_nodes/1, remove_nodes/1, cross_cover_analyse/2]). -include("ct_util.hrl"). @@ -100,6 +100,22 @@ remove_nodes(Nodes) -> %%%----------------------------------------------------------------- +%%% @spec cross_cover_analyse(Level,Tests) -> ok +%%% Level = overview | details +%%% Tests = [{Tag,Dir}] +%%% Tag = atom() +%%% Dir = string() +%%% +%%% @doc Accumulate cover results over multiple tests. +%%% See the chapter about <seealso +%%% marker="cover_chapter#cross_cover">cross cover +%%% analysis</seealso> in the users's guide. +%%% +cross_cover_analyse(Level,Tests) -> + test_server_ctrl:cross_cover_analyse(Level,Tests). + + +%%%----------------------------------------------------------------- %%% @hidden %% Read cover specification file and return the parsed info. @@ -249,9 +265,11 @@ get_app_info(App=#cover{app=Name}, [{excl_mods,Name,Mods1}|Terms]) -> Mods = App#cover.excl_mods, get_app_info(App#cover{excl_mods=Mods++Mods1},Terms); -get_app_info(App=#cover{app=Name}, [{cross_apps,Name,AppMods1}|Terms]) -> - AppMods = App#cover.cross, - get_app_info(App#cover{cross=AppMods++AppMods1},Terms); +get_app_info(App=#cover{app=none}, [{cross,Cross}|Terms]) -> + get_app_info(App, [{cross,none,Cross}|Terms]); +get_app_info(App=#cover{app=Name}, [{cross,Name,Cross1}|Terms]) -> + Cross = App#cover.cross, + get_app_info(App#cover{cross=Cross++Cross1},Terms); get_app_info(App=#cover{app=none}, [{src_dirs,Dirs}|Terms]) -> get_app_info(App, [{src_dirs,none,Dirs}|Terms]); @@ -354,10 +372,10 @@ remove_excludes_and_dups(CoverData=#cover{excl_mods=Excl,incl_mods=Incl}) -> files2mods(Info=#cover{excl_mods=ExclFs, incl_mods=InclFs, - cross=CrossFs}) -> + cross=Cross}) -> Info#cover{excl_mods=files2mods1(ExclFs), incl_mods=files2mods1(InclFs), - cross=files2mods1(CrossFs)}. + cross=[{Tag,files2mods1(Fs)} || {Tag,Fs} <- Cross]}. files2mods1([M|Fs]) when is_atom(M) -> [M|files2mods1(Fs)]; diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index bec3368869..c1abf27e9f 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -32,8 +32,6 @@ -export([error_in_suite/1, init_per_suite/1, end_per_suite/1, init_per_group/2, end_per_group/2]). --export([make_all_conf/3, make_conf/5]). - -include("ct_event.hrl"). -include("ct_util.hrl"). @@ -876,13 +874,13 @@ get_suite(Mod, all) -> {'EXIT',_} -> get_all(Mod, []); GroupDefs when is_list(GroupDefs) -> - case catch find_groups(Mod, all, all, GroupDefs) of + case catch ct_groups: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]]}]; ConfTests -> - get_all(Mod, ConfTests) + get_all(Mod, ConfTests) end; _ -> E = "Bad return value from "++atom_to_list(Mod)++":groups/0", @@ -901,7 +899,7 @@ get_suite(Mod, Group={conf,Props,_Init,TCs,_End}) -> {'EXIT',_} -> [Group]; GroupDefs when is_list(GroupDefs) -> - case catch find_groups(Mod, Name, TCs, GroupDefs) of + case catch ct_groups: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 @@ -916,12 +914,13 @@ get_suite(Mod, Group={conf,Props,_Init,TCs,_End}) -> %% init/end functions for top groups will be executed case catch ?val(name, element(2, hd(ConfTests))) of Name -> % top group - delete_subs(ConfTests, ConfTests); + ct_groups:delete_subs(ConfTests, ConfTests); _ -> [] end; false -> - ConfTests1 = delete_subs(ConfTests, ConfTests), + ConfTests1 = ct_groups:delete_subs(ConfTests, + ConfTests), case ?val(override, Props) of undefined -> ConfTests1; @@ -930,9 +929,9 @@ get_suite(Mod, Group={conf,Props,_Init,TCs,_End}) -> ORSpec -> ORSpec1 = if is_tuple(ORSpec) -> [ORSpec]; true -> ORSpec end, - search_and_override(ConfTests1, - ORSpec1, Mod) - end + ct_groups:search_and_override(ConfTests1, + ORSpec1, Mod) + end end end; _ -> @@ -976,234 +975,6 @@ get_all_cases1(_, []) -> %%%----------------------------------------------------------------- -find_groups(Mod, Name, TCs, GroupDefs) -> - Found = find(Mod, Name, TCs, GroupDefs, [], GroupDefs, false), - trim(Found). - -find(Mod, all, _TCs, [{Name,Props,Tests} | Gs], Known, Defs, _) - when is_atom(Name), is_list(Props), is_list(Tests) -> - 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; - -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); - -%% Undocumented remote group feature, use with caution -find(Mod, Name, TCs, [{group, ExtMod, ExtGrp} | Gs], Known, Defs, true) - when is_atom(ExtMod), is_atom(ExtGrp) -> - ExternalDefs = ExtMod:groups(), - ExternalTCs = find(ExtMod, ExtGrp, TCs, [{group, ExtGrp}], - [], ExternalDefs, false), - ExternalTCs ++ find(Mod, Name, TCs, Gs, Known, Defs, true); - -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) -> - find(Mod, Name, TCs, Gs, Known, Defs, false); - -find(Mod, Name, TCs, [TC | Gs], Known, Defs, true) when is_atom(TC) -> - [{Mod, TC} | find(Mod, Name, TCs, Gs, Known, Defs, true)]; - -find(Mod, Name, TCs, [{ExternalTC, Case} = TC | Gs], Known, Defs, true) - when is_atom(ExternalTC), - is_atom(Case) -> - [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(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)}); - -find(_Mod, _Name, _TCs, [], _Known, _Defs, false) -> - ['$NOMATCH']; - -find(_Mod, _Name, _TCs, [], _Known, _Defs, _Found) -> - []. - -delete_subs([{conf, _,_,_,_} = 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([_Else | Confs], All) -> - delete_subs(Confs, All); -delete_subs([], All) -> - All. - -delete_conf({conf,Props,_,_,_}, Confs) -> - Name = ?val(name, Props), - [Conf || Conf = {conf,Props0,_,_,_} <- Confs, - Name =/= ?val(name, Props0)]. - -is_sub({conf,Props,_,_,_}=Conf, [{conf,_,_,Tests,_} | Confs]) -> - Name = ?val(name, Props), - case lists:any(fun({conf,Props0,_,_,_}) -> - case ?val(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; - false -> - E = "Invalid group "++atom_to_list(Name)++ - " in "++atom_to_list(Mod)++":groups/0", - 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} - <- delete_subs(ConfTests, 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,ExtraProps} = - case erlang:function_exported(Mod,init_per_group,2) of - true -> - {{Mod,init_per_group},{Mod,end_per_group},[]}; - false -> - ct_logs:log("TEST INFO", "init_per_group/2 and " - "end_per_group/2 missing for group " - "~p in ~p, using default.", - [Name,Mod]), - {{?MODULE,init_per_group}, - {?MODULE,end_per_group}, - [{suite,Mod}]} - end, - {conf,[{name,Name}|Props++ExtraProps],InitConf,TestSpec,EndConf}. - -%%%----------------------------------------------------------------- - get_all(Mod, ConfTests) -> case catch apply(Mod, all, []) of {'EXIT',_} -> @@ -1218,133 +989,24 @@ get_all(Mod, ConfTests) -> [{?MODULE,error_in_suite,[[{error,What}]]}]; SeqsAndTCs -> %% expand group references in all() using ConfTests - case catch expand_groups(SeqsAndTCs, ConfTests, Mod) of + case catch ct_groups:expand_groups(SeqsAndTCs, + ConfTests, + Mod) of {error,_} = Error -> [{?MODULE,error_in_suite,[[Error]]}]; Tests -> - delete_subs(Tests, Tests) + ct_groups:delete_subs(Tests, Tests) end end; Skip = {skip,_Reason} -> Skip; _ -> Reason = - list_to_atom("Bad return value from "++atom_to_list(Mod)++":all/0"), + list_to_atom("Bad return value from "++ + atom_to_list(Mod)++":all/0"), [{?MODULE,error_in_suite,[[{error,Reason}]]}] end. -expand_groups([H | T], ConfTests, Mod) -> - [expand_groups(H, ConfTests, Mod) | expand_groups(T, ConfTests, Mod)]; -expand_groups([], _ConfTests, _Mod) -> - []; -expand_groups({group,Name}, ConfTests, Mod) -> - 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:flatmap(FindConf, ConfTests) of - [] -> - 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 R15. The code below is only kept diff --git a/lib/common_test/src/ct_groups.erl b/lib/common_test/src/ct_groups.erl new file mode 100644 index 0000000000..74ab5e5439 --- /dev/null +++ b/lib/common_test/src/ct_groups.erl @@ -0,0 +1,599 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2012. 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 Common Test Framework callback module. +%%% +%%% <p>This module contains CT internal help functions for searching +%%% through groups specification trees and producing resulting +%%% tests.</p> + +-module(ct_groups). + +-export([find_groups/4]). +-export([make_all_conf/3, make_all_conf/4, make_conf/5]). +-export([delete_subs/2]). +-export([expand_groups/3, search_and_override/3]). + +-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)). + +find_groups(Mod, GrNames, TCs, GroupDefs) when is_atom(GrNames) ; + (length(GrNames) == 1) -> + find_groups1(Mod, GrNames, TCs, GroupDefs); + +find_groups(Mod, Groups, TCs, GroupDefs) when Groups /= [] -> + lists:append([find_groups1(Mod, [GrNames], TCs, GroupDefs) || + GrNames <- Groups]); + +find_groups(_Mod, [], _TCs, _GroupDefs) -> + []. + +%% GrNames == atom(): Single group name, perform full search +%% GrNames == list(): List of groups, find all matching paths +%% GrNames == [list()]: Search path terminated by last group in GrNames +find_groups1(Mod, GrNames, TCs, GroupDefs) -> + {GrNames1,FindAll} = + case GrNames of + Name when is_atom(Name), Name /= all -> + {[Name],true}; + [Path] when is_list(Path) -> + {Path,false}; + Path -> + {Path,true} + end, + TCs1 = if (is_atom(TCs) and (TCs /= all)) or is_tuple(TCs) -> + [TCs]; + true -> + TCs + end, + Found = find(Mod, GrNames1, TCs1, GroupDefs, [], + GroupDefs, FindAll), + [Conf || Conf <- Found, Conf /= 'NOMATCH']. + +%% Locate all groups +find(Mod, all, all, [{Name,Props,Tests} | Gs], Known, Defs, _) + when is_atom(Name), is_list(Props), is_list(Tests) -> + cyclic_test(Mod, Name, Known), + trim(make_conf(Mod, Name, Props, + find(Mod, all, all, Tests, [Name | Known], + Defs, true))) ++ + find(Mod, all, all, Gs, Known, Defs, true); + +%% Locate particular TCs in all groups +find(Mod, all, TCs, [{Name,Props,Tests} | Gs], Known, Defs, _) + when is_atom(Name), is_list(Props), is_list(Tests) -> + cyclic_test(Mod, Name, Known), + Tests1 = rm_unwanted_tcs(Tests, TCs, []), + trim(make_conf(Mod, Name, Props, + find(Mod, all, TCs, Tests1, [Name | Known], + Defs, true))) ++ + find(Mod, all, TCs, Gs, Known, Defs, true); + +%% Found next group is in search path +find(Mod, [Name|GrNames]=SPath, TCs, [{Name,Props,Tests} | Gs], Known, + Defs, FindAll) when is_atom(Name), is_list(Props), is_list(Tests) -> + cyclic_test(Mod, Name, Known), + Tests1 = rm_unwanted_tcs(Tests, TCs, GrNames), + trim(make_conf(Mod, Name, Props, + find(Mod, GrNames, TCs, Tests1, [Name|Known], + Defs, FindAll))) ++ + find(Mod, SPath, TCs, Gs, Known, Defs, FindAll); + +%% Group path terminated, stop the search +find(Mod, [], TCs, Tests, _Known, _Defs, false) -> + Cases = lists:flatmap(fun(TC) when is_atom(TC), TCs == all -> + [{Mod,TC}]; + ({group,_}) -> + []; + ({_,_}=TC) when TCs == all -> + [TC]; + (TC) -> + if is_atom(TC) -> + Tuple = {Mod,TC}, + case lists:member(Tuple, TCs) of + true -> + [Tuple]; + false -> + case lists:member(TC, TCs) of + true -> [{Mod,TC}]; + false -> [] + end + end; + true -> + [] + end + end, Tests), + if Cases == [] -> ['NOMATCH']; + true -> Cases + end; + +%% No more groups +find(_Mod, [_|_], _TCs, [], _Known, _Defs, _) -> + ['NOMATCH']; + +%% Found group not next in search path +find(Mod, GrNames, TCs, [{Name,Props,Tests} | Gs], Known, + Defs, FindAll) when is_atom(Name), is_list(Props), is_list(Tests) -> + cyclic_test(Mod, Name, Known), + Tests1 = rm_unwanted_tcs(Tests, TCs, GrNames), + trim(make_conf(Mod, Name, Props, + find(Mod, GrNames, TCs, Tests1, [Name|Known], + Defs, FindAll))) ++ + find(Mod, GrNames, TCs, Gs, Known, Defs, FindAll); + +%% A nested group defined on top level found +find(Mod, GrNames, TCs, [{group,Name1} | Gs], Known, Defs, FindAll) + when is_atom(Name1) -> + find(Mod, GrNames, TCs, [expand(Mod, Name1, Defs) | Gs], Known, + Defs, FindAll); + +%% Undocumented remote group feature, use with caution +find(Mod, GrNames, TCs, [{group, ExtMod, ExtGrp} | Gs], Known, + Defs, FindAll) when is_atom(ExtMod), is_atom(ExtGrp) -> + ExternalDefs = ExtMod:groups(), + ExternalTCs = find(ExtMod, ExtGrp, TCs, [{group, ExtGrp}], + [], ExternalDefs, FindAll), + ExternalTCs ++ find(Mod, GrNames, TCs, Gs, Known, Defs, FindAll); + +%% Group definition without properties, add an empty property list +find(Mod, GrNames, TCs, [{Name1,Tests} | Gs], Known, Defs, FindAll) + when is_atom(Name1), is_list(Tests) -> + find(Mod, GrNames, TCs, [{Name1,[],Tests} | Gs], Known, Defs, FindAll); + +%% Save, and keep searching +find(Mod, GrNames, TCs, [{ExternalTC, Case} = TC | Gs], Known, + Defs, FindAll) when is_atom(ExternalTC), + is_atom(Case) -> + [TC | find(Mod, GrNames, TCs, Gs, Known, Defs, FindAll)]; + +%% Save test case +find(Mod, GrNames, all, [TC | Gs], Known, + Defs, FindAll) when is_atom(TC) -> + [{Mod,TC} | find(Mod, GrNames, all, Gs, Known, Defs, FindAll)]; + +%% Save test case +find(Mod, GrNames, all, [{M,TC} | Gs], Known, + Defs, FindAll) when is_atom(M), M /= group, is_atom(TC) -> + [{M,TC} | find(Mod, GrNames, all, Gs, Known, Defs, FindAll)]; + +%% Check if test case should be saved +find(Mod, GrNames, TCs, [TC | Gs], Known, + Defs, FindAll) when is_atom(TC) orelse + ((size(TC) == 2) and (element(1,TC) /= group)) -> + Case = + if is_atom(TC) -> + Tuple = {Mod,TC}, + case lists:member(Tuple, TCs) of + true -> + Tuple; + false -> + case lists:member(TC, TCs) of + true -> {Mod,TC}; + false -> [] + end + end; + true -> + case lists:member(TC, TCs) of + true -> {Mod,TC}; + false -> [] + end + end, + if Case == [] -> + find(Mod, GrNames, TCs, Gs, Known, Defs, FindAll); + true -> + [Case | find(Mod, GrNames, TCs, Gs, Known, Defs, FindAll)] + end; + +%% Unexpeted term in group list +find(Mod, _GrNames, _TCs, [BadTerm | _Gs], Known, _Defs, _FindAll) -> + Where = if length(Known) == 0 -> + atom_to_list(Mod)++":groups/0"; + true -> + "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)}); + +%% No more groups +find(_Mod, _GrNames, _TCs, [], _Known, _Defs, _) -> + []. + +%%%----------------------------------------------------------------- + +%% We have to always search bottom up to only remove a branch +%% if there's 'NOMATCH' in the leaf (otherwise, the branch should +%% be kept) + +trim({conf,Props,Init,Tests,End}) -> + try trim(Tests) of + [] -> []; + Tests1 -> [{conf,Props,Init,Tests1,End}] + catch + throw:_ -> [] + end; + +trim(Tests) when is_list(Tests) -> + %% we need to compare the result of trimming each test on this + %% level, and only let a 'NOMATCH' fail the level if no + %% successful sub group can be found + Tests1 = + lists:flatmap(fun(Test) -> + IsConf = case Test of + {conf,_,_,_,_} -> + true; + _ -> + false + end, + try trim_test(Test) of + [] -> []; + Test1 when IsConf -> [{conf,Test1}]; + Test1 -> [Test1] + catch + throw:_ -> ['NOMATCH'] + end + end, Tests), + case lists:keymember(conf, 1, Tests1) of + true -> % at least one successful group + lists:flatmap(fun({conf,Test}) -> [Test]; + ('NOMATCH') -> []; % ignore any 'NOMATCH' + (Test) -> [Test] + end, Tests1); + false -> + case lists:member('NOMATCH', Tests1) of + true -> + throw('NOMATCH'); + false -> + Tests1 + end + end. + +trim_test({conf,Props,Init,Tests,End}) -> + case trim(Tests) of + [] -> + []; + Tests1 -> + {conf,Props,Init,Tests1,End} + end; + +trim_test('NOMATCH') -> + throw('NOMATCH'); + +trim_test(Test) -> + Test. + +%% GrNames is [] if the terminating group has been found. From +%% that point, all specified test should be included (as well as +%% sub groups for deeper search). +rm_unwanted_tcs(Tests, all, []) -> + Tests; + +rm_unwanted_tcs(Tests, TCs, []) -> + sort_tests(lists:flatmap(fun(Test) when is_tuple(Test), + (size(Test) > 2) -> + [Test]; + (Test={group,_}) -> + [Test]; + (Test={_M,TC}) -> + case lists:member(TC, TCs) of + true -> [Test]; + false -> [] + end; + (Test) when is_atom(Test) -> + case lists:keysearch(Test, 2, TCs) of + {value,_} -> + [Test]; + _ -> + case lists:member(Test, TCs) of + true -> [Test]; + false -> [] + end + end; + (Test) -> [Test] + end, Tests), TCs); + +rm_unwanted_tcs(Tests, _TCs, _) -> + [Test || Test <- Tests, not is_atom(Test)]. + +%% make sure the order of tests is according to the order in TCs +sort_tests(Tests, TCs) when is_list(TCs)-> + lists:sort(fun(T1, T2) -> + case {is_tc(T1),is_tc(T2)} of + {true,true} -> + (position(T1, TCs) =< + position(T2, TCs)); + {false,true} -> + (position(T2, TCs) == (length(TCs)+1)); + _ -> true + + end + end, Tests); +sort_tests(Tests, _) -> + Tests. + +is_tc(T) when is_atom(T) -> true; +is_tc({group,_}) -> false; +is_tc({_M,T}) when is_atom(T) -> true; +is_tc(_) -> false. + +position(T, TCs) -> + position(T, TCs, 1). + +position(T, [T|_TCs], Pos) -> + Pos; +position(T, [{_,T}|_TCs], Pos) -> + Pos; +position({M,T}, [T|_TCs], Pos) when M /= group -> + Pos; +position(T, [_|TCs], Pos) -> + position(T, TCs, Pos+1); +position(_, [], Pos) -> + Pos. + +%%%----------------------------------------------------------------- + +delete_subs([{conf, _,_,_,_} = 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([_Else | Confs], All) -> + delete_subs(Confs, All); +delete_subs([], All) -> + All. + +delete_conf({conf,Props,_,_,_}, Confs) -> + Name = ?val(name, Props), + [Conf || Conf = {conf,Props0,_,_,_} <- Confs, + Name =/= ?val(name, Props0)]. + +is_sub({conf,Props,_,_,_}=Conf, [{conf,_,_,Tests,_} | Confs]) -> + Name = ?val(name, Props), + case lists:any(fun({conf,Props0,_,_,_}) -> + case ?val(name, Props0) of + N when N == Name -> + true; + _ -> + false + end; + (_) -> + false + end, Tests) of + true -> + true; + false -> + is_sub(Conf, Tests) orelse is_sub(Conf, Confs) + end; + +is_sub(Conf, [_TC | Tests]) -> + is_sub(Conf, Tests); + +is_sub(_Conf, []) -> + false. + + +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; + false -> + E = "Invalid group "++atom_to_list(Name)++ + " in "++atom_to_list(Mod)++":groups/0", + throw({error,list_to_atom(E)}) + end. + +make_all_conf(Dir, Mod, Props, TestSpec) -> + case code:is_loaded(Mod) of + false -> + code:load_abs(filename:join(Dir,atom_to_list(Mod))); + _ -> + ok + end, + make_all_conf(Mod, Props, TestSpec). + +make_all_conf(Mod, Props, TestSpec) -> + case catch apply(Mod, groups, []) of + {'EXIT',_} -> + exit({invalid_group_definition,Mod}); + GroupDefs when is_list(GroupDefs) -> + case catch find_groups(Mod, all, TestSpec, GroupDefs) of + {error,_} = Error -> + %% this makes test_server call error_in_suite as first + %% (and only) test case so we can report Error properly + [{ct_framework,error_in_suite,[[Error]]}]; + [] -> + exit({invalid_group_spec,Mod}); + _ConfTests -> + make_conf(Mod, all, Props, TestSpec) + 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,ExtraProps} = + case erlang:function_exported(Mod,init_per_group,2) of + true -> + {{Mod,init_per_group},{Mod,end_per_group},[]}; + false -> + ct_logs:log("TEST INFO", "init_per_group/2 and " + "end_per_group/2 missing for group " + "~p in ~p, using default.", + [Name,Mod]), + {{ct_framework,init_per_group}, + {ct_framework,end_per_group}, + [{suite,Mod}]} + end, + {conf,[{name,Name}|Props++ExtraProps],InitConf,TestSpec,EndConf}. + +%%%----------------------------------------------------------------- + +expand_groups([H | T], ConfTests, Mod) -> + [expand_groups(H, ConfTests, Mod) | expand_groups(T, ConfTests, Mod)]; +expand_groups([], _ConfTests, _Mod) -> + []; +expand_groups({group,Name}, ConfTests, Mod) -> + 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 -> + Props1 = case ?val(suite, Props) of + undefined -> + ORProps; + SuiteName -> + [{suite,SuiteName}|ORProps] + end, + [{conf,[{name,Name}|Props1],Init,Ts,End}]; + _ -> + [] + end + end, + case lists:flatmap(FindConf, ConfTests) of + [] -> + 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) -> + InsProps = fun(GrName, undefined, Ps) -> + [{name,GrName} | Ps]; + (GrName, Suite, Ps) -> + [{name,GrName}, {suite,Suite} | Ps] + end, + Name = ?val(name, Props), + Suite = ?val(suite, Props), + case lists:keysearch(Name, 1, ORSpec) of + {value,{Name,default}} -> + [Conf]; + {value,{Name,ORProps}} -> + [{conf,InsProps(Name,Suite,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,InsProps(Name,Suite,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), + Suite = ?val(suite, Props), + case lists:keysearch(Name, 1, ORSpec) of + {value,Spec} -> % group found in spec + Props1 = + case element(2, Spec) of + default -> Props; + ORProps when Suite == undefined -> [{name,Name} | ORProps]; + ORProps -> [{name,Name}, {suite,Suite} | 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). diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index 99bec3ea09..f29eba605c 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -51,7 +51,7 @@ %%% {testcase,Cases} | {spec,TestSpecs} | {allow_user_terms,Bool} | %%% {logdir,LogDir} | {event_handler,EventHandlers} | %%% {silent_connections,Conns} | {cover,CoverSpecFile} | -%%% {userconfig, UserCfgFiles} +%%% {cover_stop,Bool} | {userconfig, UserCfgFiles} %%% CfgFiles = string() | [string()] %%% TestDirs = string() | [string()] %%% Suites = atom() | [atom()] diff --git a/lib/common_test/src/ct_master_logs.erl b/lib/common_test/src/ct_master_logs.erl index d76288feef..84f175c0a9 100644 --- a/lib/common_test/src/ct_master_logs.erl +++ b/lib/common_test/src/ct_master_logs.erl @@ -204,7 +204,7 @@ open_ct_master_log(Dir) -> {ok,Fd} = file:open(FullName,[write]), io:put_chars(Fd,header("Common Test Master Log", {[],[1,2],[]})), %% maybe add config info here later - io:put_chars(config_table([])), + io:put_chars(Fd,config_table([])), io:put_chars(Fd, "<style>\n" "div.ct_internal { background:lightgrey; color:black }\n" diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl index 52fe9599ce..1ccbc86d8f 100644 --- a/lib/common_test/src/ct_netconfc.erl +++ b/lib/common_test/src/ct_netconfc.erl @@ -307,7 +307,7 @@ -type option() :: {ssh,host()} | {port,inet:port_number()} | {user,string()} | {password,string()} | {user_dir,string()} | {timeout,timeout()}. --type host() :: inet:host_name() | inet:ip_address(). +-type host() :: inet:hostname() | inet:ip_address(). -type notification() :: {notification, xml_attributes(), notification_content()}. -type notification_content() :: [event_time()|simple_xml()]. @@ -968,7 +968,7 @@ close_session(Client) -> %% @end %%---------------------------------------------------------------------- close_session(Client, Timeout) -> - call(Client,{send_rpc_op, close_session, [], Timeout}). + call(Client,{send_rpc_op, close_session, [], Timeout}, true). %%---------------------------------------------------------------------- @@ -1073,7 +1073,8 @@ handle_msg({get_event_streams=Op,Streams,Timeout}, From, State) -> SimpleXml = encode_rpc_operation(get,[Filter]), do_send_rpc(Op, SimpleXml, Timeout, From, State). -handle_msg({ssh_cm, _CM, {data, _Ch, _Type, Data}}, State) -> +handle_msg({ssh_cm, CM, {data, Ch, _Type, Data}}, State) -> + ssh_connection:adjust_window(CM,Ch,size(Data)), handle_data(Data, State); handle_msg({ssh_cm, _CM, _SshCloseMsg}, State) -> %% _SshCloseMsg can probably be one of @@ -1121,17 +1122,38 @@ close(Client) -> %% Internal functions %%---------------------------------------------------------------------- call(Client, Msg) -> - call(Client, Msg, infinity). -call(Client, Msg, Timeout) -> + call(Client, Msg, infinity, false). +call(Client, Msg, Timeout) when is_integer(Timeout); Timeout==infinity -> + call(Client, Msg, Timeout, false); +call(Client, Msg, WaitStop) when is_boolean(WaitStop) -> + call(Client, Msg, infinity, WaitStop). +call(Client, Msg, Timeout, WaitStop) -> case get_handle(Client) of {ok,Pid} -> case ct_gen_conn:call(Pid,Msg,Timeout) of - {error,{process_down,Client,noproc}} -> + {error,{process_down,Pid,noproc}} -> {error,no_such_client}; - {error,{process_down,Client,normal}} -> + {error,{process_down,Pid,normal}} when WaitStop -> + %% This will happen when server closes connection + %% before clien received rpc-reply on + %% close-session. + ok; + {error,{process_down,Pid,normal}} -> {error,closed}; - {error,{process_down,Client,Reason}} -> + {error,{process_down,Pid,Reason}} -> {error,{closed,Reason}}; + Other when WaitStop -> + MRef = erlang:monitor(process,Pid), + receive + {'DOWN',MRef,process,Pid,Normal} when Normal==normal; + Normal==noproc -> + Other; + {'DOWN',MRef,process,Pid,Reason} -> + {error,{{closed,Reason},Other}} + after Timeout -> + erlang:demonitor(MRef, [flush]), + {error,{timeout,Other}} + end; Other -> Other end; @@ -1784,7 +1806,8 @@ get_tag([]) -> %%% SSH stuff ssh_receive_data() -> receive - {ssh_cm, _CM, {data, _Ch, _Type, Data}} -> + {ssh_cm, CM, {data, Ch, _Type, Data}} -> + ssh_connection:adjust_window(CM,Ch,size(Data)), {ok, Data}; {ssh_cm, _CM, {Closed, _Ch}} = X when Closed == closed; Closed == eof -> {error,X}; diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 4a6a3cdcac..eb05c90ba8 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -58,6 +58,7 @@ vts, shell, cover, + cover_stop, coverspec, step, logdir, @@ -245,6 +246,7 @@ script_start1(Parent, Args) -> Vts = get_start_opt(vts, true, Args), Shell = get_start_opt(shell, true, Args), Cover = get_start_opt(cover, fun([CoverFile]) -> ?abs(CoverFile) end, Args), + CoverStop = get_start_opt(cover_stop, fun([CS]) -> list_to_atom(CS) end, Args), LogDir = get_start_opt(logdir, fun([LogD]) -> LogD end, Args), LogOpts = get_start_opt(logopts, fun(Os) -> [list_to_atom(O) || O <- Os] end, [], Args), @@ -329,7 +331,8 @@ script_start1(Parent, Args) -> end, StartOpts = #opts{label = Label, profile = Profile, - vts = Vts, shell = Shell, cover = Cover, + vts = Vts, shell = Shell, + cover = Cover, cover_stop = CoverStop, logdir = LogDir, logopts = LogOpts, basic_html = BasicHtml, verbosity = Verbosity, @@ -416,6 +419,9 @@ script_start2(StartOpts = #opts{vts = undefined, Cover = choose_val(StartOpts#opts.cover, SpecStartOpts#opts.cover), + CoverStop = + choose_val(StartOpts#opts.cover_stop, + SpecStartOpts#opts.cover_stop), MultTT = choose_val(StartOpts#opts.multiply_timetraps, SpecStartOpts#opts.multiply_timetraps), @@ -475,6 +481,7 @@ script_start2(StartOpts = #opts{vts = undefined, profile = Profile, testspecs = Specs, cover = Cover, + cover_stop = CoverStop, logdir = LogDir, logopts = AllLogOpts, basic_html = BasicHtml, @@ -723,6 +730,7 @@ script_usage() -> "\n\t[-silent_connections [ConnType1 ConnType2 .. ConnTypeN]]" "\n\t[-stylesheet CSSFile]" "\n\t[-cover CoverCfgFile]" + "\n\t[-cover_stop Bool]" "\n\t[-event_handler EvHandler1 EvHandler2 .. EvHandlerN]" "\n\t[-ct_hooks CTHook1 CTHook2 .. CTHookN]" "\n\t[-include InclDir1 InclDir2 .. InclDirN]" @@ -745,6 +753,7 @@ script_usage() -> "\n\t[-silent_connections [ConnType1 ConnType2 .. ConnTypeN]]" "\n\t[-stylesheet CSSFile]" "\n\t[-cover CoverCfgFile]" + "\n\t[-cover_stop Bool]" "\n\t[-event_handler EvHandler1 EvHandler2 .. EvHandlerN]" "\n\t[-ct_hooks CTHook1 CTHook2 .. CTHookN]" "\n\t[-include InclDir1 InclDir2 .. InclDirN]" @@ -938,6 +947,7 @@ run_test2(StartOpts) -> %% code coverage Cover = get_start_opt(cover, fun(CoverFile) -> ?abs(CoverFile) end, StartOpts), + CoverStop = get_start_opt(cover_stop, value, StartOpts), %% timetrap manipulation MultiplyTT = get_start_opt(multiply_timetraps, value, 1, StartOpts), @@ -1000,7 +1010,8 @@ run_test2(StartOpts) -> Step = get_start_opt(step, value, StartOpts), Opts = #opts{label = Label, profile = Profile, - cover = Cover, step = Step, logdir = LogDir, + cover = Cover, cover_stop = CoverStop, + step = Step, logdir = LogDir, logopts = LogOpts, basic_html = BasicHtml, config = CfgFiles, verbosity = Verbosity, @@ -1063,6 +1074,8 @@ run_spec_file(Relaxed, AllConfig = merge_vals([CfgFiles, SpecOpts#opts.config]), Cover = choose_val(Opts#opts.cover, SpecOpts#opts.cover), + CoverStop = choose_val(Opts#opts.cover_stop, + SpecOpts#opts.cover_stop), MultTT = choose_val(Opts#opts.multiply_timetraps, SpecOpts#opts.multiply_timetraps), ScaleTT = choose_val(Opts#opts.scale_timetraps, @@ -1103,6 +1116,7 @@ run_spec_file(Relaxed, Opts1 = Opts#opts{label = Label, profile = Profile, cover = Cover, + cover_stop = CoverStop, logdir = which(logdir, LogDir), logopts = AllLogOpts, stylesheet = Stylesheet, @@ -1272,7 +1286,8 @@ run_dir(Opts = #opts{logdir = LogDir, reformat_result(catch do_run(tests(Dir2, Mod), [], Opts1, StartOpts)); _ -> - reformat_result(catch do_run(tests(Dir2, Mod, GsAndCs), + reformat_result(catch do_run(tests(Dir2, Mod, + GsAndCs), [], Opts1, StartOpts)) end; @@ -1281,7 +1296,8 @@ run_dir(Opts = #opts{logdir = LogDir, [_,_|_] when GsAndCs /= [] -> exit({error,multiple_suites_and_cases}); [{Dir2,Mod}] when GsAndCs /= [] -> - reformat_result(catch do_run(tests(Dir2, Mod, GsAndCs), + reformat_result(catch do_run(tests(Dir2, Mod, + GsAndCs), [], Opts1, StartOpts)); DirMods -> reformat_result(catch do_run(tests(DirMods), @@ -1374,6 +1390,7 @@ get_data_for_node(#testspec{label = Labels, verbosity = VLvls, silent_connections = SilentConnsList, cover = CoverFs, + cover_stop = CoverStops, config = Cfgs, userconfig = UsrCfgs, event_handler = EvHs, @@ -1405,6 +1422,7 @@ get_data_for_node(#testspec{label = Labels, SCs -> SCs end, Cover = proplists:get_value(Node, CoverFs), + CoverStop = proplists:get_value(Node, CoverStops), MT = proplists:get_value(Node, MTs), ST = proplists:get_value(Node, STs), CreatePrivDir = proplists:get_value(Node, PDs), @@ -1423,6 +1441,7 @@ get_data_for_node(#testspec{label = Labels, verbosity = Verbosity, silent_connections = SilentConns, cover = Cover, + cover_stop = CoverStop, config = ConfigFiles, event_handlers = EvHandlers, ct_hooks = FiltCTHooks, @@ -1536,17 +1555,36 @@ groups_and_cases(Gs, Cs) when ((Gs == undefined) or (Gs == [])) and ((Cs == undefined) or (Cs == [])) -> []; groups_and_cases(Gs, Cs) when Gs == undefined ; Gs == [] -> - [ensure_atom(C) || C <- listify(Cs)]; -groups_and_cases(Gs, Cs) when Cs == undefined ; Cs == [] -> - [{ensure_atom(G),all} || G <- listify(Gs)]; -groups_and_cases(G, Cs) when is_atom(G) -> - [{G,[ensure_atom(C) || C <- listify(Cs)]}]; -groups_and_cases([G], Cs) -> - [{ensure_atom(G),[ensure_atom(C) || C <- listify(Cs)]}]; -groups_and_cases([_,_|_] , Cs) when Cs =/= [] -> - {error,multiple_groups_and_cases}; -groups_and_cases(_Gs, _Cs) -> - {error,incorrect_group_or_case_option}. + if (Cs == all) or (Cs == [all]) or (Cs == ["all"]) -> all; + true -> [ensure_atom(C) || C <- listify(Cs)] + end; +groups_and_cases(GOrGs, Cs) when (is_atom(GOrGs) orelse + (is_list(GOrGs) andalso + (is_atom(hd(GOrGs)) orelse + (is_list(hd(GOrGs)) andalso + is_atom(hd(hd(GOrGs))))))) -> + if (Cs == undefined) or (Cs == []) or + (Cs == all) or (Cs == [all]) or (Cs == ["all"]) -> + [{GOrGs,all}]; + true -> + [{GOrGs,[ensure_atom(C) || C <- listify(Cs)]}] + end; +groups_and_cases(Gs, Cs) when is_integer(hd(hd(Gs))) -> + %% if list of strings, this comes from 'ct_run -group G1 G2 ...' and + %% we need to parse the strings + Gs1 = + if (Gs == [all]) or (Gs == ["all"]) -> + all; + true -> + lists:map(fun(G) -> + {ok,Ts,_} = erl_scan:string(G++"."), + {ok,Term} = erl_parse:parse_term(Ts), + Term + end, Gs) + end, + groups_and_cases(Gs1, Cs); +groups_and_cases(Gs, Cs) -> + {error,{incorrect_group_or_case_option,Gs,Cs}}. tests(TestDir, Suites, []) when is_list(TestDir), is_integer(hd(TestDir)) -> [{?testdir(TestDir,Suites),ensure_atom(Suites),all}]; @@ -1576,14 +1614,7 @@ do_run(Tests, Misc, LogDir, LogOpts) when is_list(Misc), StepOpts -> #opts{step = StepOpts} end, - Opts1 = - case proplists:get_value(cover, Misc) of - undefined -> - Opts; - CoverFile -> - Opts#opts{cover = CoverFile} - end, - do_run(Tests, [], Opts1#opts{logdir = LogDir}, []); + do_run(Tests, [], Opts#opts{logdir = LogDir}, []); do_run(Tests, Skip, Opts, Args) when is_record(Opts, opts) -> #opts{label = Label, profile = Profile, cover = Cover, @@ -1617,7 +1648,13 @@ do_run(Tests, Skip, Opts, Args) when is_record(Opts, opts) -> {error,Reason} -> exit({error,Reason}); CoverSpec -> - Opts#opts{coverspec = CoverSpec} + CoverStop = + case Opts#opts.cover_stop of + undefined -> true; + Stop -> Stop + end, + Opts#opts{coverspec = CoverSpec, + cover_stop = CoverStop} end end, %% This env variable is used by test_server to determine @@ -1687,11 +1724,15 @@ compile_and_run(Tests, Skip, Opts, Args) -> SavedErrors = save_make_errors(SuiteMakeErrors), ct_repeat:log_loop_info(Args), - {Tests1,Skip1} = final_tests(Tests,Skip,SavedErrors), - - ReleaseSh = proplists:get_value(release_shell, Args), - ct_util:set_testdata({release_shell,ReleaseSh}), - possibly_spawn(ReleaseSh == true, Tests1, Skip1, Opts); + try final_tests(Tests,Skip,SavedErrors) of + {Tests1,Skip1} -> + ReleaseSh = proplists:get_value(release_shell, Args), + ct_util:set_testdata({release_shell,ReleaseSh}), + possibly_spawn(ReleaseSh == true, Tests1, Skip1, Opts) + catch + _:BadFormat -> + {error,BadFormat} + end; false -> io:nl(), ct_util:stop(clean), @@ -1961,22 +2002,21 @@ final_tests1([{TestDir,Suite,GrsOrCs}|Tests], Final, Skip, Bad) when %% for now, only flat group defs are allowed as %% start options and test spec terms fun({all,all}) -> - ct_framework:make_all_conf(TestDir, - Suite, []); + [ct_groups:make_conf(TestDir, Suite, all, [], all)]; ({skipped,Group,TCs}) -> - [ct_framework:make_conf(TestDir, Suite, - Group, [skipped], TCs)]; - ({GrSpec = {Group,_},TCs}) -> + [ct_groups:make_conf(TestDir, Suite, + Group, [skipped], TCs)]; + ({GrSpec = {GroupName,_},TCs}) -> Props = [{override,GrSpec}], - [ct_framework:make_conf(TestDir, Suite, - Group, Props, TCs)]; - ({GrSpec = {Group,_,_},TCs}) -> + [ct_groups:make_conf(TestDir, Suite, + GroupName, Props, TCs)]; + ({GrSpec = {GroupName,_,_},TCs}) -> Props = [{override,GrSpec}], - [ct_framework:make_conf(TestDir, Suite, - Group, Props, TCs)]; - ({Group,TCs}) -> - [ct_framework:make_conf(TestDir, Suite, - Group, [], TCs)]; + [ct_groups:make_conf(TestDir, Suite, + GroupName, Props, TCs)]; + ({GroupOrGroups,TCs}) -> + [ct_groups:make_conf(TestDir, Suite, + GroupOrGroups, [], TCs)]; (TC) -> [TC] end, GrsOrCs), @@ -1988,12 +2028,12 @@ final_tests1([], Final, Skip, _Bad) -> {lists:reverse(Final),Skip}. final_skip([{TestDir,Suite,{all,all},Reason}|Skips], Final) -> - SkipConf = ct_framework:make_conf(TestDir, Suite, all, [], all), + SkipConf = ct_groups:make_conf(TestDir, Suite, all, [], all), Skip = {TestDir,Suite,SkipConf,Reason}, final_skip(Skips, [Skip|Final]); final_skip([{TestDir,Suite,{Group,TCs},Reason}|Skips], Final) -> - Conf = ct_framework:make_conf(TestDir, Suite, Group, [], TCs), + Conf = ct_groups:make_conf(TestDir, Suite, Group, [], TCs), Skip = {TestDir,Suite,Conf,Reason}, final_skip(Skips, [Skip|Final]); @@ -2120,7 +2160,8 @@ do_run_test(Tests, Skip, Opts) -> %% tell test_server which modules should be cover compiled %% note that actual compilation is done when tests start test_server_ctrl:cover(CovApp, CovFile, CovExcl, CovIncl, - CovCross, CovExport, CovLevel), + CovCross, CovExport, CovLevel, + Opts#opts.cover_stop), %% save cover data (used e.g. to add nodes dynamically) ct_util:set_testdata({cover,CovData}), %% start cover on specified nodes @@ -2265,9 +2306,11 @@ add_jobs([{TestDir,all,_}|Tests], Skip, Opts, CleanUp) -> wait_for_idle(), add_jobs(Tests, Skip, Opts, CleanUp) end; -add_jobs([{TestDir,[Suite],all}|Tests], Skip, Opts, CleanUp) when is_atom(Suite) -> +add_jobs([{TestDir,[Suite],all}|Tests], Skip, + Opts, CleanUp) when is_atom(Suite) -> add_jobs([{TestDir,Suite,all}|Tests], Skip, Opts, CleanUp); -add_jobs([{TestDir,Suites,all}|Tests], Skip, Opts, CleanUp) when is_list(Suites) -> +add_jobs([{TestDir,Suites,all}|Tests], Skip, + Opts, CleanUp) when is_list(Suites) -> Name = get_name(TestDir) ++ ".suites", case catch test_server_ctrl:add_module_with_skip(Name, Suites, skiplist(TestDir,Skip)) of @@ -2282,7 +2325,8 @@ add_jobs([{TestDir,Suite,all}|Tests], Skip, Opts, CleanUp) -> ok -> Name = get_name(TestDir) ++ "." ++ atom_to_list(Suite), case catch test_server_ctrl:add_module_with_skip(Name, [Suite], - skiplist(TestDir,Skip)) of + skiplist(TestDir, + Skip)) of {'EXIT',_} -> CleanUp; _ -> @@ -2305,15 +2349,24 @@ add_jobs([{TestDir,Suite,Confs}|Tests], Skip, Opts, CleanUp) when GrTestName = case Confs of [Conf] -> - "." ++ atom_to_list(Group(Conf)) ++ TCTestName(TestCases(Conf)); + case Group(Conf) of + GrName when is_atom(GrName) -> + "." ++ atom_to_list(GrName) ++ + TCTestName(TestCases(Conf)); + _ -> + ".groups" ++ TCTestName(TestCases(Conf)) + end; _ -> ".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 + case catch test_server_ctrl:add_conf_with_skip(TestName, + Suite, + Confs, + skiplist(TestDir, + Skip)) of {'EXIT',_} -> CleanUp; _ -> @@ -2325,18 +2378,21 @@ add_jobs([{TestDir,Suite,Confs}|Tests], Skip, Opts, CleanUp) when end; %% test case -add_jobs([{TestDir,Suite,[Case]}|Tests], Skip, Opts, CleanUp) when is_atom(Case) -> +add_jobs([{TestDir,Suite,[Case]}|Tests], + Skip, Opts, CleanUp) when is_atom(Case) -> add_jobs([{TestDir,Suite,Case}|Tests], Skip, Opts, CleanUp); -add_jobs([{TestDir,Suite,Cases}|Tests], Skip, Opts, CleanUp) when is_list(Cases) -> +add_jobs([{TestDir,Suite,Cases}|Tests], + Skip, Opts, CleanUp) when is_list(Cases) -> Cases1 = lists:map(fun({GroupName,_}) when is_atom(GroupName) -> GroupName; (Case) -> Case end, Cases), case maybe_interpret(Suite, Cases1, Opts) of ok -> - Name = get_name(TestDir) ++ "." ++ atom_to_list(Suite) ++ ".cases", + Name = get_name(TestDir) ++ "." ++ atom_to_list(Suite) ++ ".cases", case catch test_server_ctrl:add_cases_with_skip(Name, Suite, Cases1, - skiplist(TestDir,Skip)) of + skiplist(TestDir, + Skip)) of {'EXIT',_} -> CleanUp; _ -> @@ -2352,7 +2408,8 @@ add_jobs([{TestDir,Suite,Case}|Tests], Skip, Opts, CleanUp) when is_atom(Case) - Name = get_name(TestDir) ++ "." ++ atom_to_list(Suite) ++ "." ++ atom_to_list(Case), case catch test_server_ctrl:add_case_with_skip(Name, Suite, Case, - skiplist(TestDir,Skip)) of + skiplist(TestDir, + Skip)) of {'EXIT',_} -> CleanUp; _ -> @@ -2387,7 +2444,8 @@ skiplist(Dir, [{Dir,all,Cmt}|Skip]) -> %% we need to turn 'all' into list of modules since %% test_server doesn't do skips on Dir level Ss = filelib:wildcard(filename:join(Dir, "*_SUITE.beam")), - [{list_to_atom(filename:basename(S,".beam")),Cmt} || S <- Ss] ++ skiplist(Dir,Skip); + [{list_to_atom(filename:basename(S,".beam")),Cmt} || S <- Ss] ++ + skiplist(Dir,Skip); skiplist(Dir, [{Dir,S,Cmt}|Skip]) -> [{S,Cmt} | skiplist(Dir, Skip)]; skiplist(Dir, [{Dir,S,C,Cmt}|Skip]) -> @@ -2447,8 +2505,10 @@ run_make(Targets, TestDir0, Mod, UserInclude) -> FileTest = fun(F, suites) -> is_suite(F); (F, helpmods) -> not is_suite(F) end, - Files = lists:flatmap(fun({F,out_of_date}) -> - case FileTest(F, Targets) of + Files = + lists:flatmap(fun({F,out_of_date}) -> + case FileTest(F, + Targets) of true -> [F]; false -> [] end; @@ -2584,6 +2644,9 @@ merge_arguments([LogDir={logdir,_}|Args], Merged) -> merge_arguments([CoverFile={cover,_}|Args], Merged) -> merge_arguments(Args, handle_arg(replace, CoverFile, Merged)); +merge_arguments([CoverStop={cover_stop,_}|Args], Merged) -> + merge_arguments(Args, handle_arg(replace, CoverStop, Merged)); + merge_arguments([{'case',TC}|Args], Merged) -> merge_arguments(Args, handle_arg(merge, {testcase,TC}, Merged)); @@ -2792,11 +2855,14 @@ opts2args(EnvStartOpts) -> lists:flatmap(fun({exit_status,ExitStatusOpt}) when is_atom(ExitStatusOpt) -> [{exit_status,[atom_to_list(ExitStatusOpt)]}]; ({halt_with,{HaltM,HaltF}}) -> - [{halt_with,[atom_to_list(HaltM),atom_to_list(HaltF)]}]; + [{halt_with,[atom_to_list(HaltM), + atom_to_list(HaltF)]}]; ({interactive_mode,true}) -> [{shell,[]}]; - ({config,CfgFiles}) -> - [{ct_config,[CfgFiles]}]; + ({config,CfgFile}) when is_integer(hd(CfgFile)) -> + [{ct_config,[CfgFile]}]; + ({config,CfgFiles}) when is_list(hd(CfgFiles)) -> + [{ct_config,CfgFiles}]; ({userconfig,{CBM,CfgStr=[X|_]}}) when is_integer(X) -> [{userconfig,[atom_to_list(CBM),CfgStr]}]; ({userconfig,{CBM,CfgStrs}}) when is_list(CfgStrs) -> @@ -2814,6 +2880,12 @@ opts2args(EnvStartOpts) -> end, UserCfg), [_LastAnd|StrsR] = lists:reverse(lists:flatten(Strs)), [{userconfig,lists:reverse(StrsR)}]; + ({group,G}) when is_atom(G) -> + [{group,[atom_to_list(G)]}]; + ({group,Gs}) when is_list(Gs) -> + LOfGStrs = [lists:flatten(io_lib:format("~w",[G])) || + G <- Gs], + [{group,LOfGStrs}]; ({testcase,Case}) when is_atom(Case) -> [{'case',[atom_to_list(Case)]}]; ({testcase,Cases}) -> diff --git a/lib/common_test/src/ct_slave.erl b/lib/common_test/src/ct_slave.erl index aa3413fa89..1fd8c04f8b 100644 --- a/lib/common_test/src/ct_slave.erl +++ b/lib/common_test/src/ct_slave.erl @@ -1,7 +1,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010. All Rights Reserved. +%% Copyright Ericsson AB 2010-2012. 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 @@ -37,7 +37,7 @@ -record(options, {username, password, boot_timeout, init_timeout, startup_timeout, startup_functions, monitor_master, - kill_if_fail, erl_flags}). + kill_if_fail, erl_flags, env}). %%%----------------------------------------------------------------- %%% @spec start(Node) -> Result @@ -85,7 +85,8 @@ start(Host, Node) -> %%% {startup_functions, StartupFunctions} | %%% {monitor_master, Monitor} | %%% {kill_if_fail, KillIfFail} | -%%% {erl_flags, ErlangFlags} +%%% {erl_flags, ErlangFlags} | +%%% {env, [{EnvVar,Value}]} %%% Username = string() %%% Password = string() %%% BootTimeout = integer() @@ -99,6 +100,8 @@ start(Host, Node) -> %%% Monitor = bool() %%% KillIfFail = bool() %%% ErlangFlags = string() +%%% EnvVar = string() +%%% Value = string() %%% Result = {ok, NodeName} | {error, already_started, NodeName} | %%% {error, started_not_connected, NodeName} | %%% {error, boot_timeout, NodeName} | @@ -152,6 +155,9 @@ start(Host, Node) -> %%% <p>Option <code>erlang_flags</code> specifies, which flags will be added %%% to the parameters of the <code>erl</code> executable.</p> %%% +%%% <p>Option <code>env</code> specifies a list of environment variables +%%% that will extended the environment.</p> +%%% %%% <p>Special return values are: %%% <list> %%% <item><code>{error, already_started, NodeName}</code> - if the node with @@ -233,10 +239,12 @@ fetch_options(Options) -> Monitor = get_option_value(monitor_master, Options, false), KillIfFail = get_option_value(kill_if_fail, Options, true), ErlFlags = get_option_value(erl_flags, Options, []), + EnvVars = get_option_value(env, Options, []), #options{username=UserName, password=Password, boot_timeout=BootTimeout, init_timeout=InitTimeout, startup_timeout=StartupTimeout, startup_functions=StartupFunctions, - monitor_master=Monitor, kill_if_fail=KillIfFail, erl_flags=ErlFlags}. + monitor_master=Monitor, kill_if_fail=KillIfFail, + erl_flags=ErlFlags, env=EnvVars}. % send a message when slave node is started % @hidden @@ -306,11 +314,19 @@ do_start(Host, Node, Options) -> true-> spawn_remote_node(Host, Node, Options) end, + BootTimeout = Options#options.boot_timeout, InitTimeout = Options#options.init_timeout, StartupTimeout = Options#options.startup_timeout, Result = case wait_for_node_alive(ENode, BootTimeout) of pong-> + case test_server:is_cover() of + true -> + MainCoverNode = cover:get_main_node(), + rpc:call(MainCoverNode,cover,start,[ENode]); + false -> + ok + end, call_functions(ENode, Functions2), receive {node_started, ENode}-> @@ -365,9 +381,9 @@ get_cmd(Node, Flags) -> % spawn node locally spawn_local_node(Node, Options) -> - ErlFlags = Options#options.erl_flags, + #options{env=Env,erl_flags=ErlFlags} = Options, Cmd = get_cmd(Node, ErlFlags), - open_port({spawn, Cmd}, [stream]). + open_port({spawn, Cmd}, [stream,{env,Env}]). % start crypto and ssh if not yet started check_for_ssh_running() -> @@ -386,9 +402,10 @@ check_for_ssh_running() -> % spawn node remotely spawn_remote_node(Host, Node, Options) -> - Username = Options#options.username, - Password = Options#options.password, - ErlFlags = Options#options.erl_flags, + #options{username=Username, + password=Password, + erl_flags=ErlFlags, + env=Env} = Options, SSHOptions = case {Username, Password} of {[], []}-> []; @@ -400,8 +417,17 @@ spawn_remote_node(Host, Node, Options) -> check_for_ssh_running(), {ok, SSHConnRef} = ssh:connect(atom_to_list(Host), 22, SSHOptions), {ok, SSHChannelId} = ssh_connection:session_channel(SSHConnRef, infinity), + ssh_setenv(SSHConnRef, SSHChannelId, Env), ssh_connection:exec(SSHConnRef, SSHChannelId, get_cmd(Node, ErlFlags), infinity). + +ssh_setenv(SSHConnRef, SSHChannelId, [{Var, Value} | Vars]) + when is_list(Var), is_list(Value) -> + success = ssh_connection:setenv(SSHConnRef, SSHChannelId, + Var, Value, infinity), + ssh_setenv(SSHConnRef, SSHChannelId, Vars); +ssh_setenv(_SSHConnRef, _SSHChannelId, []) -> ok. + % call functions on a remote Erlang node call_functions(_Node, []) -> ok; @@ -423,8 +449,29 @@ wait_for_node_alive(Node, N) -> % call init:stop on a remote node do_stop(ENode) -> + {Cover,MainCoverNode} = + case test_server:is_cover() of + true -> + Main = cover:get_main_node(), + rpc:call(Main,cover,flush,[ENode]), + {true,Main}; + false -> + {false,undefined} + end, spawn(ENode, init, stop, []), - wait_for_node_dead(ENode, 5). + case wait_for_node_dead(ENode, 5) of + {ok,ENode} -> + if Cover -> + %% To avoid that cover is started again if a node + %% with the same name is started later. + rpc:call(MainCoverNode,cover,stop,[ENode]); + true -> + ok + end, + {ok,ENode}; + Error -> + Error + end. % wait N seconds until node is disconnected wait_for_node_dead(Node, 0) -> diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index a8b67d0329..202d8f9373 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -903,6 +903,8 @@ handle_data(logdir,Node,Dir,Spec) -> [{Node,ref2dir(Dir,Spec)}]; handle_data(cover,Node,File,Spec) -> [{Node,get_absfile(File,Spec)}]; +handle_data(cover_stop,Node,Stop,_Spec) -> + [{Node,Stop}]; handle_data(include,Node,Dirs=[D|_],Spec) when is_list(D) -> [{Node,ref2dir(Dir,Spec)} || Dir <- Dirs]; handle_data(include,Node,Dir=[Ch|_],Spec) when is_integer(Ch) -> @@ -1026,20 +1028,24 @@ insert_groups(Node,Dir,Suite,Group,Cases,Tests,MergeTests) 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) -> - Groups1 = [{Gr,Cases} || Gr <- Groups], + Groups1 = [if is_list(Gr) -> % preserve group path + {[Gr],Cases}; + true -> + {Gr,Cases} end || Gr <- Groups], append({{Node,Dir},[{Suite,Groups1}]},Tests); insert_groups(Node,Dir,Suite,Groups,Cases,Tests,true) when ((Cases == all) or is_list(Cases)) and is_list(Groups) -> + Groups1 = [if is_list(Gr) -> % preserve group path + {[Gr],Cases}; + true -> + {Gr,Cases} end || Gr <- Groups], case lists:keysearch({Node,Dir},1,Tests) of {value,{{Node,Dir},[{all,_}]}} -> Tests; {value,{{Node,Dir},Suites0}} -> - Suites1 = insert_groups1(Suite, - [{Gr,Cases} || Gr <- Groups], - Suites0), + Suites1 = insert_groups1(Suite,Groups1,Suites0), insert_in_order({{Node,Dir},Suites1},Tests); false -> - Groups1 = [{Gr,Cases} || Gr <- Groups], insert_in_order({{Node,Dir},[{Suite,Groups1}]},Tests) end; insert_groups(Node,Dir,Suite,Groups,Case,Tests, MergeTests) @@ -1062,13 +1068,13 @@ insert_groups1(Suite,Groups,Suites0) -> insert_groups2(_Groups,all) -> all; -insert_groups2([Group={GrName,Cases}|Groups],GrAndCases) -> - case lists:keysearch(GrName,1,GrAndCases) of - {value,{GrName,all}} -> +insert_groups2([Group={Gr,Cases}|Groups],GrAndCases) -> + case lists:keysearch(Gr,1,GrAndCases) of + {value,{Gr,all}} -> GrAndCases; - {value,{GrName,Cases0}} -> + {value,{Gr,Cases0}} -> Cases1 = insert_in_order(Cases,Cases0), - insert_groups2(Groups,insert_in_order({GrName,Cases1},GrAndCases)); + insert_groups2(Groups,insert_in_order({Gr,Cases1},GrAndCases)); false -> insert_groups2(Groups,insert_in_order(Group,GrAndCases)) end; @@ -1258,6 +1264,8 @@ valid_terms() -> {node,3}, {cover,2}, {cover,3}, + {cover_stop,2}, + {cover_stop,3}, {config,2}, {config,3}, {config,4}, diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index 196b5e46d0..c9c6514fa4 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -38,6 +38,7 @@ verbosity=[], silent_connections=[], cover=[], + cover_stop=[], config=[], userconfig=[], event_handler=[], diff --git a/lib/common_test/src/cth_conn_log.erl b/lib/common_test/src/cth_conn_log.erl index 3af89db3a5..255f3ec78a 100644 --- a/lib/common_test/src/cth_conn_log.erl +++ b/lib/common_test/src/cth_conn_log.erl @@ -58,7 +58,7 @@ -spec init(Id, HookOpts) -> Result when Id :: term(), - HookOpts :: ct:hook_options(), + HookOpts :: ct_netconfc:hook_options(), Result :: {ok,[{ct_netconfc:conn_mod(), {ct_netconfc:log_type(),[ct_netconfc:key_or_name()]}}]}. init(_Id, HookOpts) -> diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl index 77f57c6195..78ae70f37e 100644 --- a/lib/common_test/src/cth_log_redirect.erl +++ b/lib/common_test/src/cth_log_redirect.erl @@ -54,7 +54,7 @@ post_init_per_group(_Group, _Config, 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), + gen_event:call(error_logger, ?MODULE, flush, 300000), {Result, State}. pre_end_per_group(Group, Config, {ct_log, Group}) -> diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl index 76b0f0b5ea..e6eaad8d48 100644 --- a/lib/common_test/src/cth_surefire.erl +++ b/lib/common_test/src/cth_surefire.erl @@ -1,3 +1,22 @@ +%%-------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. 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 Common Test Framework functions handling test specifications. %%% %%% <p>This module creates a junit report of the test run if plugged in @@ -27,18 +46,28 @@ -export([terminate/1]). -record(state, { filepath, axis, properties, package, hostname, - curr_suite, curr_suite_ts, curr_group = [], curr_tc, - curr_log_dir, timer, tc_log, + curr_suite, curr_suite_ts, curr_group = [], + curr_log_dir, timer, tc_log, url_base, test_cases = [], test_suites = [] }). --record(testcase, { log, group, classname, name, time, failure, timestamp }). --record(testsuite, { errors, failures, hostname, name, tests, +-record(testcase, { log, url, group, classname, name, time, result, timestamp }). +-record(testsuite, { errors, failures, skipped, hostname, name, tests, time, timestamp, id, package, - properties, testcases }). + properties, testcases, log, url }). + +-define(default_report,"junit_report.xml"). +-define(suite_log,"suite.log.html"). + +%% Number of dirs from log root to testcase log file. +%% ct_run.<node>.<timestamp>/<test_name>/run.<timestamp>/<tc_log>.html +-define(log_depth,3). id(Opts) -> - filename:absname(proplists:get_value(path, Opts, "junit_report.xml")). + case proplists:get_value(path, Opts) of + undefined -> ?default_report; + Path -> filename:absname(Path) + end. init(Path, Opts) -> {ok, Host} = inet:gethostname(), @@ -47,10 +76,24 @@ init(Path, Opts) -> package = proplists:get_value(package,Opts), axis = proplists:get_value(axis,Opts,[]), properties = proplists:get_value(properties,Opts,[]), + url_base = proplists:get_value(url_base,Opts), timer = now() }. pre_init_per_suite(Suite,Config,#state{ test_cases = [] } = State) -> - {Config, init_tc(State#state{ curr_suite = Suite, curr_suite_ts = now() }, + TcLog = proplists:get_value(tc_logfile,Config), + CurrLogDir = filename:dirname(TcLog), + Path = + case State#state.filepath of + ?default_report -> + RootDir = get_test_root(TcLog), + filename:join(RootDir,?default_report); + P -> + P + end, + {Config, init_tc(State#state{ filepath = Path, + curr_suite = Suite, + curr_suite_ts = now(), + curr_log_dir = CurrLogDir}, Config) }; pre_init_per_suite(Suite,Config,State) -> %% Have to close the previous suite @@ -59,7 +102,8 @@ pre_init_per_suite(Suite,Config,State) -> post_init_per_suite(_Suite,Config, Result, State) -> {Result, end_tc(init_per_suite,Config,Result,State)}. -pre_end_per_suite(_Suite,Config,State) -> {Config, init_tc(State, Config)}. +pre_end_per_suite(_Suite,Config,State) -> + {Config, init_tc(State, Config)}. post_end_per_suite(_Suite,Config,Result,State) -> {Result, end_tc(end_per_suite,Config,Result,State)}. @@ -71,13 +115,15 @@ pre_init_per_group(Group,Config,State) -> post_init_per_group(_Group,Config,Result,State) -> {Result, end_tc(init_per_group,Config,Result,State)}. -pre_end_per_group(_Group,Config,State) -> {Config, init_tc(State, Config)}. +pre_end_per_group(_Group,Config,State) -> + {Config, init_tc(State, Config)}. post_end_per_group(_Group,Config,Result,State) -> NewState = end_tc(end_per_group, Config, Result, State), {Result, NewState#state{ curr_group = tl(NewState#state.curr_group)}}. -pre_init_per_testcase(_TC,Config,State) -> {Config, init_tc(State, Config)}. +pre_init_per_testcase(_TC,Config,State) -> + {Config, init_tc(State, Config)}. post_end_per_testcase(TC,Config,Result,State) -> {Result, end_tc(TC,Config, Result,State)}. @@ -88,11 +134,19 @@ on_tc_fail(_TC, Res, State) -> TCs = State#state.test_cases, TC = hd(TCs), NewTC = TC#testcase{ - failure = + result = {fail,lists:flatten(io_lib:format("~p",[Res]))} }, State#state{ test_cases = [NewTC | tl(TCs)]}. -on_tc_skip(Tc,{Type,_Reason} = Res, State) when Type == tc_auto_skip -> +on_tc_skip(Tc,{Type,_Reason} = Res, State0) when Type == tc_auto_skip -> + TcStr = atom_to_list(Tc), + State = + case State0#state.test_cases of + [#testcase{name=TcStr}|TCs] -> + State0#state{test_cases=TCs}; + _ -> + State0 + end, do_tc_skip(Res, end_tc(Tc,[],Res,init_tc(State,[]))); on_tc_skip(_Tc, _Res, State = #state{test_cases = []}) -> State; @@ -103,7 +157,7 @@ do_tc_skip(Res, State) -> TCs = State#state.test_cases, TC = hd(TCs), NewTC = TC#testcase{ - failure = + result = {skipped,lists:flatten(io_lib:format("~p",[Res]))} }, State#state{ test_cases = [NewTC | tl(TCs)]}. @@ -117,33 +171,52 @@ end_tc(Func, Config, Res, State) when is_atom(Func) -> end_tc(atom_to_list(Func), Config, Res, State); end_tc(Name, _Config, _Res, State = #state{ curr_suite = Suite, curr_group = Groups, - timer = TS, tc_log = Log } ) -> + curr_log_dir = CurrLogDir, + timer = TS, + tc_log = Log0, + url_base = UrlBase } ) -> + Log = + case Log0 of + "" -> + LowerSuiteName = string:to_lower(atom_to_list(Suite)), + filename:join(CurrLogDir,LowerSuiteName++"."++Name++".html"); + _ -> + Log0 + end, + Url = make_url(UrlBase,Log), ClassName = atom_to_list(Suite), PGroup = string:join([ atom_to_list(Group)|| Group <- lists:reverse(Groups)],"."), TimeTakes = io_lib:format("~f",[timer:now_diff(now(),TS) / 1000000]), State#state{ test_cases = [#testcase{ log = Log, + url = Url, timestamp = now_to_string(TS), classname = ClassName, group = PGroup, name = Name, time = TimeTakes, - failure = passed }| State#state.test_cases]}. + result = passed }| + State#state.test_cases], + tc_log = ""}. % so old tc_log is not set if next is on_tc_skip close_suite(#state{ test_cases = [] } = State) -> State; -close_suite(#state{ test_cases = TCs } = State) -> - Total = length(TCs), - Succ = length(lists:filter(fun(#testcase{ failure = F }) -> - F == passed - end,TCs)), - Fail = Total - Succ, +close_suite(#state{ test_cases = TCs, url_base = UrlBase } = State) -> + {Total,Fail,Skip} = count_tcs(TCs,0,0,0), TimeTaken = timer:now_diff(now(),State#state.curr_suite_ts) / 1000000, + SuiteLog = filename:join(State#state.curr_log_dir,?suite_log), + SuiteUrl = make_url(UrlBase,SuiteLog), Suite = #testsuite{ name = atom_to_list(State#state.curr_suite), package = State#state.package, + hostname = State#state.hostname, time = io_lib:format("~f",[TimeTaken]), timestamp = now_to_string(State#state.curr_suite_ts), - errors = Fail, tests = Total, - testcases = lists:reverse(TCs) }, + errors = 0, + failures = Fail, + skipped = Skip, + tests = Total, + testcases = lists:reverse(TCs), + log = SuiteLog, + url = SuiteUrl}, State#state{ test_cases = [], test_suites = [Suite | State#state.test_suites]}. @@ -159,14 +232,15 @@ terminate(State) -> -to_xml(#testcase{ group = Group, classname = CL, log = L, name = N, time = T, timestamp = TS, failure = F}) -> +to_xml(#testcase{ group = Group, classname = CL, log = L, url = U, name = N, time = T, timestamp = TS, result = R}) -> ["<testcase ", - [["group=\"",Group,"\""]||Group /= ""]," " + [["group=\"",Group,"\" "]||Group /= ""], "name=\"",N,"\" " "time=\"",T,"\" " - "timestamp=\"",TS,"\" " + "timestamp=\"",TS,"\" ", + [["url=\"",U,"\" "]||U /= undefined], "log=\"",L,"\">", - case F of + case R of passed -> []; {skipped,Reason} -> @@ -176,22 +250,29 @@ to_xml(#testcase{ group = Group, classname = CL, log = L, name = N, time = T, ti ["<failure message=\"Test ",N," in ",CL," failed!\" type=\"crash\">", sanitize(Reason),"</failure>"] end,"</testcase>"]; -to_xml(#testsuite{ package = P, hostname = H, errors = E, time = Time, - timestamp = TS, tests = T, name = N, testcases = Cases }) -> +to_xml(#testsuite{ package = P, hostname = H, errors = E, failures = F, + skipped = S, time = Time, timestamp = TS, tests = T, name = N, + testcases = Cases, log = Log, url = Url }) -> ["<testsuite ", [["package=\"",P,"\" "]||P /= undefined], - [["hostname=\"",P,"\" "]||H /= undefined], - [["name=\"",N,"\" "]||N /= undefined], - [["time=\"",Time,"\" "]||Time /= undefined], - [["timestamp=\"",TS,"\" "]||TS /= undefined], + "hostname=\"",H,"\" " + "name=\"",N,"\" " + "time=\"",Time,"\" " + "timestamp=\"",TS,"\" " "errors=\"",integer_to_list(E),"\" " - "tests=\"",integer_to_list(T),"\">", + "failures=\"",integer_to_list(F),"\" " + "skipped=\"",integer_to_list(S),"\" " + "tests=\"",integer_to_list(T),"\" ", + [["url=\"",Url,"\" "]||Url /= undefined], + "log=\"",Log,"\">", [to_xml(Case) || Case <- Cases], "</testsuite>"]; to_xml(#state{ test_suites = TestSuites, axis = Axis, properties = Props }) -> ["<testsuites>",properties_to_xml(Axis,Props), [to_xml(TestSuite) || TestSuite <- TestSuites],"</testsuites>"]. +properties_to_xml([],[]) -> + []; properties_to_xml(Axis,Props) -> ["<properties>", [["<property name=\"",Name,"\" axis=\"yes\" value=\"",Value,"\" />"] || {Name,Value} <- Axis], @@ -217,3 +298,37 @@ sanitize([]) -> now_to_string(Now) -> {{YY,MM,DD},{HH,Mi,SS}} = calendar:now_to_local_time(Now), io_lib:format("~p-~2..0B-~2..0BT~2..0B:~2..0B:~2..0B",[YY,MM,DD,HH,Mi,SS]). + +make_url(undefined,_) -> + undefined; +make_url(_,[]) -> + undefined; +make_url(UrlBase0,Log) -> + UrlBase = string:strip(UrlBase0,right,$/), + RelativeLog = get_relative_log_url(Log), + string:join([UrlBase,RelativeLog],"/"). + +get_test_root(Log) -> + LogParts = filename:split(Log), + filename:join(lists:sublist(LogParts,1,length(LogParts)-?log_depth)). + +get_relative_log_url(Log) -> + LogParts = filename:split(Log), + Start = length(LogParts)-?log_depth, + Length = ?log_depth+1, + string:join(lists:sublist(LogParts,Start,Length),"/"). + +count_tcs([#testcase{name=ConfCase}|TCs],Ok,F,S) + when ConfCase=="init_per_suite"; + ConfCase=="end_per_suite"; + ConfCase=="init_per_group"; + ConfCase=="end_per_group" -> + count_tcs(TCs,Ok,F,S); +count_tcs([#testcase{result=passed}|TCs],Ok,F,S) -> + count_tcs(TCs,Ok+1,F,S); +count_tcs([#testcase{result={fail,_}}|TCs],Ok,F,S) -> + count_tcs(TCs,Ok,F+1,S); +count_tcs([#testcase{result={skipped,_}}|TCs],Ok,F,S) -> + count_tcs(TCs,Ok,F,S+1); +count_tcs([],Ok,F,S) -> + {Ok+F+S,F,S}. |