From ec4c840624a9a44d4d7d6b1e51e1f33a291a704b Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Mon, 20 Sep 2010 15:46:12 +0200 Subject: Add support for suite_callback in spec, command_line and interactive. Start work on suite_callback functionality. --- lib/common_test/src/Makefile | 3 +- lib/common_test/src/ct_framework.erl | 36 +++++++++------ lib/common_test/src/ct_run.erl | 75 ++++++++++++++++++++++++------- lib/common_test/src/ct_suite_callback.erl | 73 +++++++++++++++++++++--------- lib/common_test/src/ct_testspec.erl | 16 +++++++ lib/common_test/src/ct_util.erl | 22 ++++++++- lib/common_test/src/ct_util.hrl | 1 + 7 files changed, 174 insertions(+), 52 deletions(-) diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 027667e6b0..14a0a27051 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -67,7 +67,8 @@ MODULES= \ ct_config \ ct_config_plain \ ct_config_xml \ - ct_slave + ct_slave \ + ct_suite_callback TARGET_MODULES= $(MODULES:%=$(EBIN)/%) diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index f2ca023cff..8e6cfb5565 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -24,7 +24,7 @@ -module(ct_framework). --export([init_tc/3, end_tc/3, get_suite/2, report/2, warn/1]). +-export([init_tc/3, end_tc/4, get_suite/2, report/2, warn/1]). -export([error_notification/4]). -export([overview_html_header/1]). @@ -207,7 +207,7 @@ init_tc2(Mod,Func,SuiteInfo,MergeResult,Config,DoInit) -> {skip,{require_failed_in_suite0,Reason}}; {error,Reason} -> {auto_skip,{require_failed,Reason}}; - FinalConfig -> + {ok, FinalConfig} -> case MergeResult of {error,Reason} -> %% suite0 configure finished now, report that @@ -216,13 +216,20 @@ init_tc2(Mod,Func,SuiteInfo,MergeResult,Config,DoInit) -> _ -> case get('$test_server_framework_test') of undefined -> - FinalConfig; + ct_suite_init(Mod, FuncSpec, FinalConfig); Fun -> Fun(init_tc, FinalConfig) end end end. - + +ct_suite_init(Mod, Func, [Config]) when is_list(Config) -> + case ct_suite_callback:init_tc( Mod, Func, Config) of + NewConfig when is_list(NewConfig) -> + {ok, [NewConfig]}; + Else -> + Else + end. add_defaults(Mod,Func,FuncInfo,DoInit) -> case (catch Mod:suite()) of @@ -418,14 +425,14 @@ try_set_default(Name,Key,Info,Where) -> %%% %%% @doc Test server framework callback, called by the test_server %%% when a test case is finished. -end_tc(?MODULE,error_in_suite,_) -> % bad start! +end_tc(?MODULE,error_in_suite,_, _) -> % bad start! ok; -end_tc(Mod,Func,{TCPid,Result,[Args]}) when is_pid(TCPid) -> - end_tc(Mod,Func,TCPid,Result,Args); -end_tc(Mod,Func,{Result,[Args]}) -> - end_tc(Mod,Func,self(),Result,Args). +end_tc(Mod,Func,{TCPid,Result,[Args]}, Return) when is_pid(TCPid) -> + end_tc(Mod,Func,TCPid,Result,Args,Return); +end_tc(Mod,Func,{Result,[Args]}, Return) -> + end_tc(Mod,Func,self(),Result,Args,Return). -end_tc(Mod,Func,TCPid,Result,Args) -> +end_tc(Mod,Func,TCPid,Result,Args,Return) -> case lists:keysearch(watchdog,1,Args) of {value,{watchdog,Dog}} -> test_server:timetrap_cancel(Dog); false -> ok @@ -448,8 +455,10 @@ end_tc(Mod,Func,TCPid,Result,Args) -> {_,GroupName,_Props} = Group -> case lists:keysearch(save_config,1,Args) of {value,{save_config,SaveConfig}} -> - ct_util:save_suite_data(last_saved_config, - {Mod,{group,GroupName}},SaveConfig), + ct_util:save_suite_data( + last_saved_config, + {Mod,{group,GroupName}}, + SaveConfig), Group; false -> Group @@ -492,7 +501,8 @@ end_tc(Mod,Func,TCPid,Result,Args) -> end, case get('$test_server_framework_test') of undefined -> - ok; + ct_suite_callback:end_tc( + Mod, FuncSpec, Args, Return); Fun -> Fun(end_tc, ok) end. diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index d0e6ba5fa6..df7f21a51f 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -54,6 +54,7 @@ logdir, config = [], event_handlers = [], + suite_callbacks = [], include = [], silent_connections, stylesheet, @@ -171,6 +172,9 @@ script_start1(Parent, Args) -> ([]) -> true end, false, Args), EvHandlers = event_handler_args2opts(Args), + SuiteCBs = get_start_opt(suite_callback, + fun(CBs) -> [list_to_atom(CB) || CB <- CBs] end, + [], Args), %% check flags and set corresponding application env variables @@ -234,6 +238,7 @@ script_start1(Parent, Args) -> StartOpts = #opts{label = Label, vts = Vts, shell = Shell, cover = Cover, logdir = LogDir, event_handlers = EvHandlers, + suite_callbacks = SuiteCBs, include = IncludeDirs, silent_connections = SilentConns, stylesheet = Stylesheet, @@ -305,6 +310,10 @@ script_start2(StartOpts = #opts{vts = undefined, SpecStartOpts#opts.scale_timetraps), AllEvHs = merge_vals([StartOpts#opts.event_handlers, SpecStartOpts#opts.event_handlers]), + AllSuiteCBs = merge_vals( + [StartOpts#opts.suite_callbacks, + SpecStartOpts#opts.suite_callbacks]), + AllInclude = merge_vals([StartOpts#opts.include, SpecStartOpts#opts.include]), application:set_env(common_test, include, AllInclude), @@ -315,6 +324,7 @@ script_start2(StartOpts = #opts{vts = undefined, logdir = LogDir, config = SpecStartOpts#opts.config, event_handlers = AllEvHs, + suite_callbacks = AllSuiteCBs, include = AllInclude, multiply_timetraps = MultTT, scale_timetraps = ScaleTT}} @@ -332,7 +342,8 @@ script_start2(StartOpts = #opts{vts = undefined, {error,no_testspec_specified}; {undefined,_} -> % no testspec used case check_and_install_configfiles(InitConfig, TheLogDir, - Opts#opts.event_handlers) of + Opts#opts.event_handlers, + Opts#opts.suite_callbacks) of ok -> % go on read tests from start flags script_start3(Opts#opts{config=InitConfig, logdir=TheLogDir}, Args); @@ -343,7 +354,8 @@ script_start2(StartOpts = #opts{vts = undefined, %% merge config from start flags with config from testspec AllConfig = merge_vals([InitConfig, Opts#opts.config]), case check_and_install_configfiles(AllConfig, TheLogDir, - Opts#opts.event_handlers) of + Opts#opts.event_handlers, + Opts#opts.suite_callbacks) of ok -> % read tests from spec {Run,Skip} = ct_testspec:prepare_tests(Terms, node()), do_run(Run, Skip, Opts#opts{config=AllConfig, @@ -358,7 +370,8 @@ script_start2(StartOpts, Args) -> InitConfig = ct_config:prepare_config_list(Args), LogDir = which(logdir, StartOpts#opts.logdir), case check_and_install_configfiles(InitConfig, LogDir, - StartOpts#opts.event_handlers) of + StartOpts#opts.event_handlers, + StartOpts#opts.suite_callbacks) of ok -> % go on read tests from start flags script_start3(StartOpts#opts{config=InitConfig, logdir=LogDir}, Args); @@ -366,11 +379,12 @@ script_start2(StartOpts, Args) -> Error end. -check_and_install_configfiles(Configs, LogDir, EvHandlers) -> +check_and_install_configfiles(Configs, LogDir, EvHandlers, SuiteCBs) -> case ct_config:check_config_files(Configs) of false -> install([{config,Configs}, - {event_handler,EvHandlers}], LogDir); + {event_handler,EvHandlers}, + {suite_callbacks,SuiteCBs}], LogDir); {value,{error,{nofile,File}}} -> {error,{cant_read_config_file,File}}; {value,{error,{wrong_config,Message}}}-> @@ -438,11 +452,13 @@ script_start4(#opts{vts = true, config = Config, event_handlers = EvHandlers, script_start4(#opts{label = Label, shell = true, config = Config, event_handlers = EvHandlers, + suite_callbacks = SuiteCBs, logdir = LogDir, testspecs = Specs}, _Args) -> %% label - used by ct_logs application:set_env(common_test, test_label, Label), - InstallOpts = [{config,Config},{event_handler,EvHandlers}], + InstallOpts = [{config,Config},{event_handler,EvHandlers}, + {suite_callbacks, SuiteCBs}], if Config == [] -> ok; true -> @@ -508,6 +524,7 @@ script_usage() -> "\n\t[-stylesheet CSSFile]" "\n\t[-cover CoverCfgFile]" "\n\t[-event_handler EvHandler1 EvHandler2 .. EvHandlerN]" + "\n\t[-suite_callback SuiteCB1 SuiteCB2 .. SuiteCBN]" "\n\t[-include InclDir1 InclDir2 .. InclDirN]" "\n\t[-no_auto_compile]" "\n\t[-multiply_timetraps N]" @@ -526,6 +543,7 @@ script_usage() -> "\n\t[-stylesheet CSSFile]" "\n\t[-cover CoverCfgFile]" "\n\t[-event_handler EvHandler1 EvHandler2 .. EvHandlerN]" + "\n\t[-suite_callback SuiteCB1 SuiteCB2 .. SuiteCBN]" "\n\t[-include InclDir1 InclDir2 .. InclDirN]" "\n\t[-no_auto_compile]" "\n\t[-multiply_timetraps N]" @@ -664,6 +682,9 @@ run_test1(StartOpts) -> end, Hs)) end, + %% Suite Callbacks + SuiteCBs = get_start_opt(suite_callbacks, value, [], StartOpts), + %% silent connections SilentConns = get_start_opt(silent_connections, fun(all) -> []; @@ -733,7 +754,9 @@ run_test1(StartOpts) -> Opts = #opts{label = Label, cover = Cover, step = Step, logdir = LogDir, config = CfgFiles, - event_handlers = EvHandlers, include = Include, + event_handlers = EvHandlers, + suite_callbacks = SuiteCBs, + include = Include, silent_connections = SilentConns, stylesheet = Stylesheet, multiply_timetraps = MultiplyTT, @@ -784,11 +807,16 @@ run_spec_file(Relaxed, SpecOpts#opts.event_handlers]), AllInclude = merge_vals([Opts#opts.include, SpecOpts#opts.include]), + + AllSuiteCBs = merge_vals([Opts#opts.suite_callbacks, + SpecOpts#opts.suite_callbacks]), + application:set_env(common_test, include, AllInclude), case check_and_install_configfiles(AllConfig, which(logdir,LogDir), - AllEvHs) of + AllEvHs, + AllSuiteCBs) of ok -> Opts1 = Opts#opts{label = Label, cover = Cover, @@ -798,7 +826,8 @@ run_spec_file(Relaxed, include = AllInclude, testspecs = AbsSpecs, multiply_timetraps = MultTT, - scale_timetraps = ScaleTT}, + scale_timetraps = ScaleTT, + suite_callbacks = AllSuiteCBs}, {Run,Skip} = ct_testspec:prepare_tests(TS, node()), reformat_result(catch do_run(Run, Skip, Opts1, StartOpts)); {error,GCFReason} -> @@ -808,10 +837,12 @@ run_spec_file(Relaxed, run_prepared(Run, Skip, Opts = #opts{logdir = LogDir, config = CfgFiles, - event_handlers = EvHandlers}, + event_handlers = EvHandlers, + suite_callbacks = SuiteCBs}, StartOpts) -> LogDir1 = which(logdir, LogDir), - case check_and_install_configfiles(CfgFiles, LogDir1, EvHandlers) of + case check_and_install_configfiles(CfgFiles, LogDir1, + EvHandlers, SuiteCBs) of ok -> reformat_result(catch do_run(Run, Skip, Opts#opts{logdir = LogDir1}, StartOpts)); @@ -842,7 +873,8 @@ check_config_file(Callback, File)-> run_dir(Opts = #opts{logdir = LogDir, config = CfgFiles, - event_handlers = EvHandlers}, StartOpts) -> + event_handlers = EvHandlers, + suite_callbacks = SuiteCB }, StartOpts) -> LogDir1 = which(logdir, LogDir), Opts1 = Opts#opts{logdir = LogDir1}, AbsCfgFiles = @@ -863,7 +895,9 @@ run_dir(Opts = #opts{logdir = LogDir, check_config_file(Callback, File) end, FileList)} end, CfgFiles), - case install([{config,AbsCfgFiles},{event_handler,EvHandlers}], LogDir1) of + case install([{config,AbsCfgFiles}, + {event_handler,EvHandlers}, + {suite_callbacks, SuiteCB}], LogDir1) of ok -> ok; {error,IReason} -> exit(IReason) end, @@ -968,7 +1002,8 @@ run_testspec1(TestSpec) -> application:set_env(common_test, include, AllInclude), LogDir1 = which(logdir,Opts#opts.logdir), case check_and_install_configfiles(Opts#opts.config, LogDir1, - Opts#opts.event_handlers) of + Opts#opts.event_handlers, + Opts#opts.suite_callbacks) of ok -> Opts1 = Opts#opts{testspecs = [], logdir = LogDir1, @@ -986,6 +1021,7 @@ get_data_for_node(#testspec{label = Labels, config = Cfgs, userconfig = UsrCfgs, event_handler = EvHs, + suite_callbacks = SuCBs, include = Incl, multiply_timetraps = MTs, scale_timetraps = STs}, Node) -> @@ -1000,12 +1036,14 @@ get_data_for_node(#testspec{label = Labels, ConfigFiles = [{?ct_config_txt,F} || {N,F} <- Cfgs, N==Node] ++ [CBF || {N,CBF} <- UsrCfgs, N==Node], EvHandlers = [{H,A} || {N,H,A} <- EvHs, N==Node], + SuiteCBs = [CB || {N,CB} <- SuCBs, N==Node], Include = [I || {N,I} <- Incl, N==Node], #opts{label = Label, logdir = LogDir, cover = Cover, config = ConfigFiles, event_handlers = EvHandlers, + suite_callbacks = SuiteCBs, include = Include, multiply_timetraps = MT, scale_timetraps = ST}. @@ -2263,12 +2301,17 @@ do_trace(Terms) -> dbg:tracer(), dbg:p(self(), [sos,call]), lists:foreach(fun({m,M}) -> - case dbg:tpl(M,[{'_',[],[{return_trace}]}]) of + case dbg:tpl(M,x) of + {error,What} -> exit({error,{tracing_failed,What}}); + _ -> ok + end; + ({me,M}) -> + case dbg:tp(M,x) of {error,What} -> exit({error,{tracing_failed,What}}); _ -> ok end; ({f,M,F}) -> - case dbg:tpl(M,F,[{'_',[],[{return_trace}]}]) of + case dbg:tpl(M,F,x) of {error,What} -> exit({error,{tracing_failed,What}}); _ -> ok end; diff --git a/lib/common_test/src/ct_suite_callback.erl b/lib/common_test/src/ct_suite_callback.erl index db4ac9a4ec..52ce5b92d1 100644 --- a/lib/common_test/src/ct_suite_callback.erl +++ b/lib/common_test/src/ct_suite_callback.erl @@ -39,8 +39,8 @@ -spec init(State :: term()) -> ok | {error, Reason :: term()}. init(Opts) -> - add_new_callbacks(Opts), - ok. + call(get_new_callbacks(Opts), fun call_init/2, ok). + %% @doc Called after all suites are done. -spec terminate(Config :: proplist(),State :: term()) -> @@ -51,15 +51,18 @@ terminate(Config, State) -> %% @doc Called as each test case is started. This includes all configuration %% tests. -spec init_tc(Mod :: atom(), Func :: atom(), Config :: proplist()) -> - {ok, NewConfig :: proplist()} | + NewConfig :: proplist() | {skip, Reason :: term()} | {auto_skip, Reason :: term()} | {error, Reason :: term()}. init_tc(Mod, init_per_suite, Config) -> - add_new_callbacks(Config), - {ok, Config}; + NewConfig = call(get_new_callbacks(Config) ++ get_callbacks(), + fun call_init/2, remove(?config_name,Config)), + + Data = ct_util:read_suite_data(?config_name), + [{suitedata, Data} | NewConfig]; init_tc(Mod, Func, Config) -> - {ok, Config}. + Config. %% @doc Called as each test case is completed. This includes all configuration %% tests. @@ -67,26 +70,54 @@ init_tc(Mod, Func, Config) -> Func :: atom(), Config :: proplist(), Result :: term()) -> - {ok, NewConfig :: proplist()} | + NewConfig :: proplist() | {skip, Reason :: term()} | {auto_skip, Reason :: term()} | {error, Reason :: term()} | ok. +end_tc(Mod, init_per_suite, _, Return) -> + NewConfig = call(get_new_callbacks(Return) ++ get_callbacks(), + fun call_init/2, remove(suitedata, remove(?config_name,Return))), + + Data = ct_util:read_suite_data(?config_name), + [{suitedata, Data} | NewConfig]; end_tc(Mod, Func, Config, Result) -> - {ok, Config}. + Result. %% Iternal Functions -add_new_callbacks(Config) -> - NewCBConfs = lists:flatmap(fun({?config_name, CallbackConfigs}) -> - CallbackConfigs; - (_) -> - [] - end, Config), - CBStates = lists:map(fun call_init/1,NewCBConfs), - ct_util:save_suite_data_async(?config_name, CBStates). - -call_init({Mod, Config}) -> - {Mod, Mod:init(Config)}. - - +get_new_callbacks(Config) -> + lists:flatmap(fun({?config_name, CallbackConfigs}) -> + CallbackConfigs; + (_) -> + [] + end, Config). + +get_callbacks() -> + ct_util:read_suite_data(?config_name). + +call_init(Mod, Config) when is_atom(Mod) -> + call_init({Mod, undefined}, Config); +call_init({Mod, State}, Config) -> + {{Mod, running, Mod:init(State)}, Config}; +call_init({Mod, running, State}, Config) -> + {{Mod, running, State}, Config}. + +%% Generic call function +call(Fun, Config) -> + call(get_callbacks(), Fun, Config). + +call(CBs, Fun, Config) -> + call(CBs, Fun, Config, []). + +call([CB | Rest], Fun, Config, NewCBs) -> + {NewCB, NewConf} = Fun(CB,Config), + call(Rest, Fun, NewConf, [NewCB | NewCBs]); +call([], _Fun, Config, NewCBs) -> + ct_util:save_suite_data_async(?config_name, NewCBs), + Config. + + +remove(Key,List) -> + [Conf || Conf <- List, + element(1,Conf) =/= Key]. diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index f5069427a2..942241da6c 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -625,6 +625,20 @@ add_tests([{event_handler,Node,H,Args}|Ts],Spec) when is_atom(H) -> Node1 = ref2node(Node,Spec#testspec.nodes), add_tests(Ts,Spec#testspec{event_handler=[{Node1,H,Args}|EvHs]}); +%% --- suite_callbacks -- +add_tests([{suite_callbacks, all_nodes, CBs} | Ts], Spec) -> + Tests = [{suite_callbacks,N,CBs} || N <- list_nodes(Spec)], + add_tests(Tests ++ Ts, Spec); +add_tests([{suite_callbacks, Node, [CB|CBs]}|Ts], Spec) -> + SuiteCbs = Spec#testspec.suite_callbacks, + Node1 = ref2node(Node,Spec#testspec.nodes), + add_tests([{suite_callbacks, Node, CBs} | Ts], + Spec#testspec{suite_callbacks = [{Node1,CB} | SuiteCbs]}); +add_tests([{suite_callbacks, _Node, []}|Ts], Spec) -> + add_tests(Ts, Spec); +add_tests([{suite_callbacks, CBs}|Ts], Spec) -> + add_tests([{suite_callbacks, all_nodes, CBs}|Ts], Spec); + %% --- include --- add_tests([{include,all_nodes,InclDirs}|Ts],Spec) -> Tests = lists:map(fun(N) -> {include,N,InclDirs} end, list_nodes(Spec)), @@ -1051,6 +1065,8 @@ valid_terms() -> {event_handler,2}, {event_handler,3}, {event_handler,4}, + {suite_callbacks,2}, + {suite_callbacks,3}, {multiply_timetraps,2}, {multiply_timetraps,3}, {scale_timetraps,2}, diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index b5ab4cbb6e..4696b3c954 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -32,7 +32,9 @@ -export([close_connections/0]). --export([save_suite_data/3, save_suite_data/2, read_suite_data/1, +-export([save_suite_data/3, save_suite_data/2, + save_suite_data_async/3, save_suite_data_async/2, + read_suite_data/1, delete_suite_data/0, delete_suite_data/1, match_delete_suite_data/1, delete_testdata/0, delete_testdata/1, set_testdata/1, get_testdata/1, update_testdata/2]). @@ -159,6 +161,11 @@ do_start(Parent,Mode,LogDir) -> ok end, {StartTime,TestLogDir} = ct_logs:init(Mode), + + %% Initiate suite_callbacks + ok = ct_suite_callback:init(Opts), + + ct_event:notify(#event{name=test_start, node=node(), data={StartTime, @@ -182,12 +189,19 @@ read_opts() -> {error,{bad_installation,Error}} end. + save_suite_data(Key, Value) -> call({save_suite_data, {Key, undefined, Value}}). save_suite_data(Key, Name, Value) -> call({save_suite_data, {Key, Name, Value}}). +save_suite_data_async(Key, Value) -> + save_suite_data_async(Key, undefined, Value). + +save_suite_data_async(Key, Name, Value) -> + cast({save_suite_data, {Key, Name, Value}}). + read_suite_data(Key) -> call({read_suite_data, Key}). @@ -308,6 +322,9 @@ loop(Mode,TestData,StartDir) -> ct_config:stop(), file:set_cwd(StartDir), return(From,ok); + {Ref, _Msg} when is_reference(Ref) -> + %% This clause is used when doing cast operations. + loop(Mode,TestData,StartDir); {get_mode,From} -> return(From,Mode), loop(Mode,TestData,StartDir); @@ -713,6 +730,9 @@ call(Msg) -> return({To,Ref},Result) -> To ! {Ref, Result}. +cast(Msg) -> + ct_util_server ! {Msg, {ct_util_server, make_ref()}}. + seconds(T) -> test_server:seconds(T). diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index ee973f6220..99f029bc0e 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -36,6 +36,7 @@ config=[], userconfig=[], event_handler=[], + suite_callbacks=[], include=[], multiply_timetraps=[], scale_timetraps=[], -- cgit v1.2.3