diff options
Diffstat (limited to 'lib/common_test/src')
22 files changed, 4622 insertions, 1729 deletions
diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index e7e2d1275d..84b122b5e4 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -1,19 +1,19 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 2003-2009. All Rights Reserved. -# +# +# Copyright Ericsson AB 2003-2011. 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% # @@ -63,7 +63,13 @@ MODULES= \ ct_telnet_client \ ct_make \ vts \ - unix_telnet + unix_telnet \ + ct_config \ + ct_config_plain \ + ct_config_xml \ + ct_slave \ + ct_hooks\ + ct_hooks_lock TARGET_MODULES= $(MODULES:%=$(EBIN)/%) diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src index 7b72932ad4..b42173f412 100644 --- a/lib/common_test/src/common_test.app.src +++ b/lib/common_test/src/common_test.app.src @@ -1,19 +1,19 @@ % This is an -*- erlang -*- file. %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2009-2010. 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% {application, common_test, @@ -42,10 +42,15 @@ ct_testspec, ct_util, unix_telnet, - vts + vts, + ct_config, + ct_config_plain, + ct_config_xml, + ct_slave ]}, {registered, [ct_logs, ct_util_server, + ct_config_server, ct_make_ref, vts, ct_master, diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index 8ae041e5b4..dfec2b7a67 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2003-2011. 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% %% @@ -59,18 +59,22 @@ %% Test suite API -export([require/1, require/2, get_config/1, get_config/2, get_config/3, + reload_config/1, log/1, log/2, log/3, print/1, print/2, print/3, pal/1, pal/2, pal/3, fail/1, comment/1, - testcases/2, userdata/2, userdata/3]). + testcases/2, userdata/2, userdata/3, + timetrap/1, sleep/1]). + +%% New API for manipulating with config handlers +-export([add_config/2, remove_config/2]). %% Other interface functions -export([get_status/0, abort_current_testcase/1, encrypt_config_file/2, encrypt_config_file/3, decrypt_config_file/2, decrypt_config_file/3]). - -export([get_target_name/1]). -export([parse_table/1, listenv/1]). @@ -93,7 +97,7 @@ %%% <code>install([{config,["config_node.ctc","config_user.ctc"]}])</code>.</p> %%% %%% <p>Note that this function is automatically run by the -%%% <code>run_test</code> script.</p> +%%% <code>ct_run</code> program.</p> install(Opts) -> ct_run:install(Opts). @@ -134,22 +138,31 @@ run(TestDirs) -> %%%----------------------------------------------------------------- %%% @spec run_test(Opts) -> Result %%% Opts = [OptTuples] -%%% OptTuples = {config,CfgFiles} | {dir,TestDirs} | {suite,Suites} | -%%% {testcase,Cases} | {group,Groups} | {spec,TestSpecs} | -%%% {allow_user_terms,Bool} | {logdir,LogDir} | -%%% {silent_connections,Conns} | {cover,CoverSpecFile} | -%%% {step,StepOpts} | {event_handler,EventHandlers} | {include,InclDirs} | -%%% {auto_compile,Bool} | {repeat,N} | {duration,DurTime} | -%%% {until,StopTime} | {force_stop,Bool} | {decrypt,DecryptKeyOrFile} | -%%% {refresh_logs,LogDir} | {basic_html,Bool} -%%% CfgFiles = [string()] | string() +%%% OptTuples = {dir,TestDirs} | {suite,Suites} | {group,Groups} | +%%% {testcase,Cases} | {spec,TestSpecs} | {label,Label} | +%%% {config,CfgFiles} | {userconfig, UserConfig} | +%%% {allow_user_terms,Bool} | {logdir,LogDir} | +%%% {silent_connections,Conns} | {stylesheet,CSSFile} | +%%% {cover,CoverSpecFile} | {step,StepOpts} | +%%% {event_handler,EventHandlers} | {include,InclDirs} | +%%% {auto_compile,Bool} | {multiply_timetraps,M} | {scale_timetraps,Bool} | +%%% {repeat,N} | {duration,DurTime} | {until,StopTime} | +%%% {force_stop,Bool} | {decrypt,DecryptKeyOrFile} | +%%% {refresh_logs,LogDir} | {basic_html,Bool} | +%%% {ct_hooks, CTHs} %%% TestDirs = [string()] | string() %%% Suites = [string()] | string() %%% Cases = [atom()] | atom() %%% Groups = [atom()] | atom() %%% TestSpecs = [string()] | string() +%%% Label = string() | atom() +%%% CfgFiles = [string()] | string() +%%% UserConfig = [{CallbackMod,CfgStrings}] | {CallbackMod,CfgStrings} +%%% CallbackMod = atom() +%%% CfgStrings = [string()] | string() %%% LogDir = string() %%% Conns = all | [atom()] +%%% CSSFile = string() %%% CoverSpecFile = string() %%% StepOpts = [StepOpt] | [] %%% StepOpt = config | keep_inactive @@ -157,19 +170,24 @@ run(TestDirs) -> %%% EH = atom() | {atom(),InitArgs} | {[atom()],InitArgs} %%% InitArgs = [term()] %%% InclDirs = [string()] | string() +%%% M = integer() %%% N = integer() %%% DurTime = string(HHMMSS) %%% StopTime = string(YYMoMoDDHHMMSS) | string(HHMMSS) %%% DecryptKeyOrFile = {key,DecryptKey} | {file,DecryptFile} %%% DecryptKey = string() %%% DecryptFile = string() +%%% CTHs = [CTHModule | {CTHModule, CTHInitArgs}] +%%% CTHModule = atom() +%%% CTHInitArgs = term() %%% Result = [TestResult] | {error,Reason} %%% @doc Run tests as specified by the combination of options in <code>Opts</code>. -%%% The options are the same as those used with the <code>run_test</code> script. +%%% The options are the same as those used with the +%%% <seealso marker="ct_run#ct_run"><code>ct_run</code></seealso> program. %%% Note that here a <code>TestDir</code> can be used to point out the path to %%% a <code>Suite</code>. Note also that the option <code>testcase</code> -%%% corresponds to the <code>-case</code> option in the <code>run_test</code> -%%% script. Configuration files specified in <code>Opts</code> will be +%%% corresponds to the <code>-case</code> option in the <code>ct_run</code> +%%% program. Configuration files specified in <code>Opts</code> will be %%% installed automatically at startup. run_test(Opts) -> ct_run:run_test(Opts). @@ -211,7 +229,7 @@ step(TestDir,Suite,Case,Opts) -> %%% %%% <p>From this mode all test case support functions can be executed %%% directly from the erlang shell. The interactive mode can also be -%%% started from the unix command line with <code>run_test -shell +%%% started from the OS command line with <code>ct_run -shell %%% [-config File...]</code>.</p> %%% %%% <p>If any functions using "required config data" (e.g. telnet or @@ -269,7 +287,7 @@ stop_interactive() -> %%% @see get_config/2 %%% @see get_config/3 require(Required) -> - ct_util:require(Required). + ct_config:require(Required). %%%----------------------------------------------------------------- %%% @spec require(Name,Required) -> ok | {error,Reason} @@ -304,19 +322,19 @@ require(Required) -> %%% @see get_config/2 %%% @see get_config/3 require(Name,Required) -> - ct_util:require(Name,Required). + ct_config:require(Name,Required). %%%----------------------------------------------------------------- %%% @spec get_config(Required) -> Value %%% @equiv get_config(Required,undefined,[]) get_config(Required) -> - ct_util:get_config(Required,undefined,[]). + ct_config:get_config(Required,undefined,[]). %%%----------------------------------------------------------------- %%% @spec get_config(Required,Default) -> Value %%% @equiv get_config(Required,Default,[]) get_config(Required,Default) -> - ct_util:get_config(Required,Default,[]). + ct_config:get_config(Required,Default,[]). %%%----------------------------------------------------------------- %%% @spec get_config(Required,Default,Opts) -> ValueOrElement @@ -375,7 +393,26 @@ get_config(Required,Default) -> %%% @see require/1 %%% @see require/2 get_config(Required,Default,Opts) -> - ct_util:get_config(Required,Default,Opts). + ct_config:get_config(Required,Default,Opts). + +%%%----------------------------------------------------------------- +%%% @spec reload_config(Required) -> ValueOrElement +%%% Required = KeyOrName | {KeyOrName,SubKey} +%%% KeyOrName = atom() +%%% SubKey = atom() +%%% ValueOrElement = term() +%%% +%%% @doc Reload config file which contains specified configuration key. +%%% +%%% <p>This function performs updating of the configuration data from which the +%%% given configuration variable was read, and returns the (possibly) new +%%% value of this variable.</p> +%%% <p>Note that if some variables were present in the configuration but are not loaded +%%% using this function, they will be removed from the configuration table together +%%% with their aliases.</p> +%%% +reload_config(Required)-> + ct_config:reload_config(Required). %%%----------------------------------------------------------------- %%% @spec log(Format) -> ok @@ -661,7 +698,7 @@ userdata(TestDir, Suite, Case) -> %%%----------------------------------------------------------------- -%%% @spec get_status() -> TestStatus | {error,Reason} +%%% @spec get_status() -> TestStatus | {error,Reason} | no_tests_running %%% TestStatus = [StatusElem] %%% StatusElem = {current,{Suite,TestCase}} | {successful,Successful} | %%% {failed,Failed} | {skipped,Skipped} | {total,Total} @@ -734,7 +771,7 @@ abort_current_testcase(Reason) -> %%% <p>See the <code>crypto</code> application for details on DES3 %%% encryption/decryption.</p> encrypt_config_file(SrcFileName, EncryptFileName) -> - ct_util:encrypt_config_file(SrcFileName, EncryptFileName). + ct_config:encrypt_config_file(SrcFileName, EncryptFileName). %%%----------------------------------------------------------------- %%% @spec encrypt_config_file(SrcFileName, EncryptFileName, KeyOrFile) -> @@ -754,7 +791,7 @@ encrypt_config_file(SrcFileName, EncryptFileName) -> %%% <p>See the <code>crypto</code> application for details on DES3 %%% encryption/decryption.</p> encrypt_config_file(SrcFileName, EncryptFileName, KeyOrFile) -> - ct_util:encrypt_config_file(SrcFileName, EncryptFileName, KeyOrFile). + ct_config:encrypt_config_file(SrcFileName, EncryptFileName, KeyOrFile). %%%----------------------------------------------------------------- %%% @spec decrypt_config_file(EncryptFileName, TargetFileName) -> @@ -770,7 +807,7 @@ encrypt_config_file(SrcFileName, EncryptFileName, KeyOrFile) -> %%% <code>.ct_config.crypt</code> in the current directory, or the %%% home directory of the user (it is searched for in that order).</p> decrypt_config_file(EncryptFileName, TargetFileName) -> - ct_util:decrypt_config_file(EncryptFileName, TargetFileName). + ct_config:decrypt_config_file(EncryptFileName, TargetFileName). %%%----------------------------------------------------------------- %%% @spec decrypt_config_file(EncryptFileName, TargetFileName, KeyOrFile) -> @@ -785,5 +822,65 @@ decrypt_config_file(EncryptFileName, TargetFileName) -> %%% file contents is saved in the target file. The key must have the %%% the same value as that used for encryption.</p> decrypt_config_file(EncryptFileName, TargetFileName, KeyOrFile) -> - ct_util:decrypt_config_file(EncryptFileName, TargetFileName, KeyOrFile). + ct_config:decrypt_config_file(EncryptFileName, TargetFileName, KeyOrFile). + + +%%%----------------------------------------------------------------- +%%% @spec add_config(Callback, Config) -> ok | {error, Reason} +%%% Callback = atom() +%%% Config = string() +%%% Reason = term() +%%% +%%% @doc <p>This function loads configuration variables using the +%%% given callback module and configuration string. Callback module +%%% should be either loaded or present in the code part. Loaded +%%% configuration variables can later be removed using +%%% <code>remove_config/2</code> function.</p> +add_config(Callback, Config)-> + ct_config:add_config(Callback, Config). +%%%----------------------------------------------------------------- +%%% @spec remove_config(Callback, Config) -> ok +%%% Callback = atom() +%%% Config = string() +%%% Reason = term() +%%% +%%% @doc <p>This function removes configuration variables (together with +%%% their aliases) which were loaded with specified callback module and +%%% configuration string.</p> +remove_config(Callback, Config) -> + ct_config:remove_config(Callback, Config). + +%%%----------------------------------------------------------------- +%%% @spec timetrap(Time) -> ok +%%% Time = {hours,Hours} | {minutes,Mins} | {seconds,Secs} | Millisecs | infinity +%%% Hours = integer() +%%% Mins = integer() +%%% Secs = integer() +%%% Millisecs = integer() | float() +%%% +%%% @doc <p>Use this function to set a new timetrap for the running test case.</p> +timetrap(Time) -> + test_server:timetrap(Time). + +%%%----------------------------------------------------------------- +%%% @spec sleep(Time) -> ok +%%% Time = {hours,Hours} | {minutes,Mins} | {seconds,Secs} | Millisecs | infinity +%%% Hours = integer() +%%% Mins = integer() +%%% Secs = integer() +%%% Millisecs = integer() | float() +%%% +%%% @doc <p>This function, similar to <c>timer:sleep/1</c>, suspends the test +%%% case for specified time. However, this function also multiplies +%%% <c>Time</c> with the 'multiply_timetraps' value (if set) and under +%%% certain circumstances also scales up the time automatically +%%% if 'scale_timetraps' is set to true (default is false).</p> +sleep({hours,Hs}) -> + sleep(trunc(Hs * 1000 * 60 * 60)); +sleep({minutes,Ms}) -> + sleep(trunc(Ms * 1000 * 60)); +sleep({seconds,Ss}) -> + sleep(trunc(Ss * 1000)); +sleep(Time) -> + test_server:adjusted_sleep(Time). diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl new file mode 100644 index 0000000000..6b75937668 --- /dev/null +++ b/lib/common_test/src/ct_config.erl @@ -0,0 +1,804 @@ +%%-------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. 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% +%%---------------------------------------------------------------------- +%% File : ct_config.erl +%% Description : CT module for reading and manipulating of configuration +%% data +%% +%% Created : 15 February 2010 +%%---------------------------------------------------------------------- +-module(ct_config). + +-export([start/1, stop/0]). + +-export([read_config_files/1, + get_config_file_list/1]). + +-export([require/1, require/2]). + +-export([get_config/1, get_config/2, get_config/3, + get_all_config/0]). + +-export([set_default_config/2, set_default_config/3]). + +-export([delete_default_config/1]). + +-export([reload_config/1, update_config/2]). + +-export([release_allocated/0]). + +-export([encrypt_config_file/2, encrypt_config_file/3, + decrypt_config_file/2, decrypt_config_file/3, + get_crypt_key_from_file/0, get_crypt_key_from_file/1]). + +-export([get_ref_from_name/1, get_name_from_ref/1, get_key_from_name/1]). + +-export([check_config_files/1, add_default_callback/1, prepare_config_list/1]). + +-export([add_config/2, remove_config/2]). + +-include("ct_util.hrl"). + +-define(cryptfile, ".ct_config.crypt"). + +-record(ct_conf,{key,value,handler,config,ref,name='_UNDEF',default=false}). + +start(Mode) -> + case whereis(ct_config_server) of + undefined -> + Me = self(), + Pid = spawn_link(fun() -> do_start(Me) end), + receive + {Pid,started} -> Pid; + {Pid,Error} -> exit(Error) + end; + Pid -> + case ct_util:get_mode() of + interactive when Mode==interactive -> + Pid; + interactive -> + {error,interactive_mode}; + _OtherMode -> + Pid + end + end. + +do_start(Parent) -> + process_flag(trap_exit,true), + register(ct_config_server,self()), + ct_util:create_table(?attr_table,bag,#ct_conf.key), + {ok,StartDir} = file:get_cwd(), + Opts = case ct_util:read_opts() of + {ok,Opts1} -> + Opts1; + Error -> + Parent ! {self(),Error}, + exit(Error) + end, + case read_config_files(Opts) of + ok -> + Parent ! {self(),started}, + loop(StartDir); + ReadError -> + Parent ! {self(),ReadError}, + exit(ReadError) + end. + +stop() -> + case whereis(ct_config_server) of + undefined -> ok; + _ -> call({stop}) + end. + +call(Msg) -> + MRef = erlang:monitor(process, whereis(ct_config_server)), + Ref = make_ref(), + ct_config_server ! {Msg,{self(),Ref}}, + receive + {Ref, Result} -> + erlang:demonitor(MRef, [flush]), + Result; + {'DOWN',MRef,process,_,Reason} -> + {error,{ct_util_server_down,Reason}} + end. + +return({To,Ref},Result) -> + To ! {Ref, Result}. + +loop(StartDir) -> + receive + {{require,Name,Tag,SubTags},From} -> + Result = do_require(Name,Tag,SubTags), + return(From,Result), + loop(StartDir); + {{set_default_config,{Config,Scope}},From} -> + set_config(Config,{true,Scope}), + return(From,ok), + loop(StartDir); + {{set_default_config,{Name,Config,Scope}},From} -> + set_config(Name,Config,{true,Scope}), + return(From,ok), + loop(StartDir); + {{delete_default_config,Scope},From} -> + delete_config({true,Scope}), + return(From,ok), + loop(StartDir); + {{update_config,{Name,NewConfig}},From} -> + update_conf(Name,NewConfig), + return(From,ok), + loop(StartDir); + {{reload_config, KeyOrName},From}-> + NewValue = reload_conf(KeyOrName), + return(From, NewValue), + loop(StartDir); + {{stop},From} -> + ets:delete(?attr_table), + file:set_cwd(StartDir), + return(From,ok) + end. + +set_default_config(NewConfig, Scope) -> + call({set_default_config, {NewConfig, Scope}}). + +set_default_config(Name, NewConfig, Scope) -> + call({set_default_config, {Name, NewConfig, Scope}}). + +delete_default_config(Scope) -> + call({delete_default_config, Scope}). + +update_config(Name, Config) -> + call({update_config, {Name, Config}}). + +reload_config(KeyOrName) -> + call({reload_config, KeyOrName}). + +process_default_configs(Opts) -> + case lists:keysearch(config, 1, Opts) of + {value,{_,Files=[File|_]}} when is_list(File) -> + Files; + {value,{_,File=[C|_]}} when is_integer(C) -> + [File]; + {value,{_,[]}} -> + []; + false -> + [] + end. + +process_user_configs(Opts, Acc) -> + case lists:keytake(userconfig, 1, Opts) of + false -> + lists:reverse(Acc); + {value, {userconfig, Config=[{_,_}|_]}, NewOpts} -> + Acc1 = lists:map(fun({_Callback, []}=Cfg) -> + Cfg; + ({Callback, Files=[File|_]}) when is_list(File) -> + {Callback, Files}; + ({Callback, File=[C|_]}) when is_integer(C) -> + {Callback, [File]} + end, Config), + process_user_configs(NewOpts, lists:reverse(Acc1)++Acc); + {value, {userconfig, {Callback, []}}, NewOpts} -> + process_user_configs(NewOpts, [{Callback, []} | Acc]); + {value, {userconfig, {Callback, Files=[File|_]}}, NewOpts} when is_list(File) -> + process_user_configs(NewOpts, [{Callback, Files} | Acc]); + {value, {userconfig, {Callback, File=[C|_]}}, NewOpts} when is_integer(C) -> + process_user_configs(NewOpts, [{Callback, [File]} | Acc]) + end. + +get_config_file_list(Opts) -> + DefaultConfigs = process_default_configs(Opts), + CfgFiles = + if + DefaultConfigs == []-> + []; + true-> + [{?ct_config_txt, DefaultConfigs}] + end ++ + process_user_configs(Opts, []), + CfgFiles. + +add_default_callback(Opts) -> + case lists:keytake(config, 1, Opts) of + {value, {config, [File | _] = Files}, NoConfigOpts} + when is_integer(File) =/= true -> + [{config, lists:flatmap(fun add_def_cb/1, Files)} | NoConfigOpts]; + {value, {config, File}, NoConfigOpts} -> + [{config, add_def_cb(File)} | NoConfigOpts]; + false -> + Opts + end. + +add_def_cb([]) -> + []; +add_def_cb(Config) when is_tuple(Config) -> + [Config]; +add_def_cb([H|_T] = Config ) when is_integer(H) -> + [{?ct_config_txt, [Config]}]. + +read_config_files(Opts) -> + AddCallback = fun(CallBack, []) -> + [{CallBack, []}]; + (CallBack, [F|_]=Files) when is_integer(F) -> + [{CallBack, Files}]; + (CallBack, [F|_]=Files) when is_list(F) -> + lists:map(fun(X) -> {CallBack, X} end, Files) + end, + + ConfigFiles = case lists:keyfind(config, 1, Opts) of + {config,ConfigLists}-> + lists:foldr(fun({Callback,Files}, Acc) -> + AddCallback(Callback,Files) + ++ Acc + end,[],ConfigLists); + false-> + [] + end, + read_config_files_int(ConfigFiles, fun store_config/3). + +read_config_files_int([{Callback, File}|Files], FunToSave) -> + case Callback:read_config(File) of + {ok, Config} -> + FunToSave(Config, Callback, File), + read_config_files_int(Files, FunToSave); + {error, ErrorName, ErrorDetail}-> + {user_error, {ErrorName, File, ErrorDetail}} + end; +read_config_files_int([], _FunToSave) -> + ok. + +store_config(Config, Callback, File) -> + [ets:insert(?attr_table, + #ct_conf{key=Key, + value=Val, + handler=Callback, + config=File, + ref=ct_util:ct_make_ref(), + default=false}) || + {Key,Val} <- Config]. + +keyfindall(Key, Pos, List) -> + [E || E <- List, element(Pos, E) =:= Key]. + +rewrite_config(Config, Callback, File) -> + OldRows = ets:match_object(?attr_table, + #ct_conf{handler=Callback, + config=File,_='_'}), + ets:match_delete(?attr_table, + #ct_conf{handler=Callback, + config=File,_='_'}), + Updater = fun({Key, Value}) -> + case keyfindall(Key, #ct_conf.key, OldRows) of + []-> + ets:insert(?attr_table, + #ct_conf{key=Key, + value=Value, + handler=Callback, + config=File, + ref=ct_util:ct_make_ref()}); + RowsToUpdate -> + Inserter = fun(Row) -> + ets:insert(?attr_table, + Row#ct_conf{value=Value, + ref=ct_util:ct_make_ref()}) + end, + lists:foreach(Inserter, RowsToUpdate) + end + end, + [Updater({Key, Value})||{Key, Value}<-Config]. + +set_config(Config,Default) -> + set_config('_UNDEF',Config,Default). + +set_config(Name,Config,Default) -> + [ets:insert(?attr_table, + #ct_conf{key=Key,value=Val,ref=ct_util:ct_make_ref(), + name=Name,default=Default}) || + {Key,Val} <- Config]. + +get_config(KeyOrName) -> + get_config(KeyOrName,undefined,[]). + +get_config(KeyOrName,Default) -> + get_config(KeyOrName,Default,[]). + +get_config(KeyOrName,Default,Opts) when is_atom(KeyOrName) -> + case lookup_config(KeyOrName) of + [] -> + Default; + [{_Ref,Val}|_] = Vals -> + case {lists:member(all,Opts),lists:member(element,Opts)} of + {true,true} -> + [{KeyOrName,V} || {_R,V} <- lists:sort(Vals)]; + {true,false} -> + [V || {_R,V} <- lists:sort(Vals)]; + {false,true} -> + {KeyOrName,Val}; + {false,false} -> + Val + end + end; + +get_config({KeyOrName,SubKey},Default,Opts) -> + case lookup_config(KeyOrName) of + [] -> + Default; + Vals -> + Vals1 = case [Val || {_Ref,Val} <- lists:sort(Vals)] of + Result=[L|_] when is_list(L) -> + case L of + [{_,_}|_] -> + Result; + _ -> + [] + end; + _ -> + [] + end, + case get_subconfig([SubKey],Vals1,[],Opts) of + {ok,[{_,SubVal}|_]=SubVals} -> + case {lists:member(all,Opts),lists:member(element,Opts)} of + {true,true} -> + [{{KeyOrName,SubKey},Val} || {_,Val} <- SubVals]; + {true,false} -> + [Val || {_SubKey,Val} <- SubVals]; + {false,true} -> + {{KeyOrName,SubKey},SubVal}; + {false,false} -> + SubVal + end; + _ -> + Default + end + end. + +get_subconfig(SubKeys,Values) -> + get_subconfig(SubKeys,Values,[],[]). + +get_subconfig(SubKeys,[Value|Rest],Mapped,Opts) -> + case do_get_config(SubKeys,Value,[]) of + {ok,SubMapped} -> + case lists:member(all,Opts) of + true -> + get_subconfig(SubKeys,Rest,Mapped++SubMapped,Opts); + false -> + {ok,SubMapped} + end; + _Error -> + get_subconfig(SubKeys,Rest,Mapped,Opts) + end; +get_subconfig(SubKeys,[],[],_) -> + {error,{not_available,SubKeys}}; +get_subconfig(_SubKeys,[],Mapped,_) -> + {ok,Mapped}. + +do_get_config([Key|Required],Available,Mapped) -> + case lists:keysearch(Key,1,Available) of + {value,{Key,Value}} -> + NewAvailable = lists:keydelete(Key,1,Available), + NewMapped = [{Key,Value}|Mapped], + do_get_config(Required,NewAvailable,NewMapped); + false -> + {error,{not_available,Key}} + end; +do_get_config([],_Available,Mapped) -> + {ok,lists:reverse(Mapped)}. + +get_all_config() -> + ets:select(?attr_table,[{#ct_conf{name='$1',key='$2',value='$3', + default='$4',_='_'}, + [], + [{{'$1','$2','$3','$4'}}]}]). + +lookup_config(KeyOrName) -> + case lookup_name(KeyOrName) of + [] -> + lookup_key(KeyOrName); + Values -> + Values + end. + +lookup_name(Name) -> + ets:select(?attr_table,[{#ct_conf{ref='$1',value='$2',name=Name,_='_'}, + [], + [{{'$1','$2'}}]}]). +lookup_key(Key) -> + ets:select(?attr_table,[{#ct_conf{key=Key,ref='$1',value='$2',name='_UNDEF',_='_'}, + [], + [{{'$1','$2'}}]}]). + +lookup_handler_for_config({Key, _Subkey}) -> + lookup_handler_for_config(Key); +lookup_handler_for_config(KeyOrName) -> + case lookup_handler_for_name(KeyOrName) of + [] -> + lookup_handler_for_key(KeyOrName); + Values -> + Values + end. + +lookup_handler_for_name(Name) -> + ets:select(?attr_table,[{#ct_conf{handler='$1',config='$2',name=Name,_='_'}, + [], + [{{'$1','$2'}}]}]). + +lookup_handler_for_key(Key) -> + ets:select(?attr_table,[{#ct_conf{handler='$1',config='$2',key=Key,_='_'}, + [], + [{{'$1','$2'}}]}]). + + +update_conf(Name, NewConfig) -> + Old = ets:select(?attr_table,[{#ct_conf{name=Name,_='_'},[],['$_']}]), + lists:foreach(fun(OldElem) -> + NewElem = OldElem#ct_conf{value=NewConfig}, + ets:delete_object(?attr_table, OldElem), + ets:insert(?attr_table, NewElem) + end, Old), + ok. + +reload_conf(KeyOrName) -> + case lookup_handler_for_config(KeyOrName) of + []-> + undefined; + HandlerList-> + HandlerList2 = lists:usort(HandlerList), + read_config_files_int(HandlerList2, fun rewrite_config/3), + get_config(KeyOrName) + end. + +release_allocated() -> + Allocated = ets:select(?attr_table,[{#ct_conf{name='$1',_='_'}, + [{'=/=','$1','_UNDEF'}], + ['$_']}]), + release_allocated(Allocated). +release_allocated([H|T]) -> + ets:delete_object(?attr_table,H), + ets:insert(?attr_table,H#ct_conf{name='_UNDEF'}), + release_allocated(T); +release_allocated([]) -> + ok. + +allocate(Name,Key,SubKeys) -> + case ets:match_object(?attr_table,#ct_conf{key=Key,name='_UNDEF',_='_'}) of + [] -> + {error,{not_available,Key}}; + Available -> + case allocate_subconfig(Name,SubKeys,Available,false) of + ok -> + ok; + Error -> + Error + end + end. + +allocate_subconfig(Name,SubKeys,[C=#ct_conf{value=Value}|Rest],Found) -> + case do_get_config(SubKeys,Value,[]) of + {ok,_SubMapped} -> + ets:insert(?attr_table,C#ct_conf{name=Name}), + allocate_subconfig(Name,SubKeys,Rest,true); + _Error -> + allocate_subconfig(Name,SubKeys,Rest,Found) + end; +allocate_subconfig(_Name,_SubKeys,[],true) -> + ok; +allocate_subconfig(_Name,SubKeys,[],false) -> + {error,{not_available,SubKeys}}. + +delete_config(Default) -> + ets:match_delete(?attr_table,#ct_conf{default=Default,_='_'}), + ok. + +require(Key) when is_atom(Key) -> + require({Key,[]}); +require({Key,SubKeys}) when is_atom(Key) -> + allocate('_UNDEF',Key,to_list(SubKeys)); +require(Key) -> + {error,{invalid,Key}}. + +require(Name,Key) when is_atom(Key) -> + require(Name,{Key,[]}); +require(Name,{Key,SubKeys}) when is_atom(Name), is_atom(Key) -> + call({require,Name,Key,to_list(SubKeys)}); +require(Name,Keys) -> + {error,{invalid,{Name,Keys}}}. + +to_list(X) when is_list(X) -> X; +to_list(X) -> [X]. + +do_require(Name,Key,SubKeys) when is_list(SubKeys) -> + case get_key_from_name(Name) of + {error,_} -> + allocate(Name,Key,SubKeys); + {ok,Key} -> + %% already allocated - check that it has all required subkeys + Vals = [Val || {_Ref,Val} <- lookup_name(Name)], + case get_subconfig(SubKeys,Vals) of + {ok,_SubMapped} -> + ok; + Error -> + Error + end; + {ok,OtherKey} -> + {error,{name_in_use,Name,OtherKey}} + end. + +encrypt_config_file(SrcFileName, EncryptFileName) -> + case get_crypt_key_from_file() of + {error,_} = E -> + E; + Key -> + encrypt_config_file(SrcFileName, EncryptFileName, {key,Key}) + end. + +get_ref_from_name(Name) -> + case ets:select(?attr_table,[{#ct_conf{name=Name,ref='$1',_='_'}, + [], + ['$1']}]) of + [Ref] -> + {ok,Ref}; + _ -> + {error,{no_such_name,Name}} + end. + +get_name_from_ref(Ref) -> + case ets:select(?attr_table,[{#ct_conf{name='$1',ref=Ref,_='_'}, + [], + ['$1']}]) of + [Name] -> + {ok,Name}; + _ -> + {error,{no_such_ref,Ref}} + end. + +get_key_from_name(Name) -> + case ets:select(?attr_table,[{#ct_conf{name=Name,key='$1',_='_'}, + [], + ['$1']}]) of + [Key|_] -> + {ok,Key}; + _ -> + {error,{no_such_name,Name}} + end. + +encrypt_config_file(SrcFileName, EncryptFileName, {file,KeyFile}) -> + case get_crypt_key_from_file(KeyFile) of + {error,_} = E -> + E; + Key -> + encrypt_config_file(SrcFileName, EncryptFileName, {key,Key}) + end; + +encrypt_config_file(SrcFileName, EncryptFileName, {key,Key}) -> + crypto:start(), + {K1,K2,K3,IVec} = make_crypto_key(Key), + case file:read_file(SrcFileName) of + {ok,Bin0} -> + Bin1 = term_to_binary({SrcFileName,Bin0}), + Bin2 = case byte_size(Bin1) rem 8 of + 0 -> Bin1; + N -> list_to_binary([Bin1,random_bytes(8-N)]) + end, + EncBin = crypto:des3_cbc_encrypt(K1, K2, K3, IVec, Bin2), + case file:write_file(EncryptFileName, EncBin) of + ok -> + io:format("~s --(encrypt)--> ~s~n", + [SrcFileName,EncryptFileName]), + ok; + {error,Reason} -> + {error,{Reason,EncryptFileName}} + end; + {error,Reason} -> + {error,{Reason,SrcFileName}} + end. + +decrypt_config_file(EncryptFileName, TargetFileName) -> + case get_crypt_key_from_file() of + {error,_} = E -> + E; + Key -> + decrypt_config_file(EncryptFileName, TargetFileName, {key,Key}) + end. + +decrypt_config_file(EncryptFileName, TargetFileName, {file,KeyFile}) -> + case get_crypt_key_from_file(KeyFile) of + {error,_} = E -> + E; + Key -> + decrypt_config_file(EncryptFileName, TargetFileName, {key,Key}) + end; + +decrypt_config_file(EncryptFileName, TargetFileName, {key,Key}) -> + crypto:start(), + {K1,K2,K3,IVec} = make_crypto_key(Key), + case file:read_file(EncryptFileName) of + {ok,Bin} -> + DecBin = crypto:des3_cbc_decrypt(K1, K2, K3, IVec, Bin), + case catch binary_to_term(DecBin) of + {'EXIT',_} -> + {error,bad_file}; + {_SrcFile,SrcBin} -> + case TargetFileName of + undefined -> + {ok,SrcBin}; + _ -> + case file:write_file(TargetFileName, SrcBin) of + ok -> + io:format("~s --(decrypt)--> ~s~n", + [EncryptFileName,TargetFileName]), + ok; + {error,Reason} -> + {error,{Reason,TargetFileName}} + end + end + end; + {error,Reason} -> + {error,{Reason,EncryptFileName}} + end. + +get_crypt_key_from_file(File) -> + case file:read_file(File) of + {ok,Bin} -> + case catch string:tokens(binary_to_list(Bin), [$\n,$\r]) of + [Key] -> + Key; + _ -> + {error,{bad_crypt_file,File}} + end; + {error,Reason} -> + {error,{Reason,File}} + end. + +get_crypt_key_from_file() -> + CwdFile = filename:join(".",?cryptfile), + {Result,FullName} = + case file:read_file(CwdFile) of + {ok,Bin} -> + {Bin,CwdFile}; + _ -> + case init:get_argument(home) of + {ok,[[Home]]} -> + HomeFile = filename:join(Home,?cryptfile), + case file:read_file(HomeFile) of + {ok,Bin} -> + {Bin,HomeFile}; + _ -> + {{error,no_crypt_file},noent} + end; + _ -> + {{error,no_crypt_file},noent} + end + end, + case FullName of + noent -> + Result; + _ -> + case catch string:tokens(binary_to_list(Result), [$\n,$\r]) of + [Key] -> + io:format("~nCrypt key file: ~s~n", [FullName]), + Key; + _ -> + {error,{bad_crypt_file,FullName}} + end + end. + +make_crypto_key(String) -> + <<K1:8/binary,K2:8/binary>> = First = erlang:md5(String), + <<K3:8/binary,IVec:8/binary>> = erlang:md5([First|lists:reverse(String)]), + {K1,K2,K3,IVec}. + +random_bytes(N) -> + {A,B,C} = now(), + random:seed(A, B, C), + random_bytes_1(N, []). + +random_bytes_1(0, Acc) -> Acc; +random_bytes_1(N, Acc) -> random_bytes_1(N-1, [random:uniform(255)|Acc]). + +check_callback_load(Callback) -> + case code:is_loaded(Callback) of + {file, _Filename}-> + check_exports(Callback); + false-> + case code:load_file(Callback) of + {module, Callback}-> + check_exports(Callback); + {error, Error}-> + {error, Error} + end + end. + +check_exports(Callback) -> + Fs = Callback:module_info(exports), + case {lists:member({check_parameter,1},Fs), + lists:member({read_config,1},Fs)} of + {true, true} -> + {ok, Callback}; + _ -> + {error, missing_callback_functions} + end. + +check_config_files(Configs) -> + ConfigChecker = fun + ({Callback, [F|_R]=Files}) -> + case check_callback_load(Callback) of + {ok, Callback} -> + if is_integer(F) -> + Callback:check_parameter(Files); + is_list(F) -> + lists:map(fun(File) -> + Callback:check_parameter(File) + end, + Files) + end; + {error, Why}-> + {error, {callback, {Callback,Why}}} + end; + ({Callback, []}) -> + case check_callback_load(Callback) of + {ok, Callback}-> + Callback:check_parameter([]); + {error, Why}-> + {error, {callback, {Callback,Why}}} + end + end, + lists:keysearch(error, 1, lists:flatten(lists:map(ConfigChecker, Configs))). + +prepare_user_configs([ConfigString|UserConfigs], Acc, new) -> + prepare_user_configs(UserConfigs, + [{list_to_atom(ConfigString), []}|Acc], + cur); +prepare_user_configs(["and"|UserConfigs], Acc, _) -> + prepare_user_configs(UserConfigs, Acc, new); +prepare_user_configs([ConfigString|UserConfigs], [{LastMod, LastList}|Acc], cur) -> + prepare_user_configs(UserConfigs, + [{LastMod, [ConfigString|LastList]}|Acc], + cur); +prepare_user_configs([], Acc, _) -> + Acc. + +prepare_config_list(Args) -> + ConfigFiles = case lists:keysearch(ct_config, 1, Args) of + {value,{ct_config,Files}}-> + [{?ct_config_txt,[filename:absname(F) || F <- Files]}]; + false-> + [] + end, + UserConfigs = case lists:keysearch(userconfig, 1, Args) of + {value,{userconfig,UserConfigFiles}}-> + prepare_user_configs(UserConfigFiles, [], new); + false-> + [] + end, + ConfigFiles ++ UserConfigs. + +% TODO: add logging of the loaded configuration file to the CT FW log!!! +add_config(Callback, []) -> + read_config_files_int([{Callback, []}], fun store_config/3); +add_config(Callback, [File|_Files]=Config) when is_list(File) -> + lists:foreach(fun(CfgStr) -> + read_config_files_int([{Callback, CfgStr}], fun store_config/3) end, + Config); +add_config(Callback, [C|_]=Config) when is_integer(C) -> + read_config_files_int([{Callback, Config}], fun store_config/3), + ok. + +remove_config(Callback, Config) -> + ets:match_delete(?attr_table, + #ct_conf{handler=Callback, + config=Config,_='_'}), + ok. diff --git a/lib/common_test/src/ct_config_plain.erl b/lib/common_test/src/ct_config_plain.erl new file mode 100644 index 0000000000..3fbc8af9fb --- /dev/null +++ b/lib/common_test/src/ct_config_plain.erl @@ -0,0 +1,109 @@ +%%-------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. 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% +%%---------------------------------------------------------------------- +%% File : ct_config_plain.erl +%% Description : CT callback module for reading configs from text files +%% +%% Created : 15 February 2010 +%%---------------------------------------------------------------------- +-module(ct_config_plain). +-export([read_config/1, check_parameter/1]). + +read_config(ConfigFile) -> + case file:consult(ConfigFile) of + {ok,Config} -> + {ok, Config}; + {error,enoent} -> + {error, config_file_error, enoent}; + {error,Reason} -> + Key = + case application:get_env(common_test, decrypt) of + {ok,KeyOrFile} -> + case KeyOrFile of + {key,K} -> + K; + {file,F} -> + ct_config:get_crypt_key_from_file(F) + end; + _ -> + ct_config:get_crypt_key_from_file() + end, + case Key of + {error,no_crypt_file} -> + {error, config_file_error, Reason}; + {error,CryptError} -> + {error, decrypt_file_error, CryptError}; + _ when is_list(Key) -> + case ct_config:decrypt_config_file(ConfigFile, undefined, {key,Key}) of + {ok,CfgBin} -> + case read_config_terms(CfgBin) of + {error,ReadFail} -> + {error, config_file_error, ReadFail}; + Config -> + {ok, Config} + end; + {error,DecryptFail} -> + {error, decrypt_config_error, DecryptFail} + end; + _ -> + {error, bad_decrypt_key, Key} + end + end. + +% check if config file exists +check_parameter(File)-> + case filelib:is_file(File) of + true-> + {ok, {file, File}}; + false-> + {error, {nofile, File}} + end. + +read_config_terms(Bin) when is_binary(Bin) -> + case catch binary_to_list(Bin) of + {'EXIT',_} -> + {error,invalid_textfile}; + Lines -> + read_config_terms(Lines) + end; +read_config_terms(Lines) when is_list(Lines) -> + read_config_terms1(erl_scan:tokens([], Lines, 0), 1, [], []). + +read_config_terms1({done,{ok,Ts,EL},Rest}, L, Terms, _) -> + case erl_parse:parse_term(Ts) of + {ok,Term} when Rest == [] -> + lists:reverse([Term|Terms]); + {ok,Term} -> + read_config_terms1(erl_scan:tokens([], Rest, 0), + EL+1, [Term|Terms], Rest); + _ -> + {error,{bad_term,{L,EL}}} + end; +read_config_terms1({done,{eof,_},_}, _, Terms, Rest) when Rest == [] -> + lists:reverse(Terms); +read_config_terms1({done,{eof,EL},_}, L, _, _) -> + {error,{bad_term,{L,EL}}}; +read_config_terms1({done,{error,Info,EL},_}, L, _, _) -> + {error,{Info,{L,EL}}}; +read_config_terms1({more,_}, L, Terms, Rest) -> + case string:tokens(Rest, [$\n,$\r,$\t]) of + [] -> + lists:reverse(Terms); + _ -> + {error,{bad_term,L}} + end. diff --git a/lib/common_test/src/ct_config_xml.erl b/lib/common_test/src/ct_config_xml.erl new file mode 100644 index 0000000000..8a6e75e635 --- /dev/null +++ b/lib/common_test/src/ct_config_xml.erl @@ -0,0 +1,118 @@ +%%-------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. 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% +%%---------------------------------------------------------------------- +%% File : ct_config_xml.erl +%% Description : CT callback module for reading configs from XML files +%% +%% Created : 16 February 2010 +%%---------------------------------------------------------------------- +-module(ct_config_xml). +-export([read_config/1, check_parameter/1]). + +% read config file +read_config(ConfigFile) -> + case catch do_read_xml_config(ConfigFile) of + {ok, Config}-> + {ok, Config}; + {error, Error, ErroneousString}-> + {error, Error, ErroneousString} + end. + +% check file exists +check_parameter(File)-> + case filelib:is_file(File) of + true-> + {ok, {file, File}}; + false-> + {error, {nofile, File}} + end. + +% actual reading of the config +do_read_xml_config(ConfigFile)-> + case catch xmerl_sax_parser:file(ConfigFile, + [{event_fun, fun event/3}, + {event_state, []}]) of + {ok, EntityList, _}-> + {ok, lists:reverse(transform_entity_list(EntityList))}; + Oops-> + {error, parsing_failed, Oops} + end. + +% event callback for xmerl_sax_parser +event(Event, _LineNo, State) -> + tag(Event, State). + +% document start +tag(startDocument, State) -> + State; + +% start of the config +tag({startElement, _Uri, "config", _QName, _Attributes}, []) -> + [{"config", []}]; + +% start tag +tag({startElement, _Uri, Name, _QName, _Attributes}, Tags) -> + [{Name, []}|Tags]; + +% value +tag({characters, String}, [{Tag, _Value}|Tags]) -> + [{Tag, String}|Tags]; + +% end tag +tag({endElement, _Uri, _Name, _QName}, + [Entity, {PrevEntityTag, PrevEntityValue}|Tags]) -> + NewHead = {PrevEntityTag, [Entity|PrevEntityValue]}, + [NewHead|Tags]; + +% end of the config +tag({endElement, _Uri, "config", _QName}, [{"config", Config}]) -> + Config; + +% end of document, return result +tag(endDocument, {_Tags, Result}) -> + Result; + +% default +tag(_El, State) -> + State. + +% transform of the ugly deeply nested entity list to the key-value "tree" +transform_entity_list(EntityList)-> + lists:map(fun transform_entity/1, EntityList). + +% transform entity from {list(), list()} to {atom(), term()} +transform_entity({Tag, [Value|Rest]}) when + is_tuple(Value)-> + {list_to_atom(Tag), transform_entity_list(lists:reverse([Value|Rest]))}; +transform_entity({Tag, String})-> + case list_to_term(String) of + {ok, Value}-> + {list_to_atom(Tag), Value}; + Error-> + throw(Error) + end. + +% transform a string with Erlang terms +list_to_term(String) -> + {ok, T, _} = erl_scan:string(String++"."), + case catch erl_parse:parse_term(T) of + {ok, Term} -> + {ok, Term}; + Error -> + {error, Error, String} + end. diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index ed8b564921..38a2aa53ac 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2010. All Rights Reserved. +%% Copyright Ericsson AB 2004-2011. 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,11 +24,15 @@ -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]). + -export([error_in_suite/1, ct_init_per_group/2, ct_end_per_group/2]). +-export([make_all_conf/3, make_conf/5]). + -include("ct_event.hrl"). -include("ct_util.hrl"). @@ -101,7 +105,8 @@ init_tc1(Mod,Func,[Config0],DoInit) when is_list(Config0) -> [{saved_config,{LastFunc,SavedConfig}} | lists:keydelete(saved_config,1,Config0)]; {{LastSuite,InitOrEnd},SavedConfig} when InitOrEnd == init_per_suite ; - InitOrEnd == end_per_suite -> % last suite + InitOrEnd == end_per_suite -> + %% last suite [{saved_config,{LastSuite,SavedConfig}} | lists:keydelete(saved_config,1,Config0)]; undefined -> @@ -113,9 +118,9 @@ init_tc1(Mod,Func,[Config0],DoInit) when is_list(Config0) -> ok; true -> %% delete all default values used in previous suite - ct_util:delete_default_config(suite), + ct_config:delete_default_config(suite), %% release all name -> key bindings (once per suite) - ct_util:release_allocated() + ct_config:release_allocated() end, TestCaseInfo = case catch apply(Mod,Func,[]) of @@ -125,7 +130,7 @@ init_tc1(Mod,Func,[Config0],DoInit) when is_list(Config0) -> %% clear all config data default values set by previous %% testcase info function (these should only survive the %% testcase, not the whole suite) - ct_util:delete_default_config(testcase), + ct_config:delete_default_config(testcase), case add_defaults(Mod,Func,TestCaseInfo,DoInit) of Error = {suite0_failed,_} -> ct_logs:init_tc(), @@ -161,6 +166,7 @@ init_tc2(Mod,Func,SuiteInfo,MergeResult,Config,DoInit) -> _ -> MergeResult end, + %% timetrap must be handled before require MergedInfo1 = timetrap_first(MergedInfo, [], []), %% tell logger to use specified style sheet @@ -201,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 @@ -210,13 +216,25 @@ 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) + case Fun(init_tc, FinalConfig) of + NewConfig when is_list(NewConfig) -> + {ok,NewConfig}; + Else -> + Else + end end end end. - + +ct_suite_init(Mod, Func, [Config]) when is_list(Config) -> + case ct_hooks: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 @@ -233,7 +251,9 @@ add_defaults(Mod,Func,FuncInfo,DoInit) -> (_) -> false end, SuiteInfo) of true -> - SuiteInfo1 = merge_with_suite_defaults(Mod,SuiteInfo), + SuiteInfoNoCTH = + lists:keydelete(ct_hooks,1,SuiteInfo), + SuiteInfo1 = merge_with_suite_defaults(Mod,SuiteInfoNoCTH), case add_defaults1(Mod,Func,FuncInfo,SuiteInfo1,DoInit) of Error = {error,_} -> {SuiteInfo1,Error}; MergedInfo -> {SuiteInfo1,MergedInfo} @@ -244,8 +264,8 @@ add_defaults(Mod,Func,FuncInfo,DoInit) -> _ -> {suite0_failed,bad_return_value} end. - -add_defaults1(_Mod,init_per_suite,[],SuiteInfo,_) -> + +add_defaults1(_Mod,init_per_suite,[],SuiteInfo,_DoInit) -> SuiteInfo; add_defaults1(Mod,Func,FuncInfo,SuiteInfo,DoInit) -> @@ -253,15 +273,27 @@ add_defaults1(Mod,Func,FuncInfo,SuiteInfo,DoInit) -> %% can result in weird behaviour (suite values get overwritten) SuiteReqs = [SDDef || SDDef <- SuiteInfo, - require == element(1,SDDef)], - case [element(2,Clash) || Clash <- SuiteReqs, - true == lists:keymember(element(2,Clash),2,FuncInfo)] of + ((require == element(1,SDDef)) or + (default_config == element(1,SDDef)))], + FuncReqs = + [FIDef || FIDef <- FuncInfo, + require == element(1,FIDef)], + case [element(2,Clash) || Clash <- SuiteReqs, + require == element(1, Clash), + true == lists:keymember(element(2,Clash),2, + FuncReqs)] of [] -> add_defaults2(Mod,Func,FuncInfo,SuiteInfo,SuiteReqs,DoInit); Clashes -> {error,{config_name_already_in_use,Clashes}} end. +add_defaults2(Mod,init_per_suite,IPSInfo,SuiteInfo,SuiteReqs,false) -> + %% not common practise to use a test case info function for + %% init_per_suite (usually handled by suite/0), but let's support + %% it just in case... + add_defaults2(Mod,init_per_suite,IPSInfo,SuiteInfo,SuiteReqs,true); + add_defaults2(_Mod,_Func,FuncInfo,SuiteInfo,_,false) -> %% include require elements from test case info, but not from suite/0 %% (since we've already required those vars) @@ -344,6 +376,8 @@ configure([{timetrap,off}|Rest],Info,SuiteInfo,Scope,Config) -> configure([{timetrap,Time}|Rest],Info,SuiteInfo,Scope,Config) -> Dog = test_server:timetrap(Time), configure(Rest,Info,SuiteInfo,Scope,[{watchdog,Dog}|Config]); +configure([{ct_hooks, Hook} | Rest], Info, SuiteInfo, Scope, Config) -> + configure(Rest, Info, SuiteInfo, Scope, [{ct_hooks, Hook} | Config]); configure([_|Rest],Info,SuiteInfo,Scope,Config) -> configure(Rest,Info,SuiteInfo,Scope,Config); configure([],_,_,_,Config) -> @@ -381,10 +415,10 @@ try_set_default(Name,Key,Info,Where) -> {_,[]} -> no_default; {'_UNDEF',_} -> - [ct_util:set_default_config([CfgVal],Where) || CfgVal <- CfgElems], + [ct_config:set_default_config([CfgVal],Where) || CfgVal <- CfgElems], ok; _ -> - [ct_util:set_default_config(Name,[CfgVal],Where) || CfgVal <- CfgElems], + [ct_config:set_default_config(Name,[CfgVal],Where) || CfgVal <- CfgElems], ok end. @@ -400,14 +434,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 @@ -430,8 +464,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 @@ -448,12 +484,33 @@ end_tc(Mod,Func,TCPid,Result,Args) -> end, ct_util:reset_silent_connections(), - %% send sync notification so that event handlers may print - %% in the log file before it gets closed - ct_event:sync_notify(#event{name=tc_done, - node=node(), - data={Mod,FuncSpec,tag(Result)}}), - case Result of + case get('$test_server_framework_test') of + undefined -> + {FinalResult,FinalNotify} = + case ct_hooks:end_tc( + Mod, FuncSpec, Args, Result, Return) of + '$ct_no_change' -> + {FinalResult = ok,Result}; + FinalResult -> + {FinalResult,FinalResult} + end, + % send sync notification so that event handlers may print + % in the log file before it gets closed + ct_event:sync_notify(#event{name=tc_done, + node=node(), + data={Mod,FuncSpec, + tag_cth(FinalNotify)}}); + Fun -> + % send sync notification so that event handlers may print + % in the log file before it gets closed + ct_event:sync_notify(#event{name=tc_done, + node=node(), + data={Mod,FuncSpec,tag(Result)}}), + FinalResult = Fun(end_tc, Return) + end, + + + case FinalResult of {skip,{sequence_failed,_,_}} -> %% ct_logs:init_tc is never called for a skipped test case %% in a failing sequence, so neither should end_tc @@ -472,12 +529,7 @@ end_tc(Mod,Func,TCPid,Result,Args) -> _ -> ok end, - case get('$test_server_framework_test') of - undefined -> - ok; - Fun -> - Fun(end_tc, ok) - end. + FinalResult. %% {error,Reason} | {skip,Reason} | {timetrap_timeout,TVal} | %% {testcase_aborted,Reason} | testcase_aborted_or_killed | @@ -493,6 +545,21 @@ tag(E = testcase_aborted_or_killed) -> tag(Other) -> Other. +tag_cth({STag,Reason}) when STag == skip; STag == skipped -> + {skipped,Reason}; +tag_cth({fail, Reason}) -> + {failed, {error,Reason}}; +tag_cth(E = {ETag,_}) when ETag == error; ETag == 'EXIT'; + ETag == timetrap_timeout; + ETag == testcase_aborted -> + {failed,E}; +tag_cth(E = testcase_aborted_or_killed) -> + {failed,E}; +tag_cth(List) when is_list(List) -> + ok; +tag_cth(Other) -> + Other. + %%%----------------------------------------------------------------- %%% @spec error_notification(Mod,Func,Args,Error) -> ok %%% Mod = atom() @@ -631,12 +698,12 @@ group_or_func(Func, _Config) -> %%% and every test case. If the former, all test cases in the suite %%% should be returned. -get_suite(Mod, all) -> +get_suite(Mod, all) -> case catch apply(Mod, groups, []) of {'EXIT',_} -> get_all(Mod, []); GroupDefs when is_list(GroupDefs) -> - case catch check_groups(Mod, GroupDefs) of + case catch find_groups(Mod, all, all, GroupDefs) of {error,_} = Error -> %% this makes test_server call error_in_suite as first %% (and only) test case so we can report Error properly @@ -651,96 +718,224 @@ get_suite(Mod, all) -> %%!============================================================ %%! Note: The handling of sequences in get_suite/2 and get_all/2 -%%! is deprecated and should be removed after OTP R13! +%%! is deprecated and should be removed at some point... %%!============================================================ -get_suite(Mod, Name) -> - %% Name may be name of a group or a test case. If it's a group, - %% it should be expanded to list of cases (in a conf term) +%% group +get_suite(Mod, Group={conf,Props,_Init,TCs,_End}) -> + Name = proplists:get_value(name, Props), case catch apply(Mod, groups, []) of {'EXIT',_} -> - get_seq(Mod, Name); + [Group]; GroupDefs when is_list(GroupDefs) -> - case catch check_groups(Mod, GroupDefs) of + case catch find_groups(Mod, Name, TCs, GroupDefs) of {error,_} = Error -> %% this makes test_server call error_in_suite as first %% (and only) test case so we can report Error properly [{?MODULE,error_in_suite,[[Error]]}]; + [] -> + {error,{invalid_group_spec,Name}}; ConfTests -> - FindConf = fun({conf,Props,_,_,_}) -> - case proplists:get_value(name, Props) of - Name -> true; - _ -> false - end - end, - case lists:filter(FindConf, ConfTests) of - [] -> % must be a test case - get_seq(Mod, Name); - [ConfTest|_] -> - ConfTest + case lists:member(skipped, Props) of + true -> + %% a *subgroup* specified *only* as skipped (and not + %% as an explicit test) should not be returned, or + %% init/end functions for top groups will be executed + case catch proplists:get_value(name, element(2, hd(ConfTests))) of + Name -> % top group + delete_subs(ConfTests, ConfTests); + _ -> + [] + end; + false -> + delete_subs(ConfTests, ConfTests) end end; _ -> E = "Bad return value from "++atom_to_list(Mod)++":groups/0", [{?MODULE,error_in_suite,[[{error,list_to_atom(E)}]]}] - end. + end; -check_groups(_Mod, []) -> - []; -check_groups(Mod, Defs) -> - check_groups(Mod, Defs, Defs, []). +%% testcase +get_suite(Mod, Name) -> + get_seq(Mod, Name). -check_groups(Mod, [TC | Gs], Defs, Levels) when is_atom(TC), length(Levels)>0 -> - [TC | check_groups(Mod, Gs, Defs, Levels)]; +%%%----------------------------------------------------------------- -check_groups(Mod, [{group,SubName} | Gs], Defs, Levels) when is_atom(SubName) -> - case lists:member(SubName, Levels) of - true -> - E = "Cyclic reference to group "++atom_to_list(SubName)++ - " in "++atom_to_list(Mod)++":groups/0", - throw({error,list_to_atom(E)}); - false -> - case find_group(Mod, SubName, Defs) of - {error,_} = Error -> - throw(Error); - G -> - [check_groups(Mod, [G], Defs, Levels) | - check_groups(Mod, Gs, Defs, Levels)] - end +find_groups(Mod, Name, TCs, GroupDefs) -> + Found = find(Mod, Name, TCs, GroupDefs, [], GroupDefs, false), + Trimmed = trim(Found), + %% I cannot find a reason to why this function is called, + %% It deletes any group which is referenced in any other + %% group. i.e. + %% groups() -> + %% [{test, [], [testcase1]}, + %% {testcases, [], [{group, test}]}]. + %% Would be changed to + %% groups() -> + %% [{testcases, [], [testcase1]}]. + %% instead of what I believe is correct: + %% groups() -> + %% [{test, [], [testcase1]}, + %% {testcases, [], [testcase1]}]. + %% Have to double check with peppe + delete_subs(Trimmed, Trimmed), + Trimmed. + +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; -check_groups(Mod, [{Name,Tests} | Gs], Defs, Levels) when is_atom(Name), - is_list(Tests) -> - check_groups(Mod, [{Name,[],Tests} | Gs], Defs, Levels); - -check_groups(Mod, [{Name,Props,Tests} | Gs], Defs, Levels) when is_atom(Name), - is_list(Props), - is_list(Tests) -> - {TestSpec,Levels1} = - case Levels of - [] -> - {check_groups(Mod, Tests, Defs, [Name]),[]}; - _ -> - {check_groups(Mod, Tests, Defs, [Name|Levels]),Levels} - end, - [make_conf(Mod, Name, Props, TestSpec) | - check_groups(Mod, Gs, Defs, Levels1)]; +find(Mod, Name, TCs, [{Name1,Props,Tests} | Gs], Known, Defs, false) + when is_atom(Name1), is_list(Props), is_list(Tests) -> + cyclic_test(Mod, Name1, Known), + [make_conf(Mod,Name1,Props, + find(Mod, Name, TCs, Tests, [Name1 | Known], Defs, false)) | + find(Mod, Name, TCs, Gs, [], Defs, false)]; + +find(Mod, Name, _TCs, [{Name,_Props,_Tests} | _Gs], _Known, _Defs, true) + when is_atom(Name) -> + E = "Duplicate groups named "++atom_to_list(Name)++" in "++ + atom_to_list(Mod)++":groups/0", + throw({error,list_to_atom(E)}); -check_groups(Mod, [BadTerm | _Gs], _Defs, Levels) -> - Where = if length(Levels) == 0 -> +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(Levels))++ + "group "++atom_to_list(lists:last(Known))++ " in "++atom_to_list(Mod)++":groups/0" end, Term = io_lib:format("~p", [BadTerm]), E = "Bad term "++lists:flatten(Term)++" in "++Where, throw({error,list_to_atom(E)}); -check_groups(_Mod, [], _Defs, _) -> +find(_Mod, _Name, _TCs, [], _Known, _Defs, false) -> + ['$NOMATCH']; + +find(_Mod, _Name, _TCs, [], _Known, _Defs, _Found) -> []. -find_group(Mod, Name, Defs) -> +delete_subs([{conf, _,_,_,_} = 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 = proplists:get_value(name, Props), + [Conf || Conf = {conf,Props0,_,_,_} <- Confs, + Name =/= proplists:get_value(name, Props0)]. + +is_sub({conf,Props,_,_,_}=Conf, [{conf,_,_,Tests,_} | Confs]) -> + Name = proplists:get_value(name, Props), + case lists:any(fun({conf,Props0,_,_,_}) -> + case proplists:get_value(name, Props0) of + N when N == Name -> + true; + _ -> + false + end; + (_) -> + false + end, Tests) of + true -> + true; + false -> + is_sub(Conf, Tests) or is_sub(Conf, Confs) + end; + +is_sub(Conf, [_TC | Tests]) -> + is_sub(Conf, Tests); + +is_sub(_Conf, []) -> + false. + +trim(['$NOMATCH' | Tests]) -> + trim(Tests); + +trim([{conf,Props,Init,Tests,End} | Confs]) -> + case trim(Tests) of + [] -> + trim(Confs); + Trimmed -> + [{conf,Props,Init,Trimmed,End} | trim(Confs)] + end; + +trim([TC | Tests]) -> + [TC | trim(Tests)]; + +trim([]) -> + []. + +cyclic_test(Mod, Name, Names) -> + case lists:member(Name, Names) of + true -> + E = "Cyclic reference to group "++atom_to_list(Name)++ + " in "++atom_to_list(Mod)++":groups/0", + throw({error,list_to_atom(E)}); + false -> + ok + end. + +expand(Mod, Name, Defs) -> case lists:keysearch(Name, 1, Defs) of {value,Def} -> Def; @@ -750,7 +945,50 @@ find_group(Mod, Name, Defs) -> throw({error,list_to_atom(E)}) end. +make_all_conf(Dir, Mod, _Props) -> + case code:is_loaded(Mod) of + false -> + code:load_abs(filename:join(Dir,atom_to_list(Mod))); + _ -> + ok + end, + make_all_conf(Mod). + +make_all_conf(Mod) -> + case catch apply(Mod, groups, []) of + {'EXIT',_} -> + {error,{invalid_group_definition,Mod}}; + GroupDefs when is_list(GroupDefs) -> + case catch find_groups(Mod, all, all, GroupDefs) of + {error,_} = Error -> + %% this makes test_server call error_in_suite as first + %% (and only) test case so we can report Error properly + [{?MODULE,error_in_suite,[[Error]]}]; + [] -> + {error,{invalid_group_spec,Mod}}; + ConfTests -> + [{conf,Props,Init,all,End} || + {conf,Props,Init,_,End} + <- 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} = case erlang:function_exported(Mod,init_per_group,2) of true -> @@ -761,6 +999,7 @@ make_conf(Mod, Name, Props, TestSpec) -> end, {conf,[{name,Name}|Props],InitConf,TestSpec,EndConf}. +%%%----------------------------------------------------------------- get_all(Mod, ConfTests) -> case catch apply(Mod, all, []) of @@ -776,31 +1015,11 @@ get_all(Mod, ConfTests) -> [{?MODULE,error_in_suite,[[{error,What}]]}]; SeqsAndTCs -> %% expand group references in all() using ConfTests - Expand = - fun({group,Name}) -> - FindConf = - fun({conf,Props,_,_,_}) -> - case proplists:get_value(name, Props) of - Name -> true; - _ -> false - end - end, - case lists:filter(FindConf, ConfTests) of - [ConfTest|_] -> - ConfTest; - [] -> - E = "Invalid reference to group "++ - atom_to_list(Name)++" in "++ - atom_to_list(Mod)++":all/0", - throw({error,list_to_atom(E)}) - end; - (SeqOrTC) -> SeqOrTC - end, - case catch lists:map(Expand, SeqsAndTCs) of + case catch expand_groups(SeqsAndTCs, ConfTests, Mod) of {error,_} = Error -> [{?MODULE,error_in_suite,[[Error]]}]; Tests -> - Tests + delete_subs(Tests, Tests) end end; Skip = {skip,_Reason} -> @@ -811,6 +1030,30 @@ get_all(Mod, ConfTests) -> [{?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) -> + FindConf = + fun({conf,Props,_,_,_}) -> + case proplists:get_value(name, Props) of + Name -> true; + _ -> false + end + end, + case lists:filter(FindConf, ConfTests) of + [ConfTest|_] -> + expand_groups(ConfTest, ConfTests, Mod); + [] -> + E = "Invalid reference to group "++ + atom_to_list(Name)++" in "++ + atom_to_list(Mod)++":all/0", + throw({error,list_to_atom(E)}) + end; +expand_groups(SeqOrTC, _ConfTests, _Mod) -> + SeqOrTC. + %%!============================================================ %%! The support for sequences by means of using sequences/0 @@ -980,6 +1223,18 @@ report(What,Data) -> ok; tc_done -> {_Suite,Case,Result} = Data, + case Result of + {failed, _} -> + ct_hooks:on_tc_fail(What, Data); + {skipped,{failed,{_,init_per_testcase,_}}} -> + ct_hooks:on_tc_skip(tc_auto_skip, Data); + {skipped,{require_failed,_}} -> + ct_hooks:on_tc_skip(tc_auto_skip, Data); + {skipped,_} -> + ct_hooks:on_tc_skip(tc_user_skip, Data); + _Else -> + ok + end, case {Case,Result} of {init_per_suite,_} -> ok; @@ -997,8 +1252,8 @@ report(What,Data) -> add_to_stats(auto_skipped); {_,{skipped,_}} -> add_to_stats(user_skipped); - {_,{FailOrSkip,_Reason}} -> - add_to_stats(FailOrSkip) + {_,{SkipOrFail,_Reason}} -> + add_to_stats(SkipOrFail) end; tc_user_skip -> %% test case specified as skipped in testspec @@ -1006,6 +1261,7 @@ report(What,Data) -> ct_event:sync_notify(#event{name=tc_user_skip, node=node(), data=Data}), + ct_hooks:on_tc_skip(What, Data), add_to_stats(user_skipped); tc_auto_skip -> %% test case skipped because of error in init_per_suite @@ -1018,6 +1274,7 @@ report(What,Data) -> ct_event:sync_notify(#event{name=tc_auto_skip, node=node(), data=Data}), + ct_hooks:on_tc_skip(What, Data), if Case /= end_per_suite, Case /= end_per_group -> add_to_stats(auto_skipped); true -> @@ -1076,4 +1333,31 @@ add_data_dir(File,Config) when is_list(File) -> File end. +%%%----------------------------------------------------------------- +%%% @spec overview_html_header(TestName) -> Header +overview_html_header(TestName) -> + TestName1 = lists:flatten(io_lib:format("~p", [TestName])), + Label = case application:get_env(common_test, test_label) of + {ok,Lbl} when Lbl =/= undefined -> + "<H1><FONT color=\"green\">" ++ Lbl ++ "</FONT></H1>\n"; + _ -> + "" + end, + Bgr = case ct_logs:basic_html() of + true -> + ""; + false -> + CTPath = code:lib_dir(common_test), + TileFile = filename:join(filename:join(CTPath,"priv"),"tile1.jpg"), + " background=\"" ++ TileFile ++ "\"" + end, + + ["<html>\n", + "<head><title>Test ", TestName1, " results</title>\n", + "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n", + "</head>\n", + "<body", Bgr, " bgcolor=\"white\" text=\"black\" ", + "link=\"blue\" vlink=\"purple\" alink=\"red\">\n", + Label, + "<H2>Results from test ", TestName1, "</H2>\n"]. diff --git a/lib/common_test/src/ct_gen_conn.erl b/lib/common_test/src/ct_gen_conn.erl index a31e57c7ea..5aab4dd2dd 100644 --- a/lib/common_test/src/ct_gen_conn.erl +++ b/lib/common_test/src/ct_gen_conn.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2003-2010. 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% %% @@ -76,7 +76,7 @@ start(Name,Address,InitData,CallbackMod) -> MRef = erlang:monitor(process,Pid), receive {connected,Pid} -> - erlang:demonitor(MRef), + erlang:demonitor(MRef, [flush]), ct_util:register_connection(Name,Address,CallbackMod,Pid), {ok,Pid}; {Error,Pid} -> @@ -182,7 +182,7 @@ call(Pid,Msg) -> Pid ! {Msg,{self(),Ref}}, receive {Ref, Result} -> - erlang:demonitor(MRef), + erlang:demonitor(MRef, [flush]), case Result of {retry,_Data} -> call(Pid,Result); diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl new file mode 100644 index 0000000000..5eddefffce --- /dev/null +++ b/lib/common_test/src/ct_hooks.erl @@ -0,0 +1,307 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2011. 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 test execution control module. +%%% +%%% <p>This module is a proxy for calling and handling common test hooks.</p> + +-module(ct_hooks). + +%% API Exports +-export([init/1]). +-export([init_tc/3]). +-export([end_tc/5]). +-export([terminate/1]). +-export([on_tc_skip/2]). +-export([on_tc_fail/2]). + +-type proplist() :: [{atom(),term()}]. + +%% If you change this, remember to update ct_util:look -> stop clause as well. +-define(config_name, ct_hooks). + +%% ------------------------------------------------------------------------- +%% API Functions +%% ------------------------------------------------------------------------- + +%% @doc Called before any suites are started +-spec init(State :: term()) -> ok | + {error, Reason :: term()}. +init(Opts) -> + call([{Hook, call_id, undefined} || Hook <- get_new_hooks(Opts)], + ok, init, []). + + +%% @doc Called after all suites are done. +-spec terminate(Hooks :: term()) -> + ok. +terminate(Hooks) -> + call([{HookId, fun call_terminate/3} || {HookId,_,_} <- Hooks], + ct_hooks_terminate_dummy, terminate, Hooks), + ok. + +%% @doc Called as each test case is started. This includes all configuration +%% tests. +-spec init_tc(Mod :: atom(), Func :: atom(), Args :: list()) -> + NewConfig :: proplist() | + {skip, Reason :: term()} | + {auto_skip, Reason :: term()} | + {fail, Reason :: term()}. +init_tc(ct_framework, _Func, Args) -> + Args; +init_tc(Mod, init_per_suite, Config) -> + Info = try proplists:get_value(ct_hooks, Mod:suite(),[]) of + List when is_list(List) -> + [{ct_hooks,List}]; + CTHook when is_atom(CTHook) -> + [{ct_hooks,[CTHook]}] + catch error:undef -> + [{ct_hooks,[]}] + end, + call(fun call_generic/3, Config ++ Info, [pre_init_per_suite, Mod]); +init_tc(Mod, end_per_suite, Config) -> + call(fun call_generic/3, Config, [pre_end_per_suite, Mod]); +init_tc(Mod, {init_per_group, GroupName, Opts}, Config) -> + maybe_start_locker(Mod, GroupName, Opts), + call(fun call_generic/3, Config, [pre_init_per_group, GroupName]); +init_tc(_Mod, {end_per_group, GroupName, _}, Config) -> + call(fun call_generic/3, Config, [pre_end_per_group, GroupName]); +init_tc(_Mod, TC, Config) -> + call(fun call_generic/3, Config, [pre_init_per_testcase, TC]). + +%% @doc Called as each test case is completed. This includes all configuration +%% tests. +-spec end_tc(Mod :: atom(), + Func :: atom(), + Args :: list(), + Result :: term(), + Resturn :: term()) -> + NewConfig :: proplist() | + {skip, Reason :: term()} | + {auto_skip, Reason :: term()} | + {fail, Reason :: term()} | + ok | '$ct_no_change'. +end_tc(ct_framework, _Func, _Args, Result, _Return) -> + Result; + +end_tc(Mod, init_per_suite, Config, _Result, Return) -> + call(fun call_generic/3, Return, [post_init_per_suite, Mod, Config], + '$ct_no_change'); + +end_tc(Mod, end_per_suite, Config, Result, _Return) -> + call(fun call_generic/3, Result, [post_end_per_suite, Mod, Config], + '$ct_no_change'); + +end_tc(_Mod, {init_per_group, GroupName, _}, Config, _Result, Return) -> + call(fun call_generic/3, Return, [post_init_per_group, GroupName, Config], + '$ct_no_change'); + +end_tc(Mod, {end_per_group, GroupName, Opts}, Config, Result, _Return) -> + Res = call(fun call_generic/3, Result, + [post_end_per_group, GroupName, Config], '$ct_no_change'), + maybe_stop_locker(Mod, GroupName,Opts), + Res; + +end_tc(_Mod, TC, Config, Result, _Return) -> + call(fun call_generic/3, Result, [post_end_per_testcase, TC, Config], + '$ct_no_change'). + +on_tc_skip(How, {_Suite, Case, Reason}) -> + call(fun call_cleanup/3, {How, Reason}, [on_tc_skip, Case]). + +on_tc_fail(_How, {_Suite, Case, Reason}) -> + call(fun call_cleanup/3, Reason, [on_tc_fail, Case]). + +%% ------------------------------------------------------------------------- +%% Internal Functions +%% ------------------------------------------------------------------------- +call_id(Mod, Config, Meta) when is_atom(Mod) -> + call_id({Mod, []}, Config, Meta); +call_id({Mod, Opts}, Config, Scope) -> + Id = catch_apply(Mod,id,[Opts], make_ref()), + {Config, {Id, scope(Scope), {Mod, {Id,Opts}}}}. + +call_init({Mod,{Id,Opts}},Config,_Meta) -> + NewState = Mod:init(Id, Opts), + {Config, {Mod, NewState}}. + +call_terminate({Mod, State}, _, _) -> + catch_apply(Mod,terminate,[State], ok), + {[],{Mod,State}}. + +call_cleanup({Mod, State}, Reason, [Function | Args]) -> + NewState = catch_apply(Mod,Function, Args ++ [Reason, State], + State), + {Reason, {Mod, NewState}}. + +call_generic({Mod, State}, Value, [Function | Args]) -> + {NewValue, NewState} = catch_apply(Mod, Function, Args ++ [Value, State], + {Value,State}), + {NewValue, {Mod, NewState}}. + +%% Generic call function +call(Fun, Config, Meta) -> + maybe_lock(), + Hooks = get_hooks(), + Res = call([{HookId,Fun} || {HookId,_, _} <- Hooks] ++ + get_new_hooks(Config, Fun), + remove(?config_name,Config), Meta, Hooks), + maybe_unlock(), + Res. + +call(Fun, Config, Meta, NoChangeRet) when is_function(Fun) -> + case call(Fun,Config,Meta) of + Config -> NoChangeRet; + NewReturn -> NewReturn + end; + +call([{Hook, call_id, NextFun} | Rest], Config, Meta, Hooks) -> + try + {Config, {NewId, _, _} = NewHook} = call_id(Hook, Config, Meta), + {NewHooks, NewRest} = + case lists:keyfind(NewId, 1, Hooks) of + false when NextFun =:= undefined -> + {Hooks ++ [NewHook], + [{NewId, fun call_init/3} | Rest]}; + ExistingHook when is_tuple(ExistingHook) -> + {Hooks, Rest}; + _ -> + {Hooks ++ [NewHook], + [{NewId, fun call_init/3},{NewId,NextFun} | Rest]} + end, + call(NewRest, Config, Meta, NewHooks) + catch Error:Reason -> + Trace = erlang:get_stacktrace(), + ct_logs:log("Suite Hook","Failed to start a CTH: ~p:~p", + [Error,{Reason,Trace}]), + call([], {fail,"Failed to start CTH" + ", see the CT Log for details"}, Meta, Hooks) + end; +call([{HookId, Fun} | Rest], Config, Meta, Hooks) -> + try + {_,Scope,ModState} = lists:keyfind(HookId, 1, Hooks), + {NewConf, NewHookInfo} = Fun(ModState, Config, Meta), + NewCalls = get_new_hooks(NewConf, Fun), + NewHooks = lists:keyreplace(HookId, 1, Hooks, {HookId, Scope, NewHookInfo}), + call(NewCalls ++ Rest, remove(?config_name, NewConf), Meta, + terminate_if_scope_ends(HookId, Meta, NewHooks)) + catch throw:{error_in_cth_call,Reason} -> + call(Rest, {fail, Reason}, Meta, + terminate_if_scope_ends(HookId, Meta, Hooks)) + end; +call([], Config, _Meta, Hooks) -> + save_suite_data_async(Hooks), + Config. + +remove(Key,List) when is_list(List) -> + [Conf || Conf <- List, is_tuple(Conf) =:= false + orelse element(1, Conf) =/= Key]; +remove(_, Else) -> + Else. + +%% Translate scopes, i.e. init_per_group,group1 -> end_per_group,group1 etc +scope([pre_init_per_testcase, TC|_]) -> + [post_end_per_testcase, TC]; +scope([pre_init_per_group, GroupName|_]) -> + [post_end_per_group, GroupName]; +scope([post_init_per_group, GroupName|_]) -> + [post_end_per_group, GroupName]; +scope([pre_init_per_suite, SuiteName|_]) -> + [post_end_per_suite, SuiteName]; +scope([post_init_per_suite, SuiteName|_]) -> + [post_end_per_suite, SuiteName]; +scope(init) -> + none. + +terminate_if_scope_ends(HookId, [Function,Tag|T], Hooks) when T =/= [] -> + terminate_if_scope_ends(HookId,[Function,Tag],Hooks); +terminate_if_scope_ends(HookId, Function, Hooks) -> + case lists:keyfind(HookId, 1, Hooks) of + {HookId, Function, _ModState} = Hook -> + terminate([Hook]), + lists:keydelete(HookId, 1, Hooks); + _ -> + Hooks + end. + +%% Fetch hook functions +get_new_hooks(Config, Fun) -> + lists:foldl(fun(NewHook, Acc) -> + [{NewHook, call_id, Fun} | Acc] + end, [], get_new_hooks(Config)). + +get_new_hooks(Config) when is_list(Config) -> + lists:flatmap(fun({?config_name, HookConfigs}) -> + HookConfigs; + (_) -> + [] + end, Config); +get_new_hooks(_Config) -> + []. + +save_suite_data_async(Hooks) -> + ct_util:save_suite_data_async(?config_name, Hooks). + +get_hooks() -> + ct_util:read_suite_data(?config_name). + +catch_apply(M,F,A, Default) -> + try + apply(M,F,A) + catch error:Reason -> + case erlang:get_stacktrace() of + %% Return the default if it was the CTH module which did not have the function. + [{M,F,A}|_] when Reason == undef -> + Default; + Trace -> + ct_logs:log("Suite Hook","Call to CTH failed: ~p:~p", + [error,{Reason,Trace}]), + throw({error_in_cth_call, + lists:flatten( + io_lib:format("~p:~p/~p CTH call failed", + [M,F,length(A)]))}) + end + end. + + +%% We need to lock around the state for parallel groups only. This is because +%% we will get several processes reading and writing the state for a single +%% cth at the same time. +maybe_start_locker(Mod,GroupName,Opts) -> + case lists:member(parallel,Opts) of + true -> + {ok, _Pid} = ct_hooks_lock:start({Mod,GroupName}); + false -> + ok + end. + +maybe_stop_locker(Mod,GroupName,Opts) -> + case lists:member(parallel,Opts) of + true -> + stopped = ct_hooks_lock:stop({Mod,GroupName}); + false -> + ok + end. + + +maybe_lock() -> + locked = ct_hooks_lock:request(). + +maybe_unlock() -> + unlocked = ct_hooks_lock:release(). diff --git a/lib/common_test/src/ct_hooks_lock.erl b/lib/common_test/src/ct_hooks_lock.erl new file mode 100644 index 0000000000..e33fa278dc --- /dev/null +++ b/lib/common_test/src/ct_hooks_lock.erl @@ -0,0 +1,132 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2011. 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 test execution control module. +%%% +%%% <p>This module is a proxy for calling and handling locks in +%%% common test hooks.</p> + +-module(ct_hooks_lock). + +-behaviour(gen_server). + +%% API +-export([start/1, stop/1, request/0, release/0]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +-define(SERVER, ?MODULE). + +-record(state, { id, locked = false, requests = [] }). + +%%%=================================================================== +%%% API +%%%=================================================================== + +%% @doc Starts the server +start(Id) -> + case gen_server:start({local, ?SERVER}, ?MODULE, Id, []) of + {error,{already_started, Pid}} -> + {ok,Pid}; + Else -> + Else + end. + +stop(Id) -> + try + gen_server:call(?SERVER, {stop,Id}) + catch exit:{noproc,_} -> + stopped + end. + +request() -> + try + gen_server:call(?SERVER,{request,self()},infinity) + catch exit:{noproc,_} -> + locked + end. + +release() -> + try + gen_server:call(?SERVER,{release,self()}) + catch exit:{noproc,_} -> + unlocked + end. + +%%%=================================================================== +%%% gen_server callbacks +%%%=================================================================== + +%% @doc Initiates the server +init(Id) -> + {ok, #state{ id = Id }}. + +%% @doc Handling call messages +handle_call({stop,Id}, _From, #state{ id = Id, requests = Reqs } = State) -> + [gen_server:reply(Req, locker_stopped) || {Req,_ReqId} <- Reqs], + {stop, normal, stopped, State}; +handle_call({stop,_Id}, _From, State) -> + {reply, stopped, State}; +handle_call({request, Pid}, _From, #state{ locked = false, + requests = [] } = State) -> + Ref = monitor(process, Pid), + {reply, locked, State#state{ locked = {true, Pid, Ref}} }; +handle_call({request, Pid}, From, #state{ requests = Reqs } = State) -> + {noreply, State#state{ requests = Reqs ++ [{From,Pid}] }}; +handle_call({release, Pid}, _From, #state{ locked = {true, Pid, Ref}, + requests = []} = State) -> + demonitor(Ref,[flush]), + {reply, unlocked, State#state{ locked = false }}; +handle_call({release, Pid}, _From, + #state{ locked = {true, Pid, Ref}, + requests = [{NextFrom,NextPid}|Rest]} = State) -> + demonitor(Ref,[flush]), + gen_server:reply(NextFrom,locked), + NextRef = monitor(process, NextPid), + {reply,unlocked,State#state{ locked = {true, NextPid, NextRef}, + requests = Rest } }; +handle_call({release, _Pid}, _From, State) -> + {reply, not_locked, State}. + +%% @doc Handling cast messages +handle_cast(_Msg, State) -> + {noreply, State}. + +%% @doc Handling all non call/cast messages +handle_info({'DOWN',Ref,process,Pid,_}, + #state{ locked = {true, Pid, Ref}, + requests = [{NextFrom,NextPid}|Rest] } = State) -> + gen_server:reply(NextFrom, locked), + NextRef = monitor(process, NextPid), + {noreply,State#state{ locked = {true, NextPid, NextRef}, + requests = Rest } }. + +%% @doc This function is called by a gen_server when it is about to terminate. +terminate(_Reason, _State) -> + ok. + +%% @doc Convert process state when code is changed +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%% ------------------------------------------------------------------------- +%% Internal Functions +%% ------------------------------------------------------------------------- diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index bd1a89ae1f..f8ace73cbf 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2003-2010. 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% %% @@ -36,7 +36,8 @@ -export([make_all_suites_index/1,make_all_runs_index/1]). %% Logging stuff directly from testcase --export([tc_log/3,tc_print/3,tc_pal/3]). +-export([tc_log/3,tc_print/3,tc_pal/3, + basic_html/0]). %% Simulate logger process for use without ct environment running -export([simulate/0]). @@ -57,7 +58,7 @@ -define(table_color2,"#E4F0FE"). -define(table_color3,"#F0F8FF"). --define(testname_width, 70). +-define(testname_width, 60). -define(abs(Name), filename:absname(Name)). @@ -80,7 +81,7 @@ init(Mode) -> MRef = erlang:monitor(process,Pid), receive {started,Pid,Result} -> - erlang:demonitor(MRef), + erlang:demonitor(MRef, [flush]), Result; {'DOWN',MRef,process,_,Reason} -> exit({could_not_start_process,?MODULE,Reason}) @@ -163,7 +164,7 @@ call(Msg) -> ?MODULE ! {Msg,{self(),Ref}}, receive {Ref, Result} -> - erlang:demonitor(MRef), + erlang:demonitor(MRef, [flush]), Result; {'DOWN',MRef,process,_,Reason} -> {error,{process_down,?MODULE,Reason}} @@ -383,11 +384,14 @@ maybe_log_timestamp() -> [{"<i>~s</i>",[log_timestamp({MS,S,US})]}]}) end. -log_timestamp(Now) -> - put(log_timestamp,Now), - {_,{H,M,S}} = calendar:now_to_local_time(Now), - lists:flatten(io_lib:format("~2.2.0w:~2.2.0w:~2.2.0w", - [H,M,S])). +log_timestamp({MS,S,US}) -> + put(log_timestamp, {MS,S,US}), + {{Year,Month,Day}, {Hour,Min,Sec}} = + calendar:now_to_local_time({MS,S,US}), + MilliSec = trunc(US/1000), + lists:flatten(io_lib:format("~4.10.0B-~2.10.0B-~2.10.0B " + "~2.10.0B:~2.10.0B:~2.10.0B.~3.10.0B", + [Year,Month,Day,Hour,Min,Sec,MilliSec])). %%%----------------------------------------------------------------- %%% The logger server @@ -460,9 +464,11 @@ logger_loop(State) -> {'EXIT',_Reason} -> Fd = State#logger_state.ct_log_fd, io:format(Fd, - "Logging fails! Str: ~p, Args: ~p~n", + "Logging fails! " + "Str: ~p, Args: ~p~n", [Str,Args]), - %% stop the testcase, we need to see the fault + %% stop the testcase, we need + %% to see the fault exit(Pid,logging_failed), ok; IoStr when IoList == [] -> @@ -505,7 +511,7 @@ logger_loop(State) -> logger_loop(State); {set_stylesheet,TC,SSFile} -> Fd = State#logger_state.ct_log_fd, - io:format(Fd, "~p uses external style sheet: ~s~n", [TC,SSFile]), + io:format(Fd, "~p loading external style sheet: ~s~n", [TC,SSFile]), logger_loop(State#logger_state{stylesheet=SSFile}); {clear_stylesheet,_} when State#logger_state.stylesheet == undefined -> logger_loop(State); @@ -716,7 +722,7 @@ make_last_run_index1(StartTime,IndexName) -> [Log]; Logs -> case read_totals_file(?totals_name) of - {_Node,Logs0,_Totals} -> + {_Node,_Lbl,Logs0,_Totals} -> insert_dirs(Logs,Logs0); _ -> %% someone deleted the totals file!? @@ -728,10 +734,15 @@ make_last_run_index1(StartTime,IndexName) -> {ok,Bin} -> binary_to_term(Bin); _ -> [] end, - {ok,Index0,Totals} = make_last_run_index(Logs1, index_header(StartTime), + Label = case application:get_env(common_test, test_label) of + {ok,Lbl} -> Lbl; + _ -> undefined + end, + {ok,Index0,Totals} = make_last_run_index(Logs1, + index_header(Label,StartTime), 0, 0, 0, 0, 0, Missing), %% write current Totals to file, later to be used in all_runs log - write_totals_file(?totals_name,Logs1,Totals), + write_totals_file(?totals_name,Label,Logs1,Totals), Index = [Index0|index_footer()], case force_write_file(IndexName, Index) of ok -> @@ -761,7 +772,7 @@ make_last_run_index([Name|Rest], Result, TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt, Missing); LastLogDir -> SuiteName = filename:rootname(filename:basename(Name)), - case make_one_index_entry(SuiteName, LastLogDir, false, Missing) of + case make_one_index_entry(SuiteName, LastLogDir, "-", false, Missing) of {Result1,Succ,Fail,USkip,ASkip,NotBuilt} -> %% for backwards compatibility AutoSkip1 = case catch AutoSkip+ASkip of @@ -780,18 +791,18 @@ make_last_run_index([], Result, TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuil {ok, [Result|total_row(TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt, false)], {TotSucc,TotFail,UserSkip,AutoSkip,TotNotBuilt}}. -make_one_index_entry(SuiteName, LogDir, All, Missing) -> +make_one_index_entry(SuiteName, LogDir, Label, All, Missing) -> case count_cases(LogDir) of {Succ,Fail,UserSkip,AutoSkip} -> NotBuilt = not_built(SuiteName, LogDir, All, Missing), - NewResult = make_one_index_entry1(SuiteName, LogDir, Succ, Fail, + NewResult = make_one_index_entry1(SuiteName, LogDir, Label, Succ, Fail, UserSkip, AutoSkip, NotBuilt, All), {NewResult,Succ,Fail,UserSkip,AutoSkip,NotBuilt}; error -> error end. -make_one_index_entry1(SuiteName, Link, Success, Fail, UserSkip, AutoSkip, +make_one_index_entry1(SuiteName, Link, Label, Success, Fail, UserSkip, AutoSkip, NotBuilt, All) -> LogFile = filename:join(Link, ?suitelog_name ++ ".html"), CrashDumpName = SuiteName ++ "_erl_crash.dump", @@ -803,7 +814,7 @@ make_one_index_entry1(SuiteName, Link, Success, Fail, UserSkip, AutoSkip, false -> "" end, - {Timestamp,Node,AllInfo} = + {Lbl,Timestamp,Node,AllInfo} = case All of {true,OldRuns} -> [_Prefix,NodeOrDate|_] = string:tokens(Link,"."), @@ -811,20 +822,21 @@ make_one_index_entry1(SuiteName, Link, Success, Fail, UserSkip, AutoSkip, 0 -> "-"; _ -> NodeOrDate end, - N = ["<TD ALIGN=right>",Node1,"</TD>\n"], + N = ["<TD ALIGN=right><FONT SIZE=-1>",Node1,"</FONT></TD>\n"], CtRunDir = filename:dirname(filename:dirname(Link)), - T = ["<TD>",timestamp(CtRunDir),"</TD>\n"], + L = ["<TD ALIGN=center><FONT SIZE=-1><B>",Label,"</FONT></B></TD>\n"], + T = ["<TD><FONT SIZE=-1>",timestamp(CtRunDir),"</FONT></TD>\n"], CtLogFile = filename:join(CtRunDir,?ct_log_name), OldRunsLink = case OldRuns of [] -> "none"; _ -> "<A HREF=\""++?all_runs_name++"\">Old Runs</A>" end, - A=["<TD><A HREF=\"",CtLogFile,"\">CT Log</A></TD>\n", - "<TD>",OldRunsLink,"</TD>\n"], - {T,N,A}; + A=["<TD><FONT SIZE=-1><A HREF=\"",CtLogFile,"\">CT Log</A></FONT></TD>\n", + "<TD><FONT SIZE=-1>",OldRunsLink,"</FONT></TD>\n"], + {L,T,N,A}; false -> - {"","",""} + {"","","",""} end, NotBuiltStr = if NotBuilt == 0 -> @@ -851,7 +863,8 @@ make_one_index_entry1(SuiteName, Link, Success, Fail, UserSkip, AutoSkip, {UserSkip+AutoSkip,integer_to_list(UserSkip),ASStr} end, ["<TR valign=top>\n", - "<TD><A HREF=\"",LogFile,"\">",SuiteName,"</A>",CrashDumpLink,"</TD>\n", + "<TD><FONT SIZE=-1><A HREF=\"",LogFile,"\">",SuiteName,"</A>",CrashDumpLink,"</FONT></TD>\n", + Lbl, Timestamp, "<TD ALIGN=right>",integer_to_list(Success),"</TD>\n", "<TD ALIGN=right>",FailStr,"</TD>\n", @@ -862,12 +875,14 @@ make_one_index_entry1(SuiteName, Link, Success, Fail, UserSkip, AutoSkip, AllInfo, "</TR>\n"]. total_row(Success, Fail, UserSkip, AutoSkip, NotBuilt, All) -> - {TimestampCell,AllInfo} = + {Label,TimestampCell,AllInfo} = case All of - true -> - {"<TD> </TD>\n","<TD> </TD>\n<TD> </TD>\n"}; + true -> + {"<TD> </TD>\n", + "<TD> </TD>\n", + "<TD> </TD>\n<TD> </TD>\n"}; false -> - {"",""} + {"","",""} end, {AllSkip,UserSkipStr,AutoSkipStr} = @@ -877,6 +892,7 @@ total_row(Success, Fail, UserSkip, AutoSkip, NotBuilt, All) -> end, ["<TR valign=top>\n", "<TD><B>Total</B></TD>", + Label, TimestampCell, "<TD ALIGN=right><B>",integer_to_list(Success),"<B></TD>\n", "<TD ALIGN=right><B>",integer_to_list(Fail),"<B></TD>\n", @@ -937,13 +953,21 @@ term_to_text(Term) -> %%% Headers and footers. -index_header(StartTime) -> - [header("Test Results " ++ format_time(StartTime)) | +index_header(Label, StartTime) -> + Head = + case Label of + undefined -> + header("Test Results", format_time(StartTime)); + _ -> + header("Test Results for \"" ++ Label ++ "\"", + format_time(StartTime)) + end, + [Head | ["<CENTER>\n", "<P><A HREF=\"",?ct_log_name,"\">Common Test Framework Log</A></P>", "<TABLE border=\"3\" cellpadding=\"5\" " "BGCOLOR=\"",?table_color3,"\">\n" - "<th><B>Name</B></th>\n", + "<th><B>Test Name</B></th>\n", "<th><font color=\"",?table_color3,"\">_</font>Ok" "<font color=\"",?table_color3,"\">_</font></th>\n" "<th>Failed</th>\n", @@ -952,13 +976,17 @@ index_header(StartTime) -> "\n"]]. all_suites_index_header() -> + {ok,Cwd} = file:get_cwd(), + LogDir = filename:basename(Cwd), + AllRuns = "All test runs in \"" ++ LogDir ++ "\"", [header("Test Results") | ["<CENTER>\n", - "<A HREF=\"",?all_runs_name,"\">All Test Runs in this directory</A>\n", + "<A HREF=\"",?all_runs_name,"\">",AllRuns,"</A>\n", "<br><br>\n", "<TABLE border=\"3\" cellpadding=\"5\" " "BGCOLOR=\"",?table_color2,"\">\n" - "<th>Name</th>\n", + "<th>Test Name</th>\n", + "<th>Label</th>\n", "<th>Test Run Started</th>\n", "<th><font color=\"",?table_color2,"\">_</font>Ok" "<font color=\"",?table_color2,"\">_</font></th>\n" @@ -971,13 +999,17 @@ all_suites_index_header() -> "\n"]]. all_runs_header() -> - [header("All test runs in current directory") | + {ok,Cwd} = file:get_cwd(), + LogDir = filename:basename(Cwd), + Title = "All test runs in \"" ++ LogDir ++ "\"", + [header(Title) | ["<CENTER><TABLE border=\"3\" cellpadding=\"5\" " "BGCOLOR=\"",?table_color1,"\">\n" "<th><B>History</B></th>\n" "<th><B>Node</B></th>\n" + "<th><B>Label</B></th>\n" "<th>Tests</th>\n" - "<th><B>Names</B></th>\n" + "<th><B>Test Names</B></th>\n" "<th>Total</th>\n" "<th><font color=\"",?table_color1,"\">_</font>Ok" "<font color=\"",?table_color1,"\">_</font></th>\n" @@ -987,12 +1019,23 @@ all_runs_header() -> "\n"]]. header(Title) -> + header1(Title, ""). +header(Title, SubTitle) -> + header1(Title, SubTitle). + +header1(Title, SubTitle) -> + SubTitleHTML = if SubTitle =/= "" -> + ["<CENTER>\n", + "<H2>" ++ SubTitle ++ "</H2>\n", + "</CENTER>\n<BR>\n"]; + true -> "<BR>\n" + end, ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" "<!-- autogenerated by '"++atom_to_list(?MODULE)++"'. -->\n" "<HTML>\n", "<HEAD>\n", - "<TITLE>" ++ Title ++ "</TITLE>\n", + "<TITLE>" ++ Title ++ " " ++ SubTitle ++ "</TITLE>\n", "<META HTTP-EQUIV=\"CACHE-CONTROL\" CONTENT=\"NO-CACHE\">\n", "</HEAD>\n", @@ -1004,6 +1047,7 @@ header(Title) -> "<CENTER>\n", "<H1>" ++ Title ++ "</H1>\n", "</CENTER>\n", + SubTitleHTML, "<!-- ---- CONTENT ---- -->\n"]. @@ -1013,19 +1057,28 @@ index_footer() -> footer() -> ["<P><CENTER>\n" - "<HR>\n" - "<P><FONT SIZE=-1>\n" - "Copyright © ", year(), - " <A HREF=\"http://erlang.ericsson.se\">Open Telecom Platform</A><BR>\n" - "Updated: <!date>", current_time(), "<!/date><BR>\n" - "</FONT>\n" - "</CENTER>\n" - "</body>\n"]. + "<BR><BR>\n" + "<HR>\n" + "<P><FONT SIZE=-1>\n" + "Copyright © ", year(), + " <A HREF=\"http://erlang.ericsson.se\">Open Telecom Platform</A><BR>\n" + "Updated: <!date>", current_time(), "<!/date><BR>\n" + "</FONT>\n" + "</CENTER>\n" + "</body>\n"]. body_tag() -> - "<body bgcolor=\"#FFFFFF\" text=\"#000000\" link=\"#0000FF\"" - "vlink=\"#800080\" alink=\"#FF0000\">\n". + case basic_html() of + true -> + "<body bgcolor=\"#FFFFFF\" text=\"#000000\" link=\"#0000FF\" " + "vlink=\"#800080\" alink=\"#FF0000\">\n"; + false -> + CTPath = code:lib_dir(common_test), + TileFile = filename:join(filename:join(CTPath,"priv"),"tile1.jpg"), + "<body background=\"" ++ TileFile ++ "\" bgcolor=\"#FFFFFF\" text=\"#000000\" link=\"#0000FF\" " + "vlink=\"#800080\" alink=\"#FF0000\">\n" + end. current_time() -> format_time(calendar:local_time()). @@ -1217,7 +1270,7 @@ runentry(Dir, BasicHtml) -> TotalsFile = filename:join(Dir,?totals_name), TotalsStr = case read_totals_file(TotalsFile) of - {Node,Logs,{TotSucc,TotFail,UserSkip,AutoSkip,NotBuilt}} -> + {Node,Label,Logs,{TotSucc,TotFail,UserSkip,AutoSkip,NotBuilt}} -> TotFailStr = if TotFail > 0 -> ["<FONT color=\"red\">", @@ -1263,6 +1316,7 @@ runentry(Dir, BasicHtml) -> end, Total = TotSucc+TotFail+AllSkip, A = ["<TD ALIGN=center><FONT SIZE=-1>",Node,"</FONT></TD>\n", + "<TD ALIGN=center><FONT SIZE=-1><B>",Label,"</B></FONT></TD>\n", "<TD ALIGN=right>",NoOfTests,"</TD>\n"], B = if BasicHtml -> ["<TD ALIGN=center><FONT SIZE=-1>",TestNamesTrunc,"</FONT></TD>\n"]; @@ -1283,17 +1337,19 @@ runentry(Dir, BasicHtml) -> end, Index = filename:join(Dir,?index_name), ["<TR>\n" - "<TD><A HREF=\"",Index,"\">",timestamp(Dir),"</A>",TotalsStr,"</TD>\n" + "<TD><FONT SIZE=-1><A HREF=\"",Index,"\">",timestamp(Dir),"</A>",TotalsStr,"</FONT></TD>\n" "</TR>\n"]. -write_totals_file(Name,Logs,Totals) -> +write_totals_file(Name,Label,Logs,Totals) -> AbsName = ?abs(Name), notify_and_lock_file(AbsName), force_write_file(AbsName, term_to_binary({atom_to_list(node()), - Logs,Totals})), + Label,Logs,Totals})), notify_and_unlock_file(AbsName). +%% this function needs to convert from old formats to new so that old +%% test results (prev ct versions) can be listed together with new read_totals_file(Name) -> AbsName = ?abs(Name), notify_and_lock_file(AbsName), @@ -1303,12 +1359,23 @@ read_totals_file(Name) -> case catch binary_to_term(Bin) of {'EXIT',_Reason} -> % corrupt file {"-",[],undefined}; - R = {Node,Ls,Tot} -> + {Node,Label,Ls,Tot} -> % all info available + Label1 = case Label of + undefined -> "-"; + _ -> Label + end, case Tot of - {_,_,_,_,_} -> % latest format - R; + {_Ok,_Fail,_USkip,_ASkip,_NoBuild} -> % latest format + {Node,Label1,Ls,Tot}; {TotSucc,TotFail,AllSkip,NotBuilt} -> - {Node,Ls,{TotSucc,TotFail,AllSkip,undefined,NotBuilt}} + {Node,Label1,Ls,{TotSucc,TotFail,AllSkip,undefined,NotBuilt}} + end; + {Node,Ls,Tot} -> % no label found + case Tot of + {_Ok,_Fail,_USkip,_ASkip,_NoBuild} -> % latest format + {Node,"-",Ls,Tot}; + {TotSucc,TotFail,AllSkip,NotBuilt} -> + {Node,"-",Ls,{TotSucc,TotFail,AllSkip,undefined,NotBuilt}} end; %% for backwards compatibility {Ls,Tot} -> {"-",Ls,Tot}; @@ -1411,7 +1478,7 @@ make_all_suites_index1(When,AllSuitesLogDirs) -> make_all_suites_index2(IndexName,AllSuitesLogDirs) -> {ok,Index0,_Totals} = make_all_suites_index3(AllSuitesLogDirs, all_suites_index_header(), - 0, 0, 0, 0, 0), + 0, 0, 0, 0, 0, []), Index = [Index0|index_footer()], case force_write_file(IndexName, Index) of ok -> @@ -1421,14 +1488,25 @@ make_all_suites_index2(IndexName,AllSuitesLogDirs) -> end. make_all_suites_index3([{SuiteName,[LastLogDir|OldDirs]}|Rest], - Result, TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt) -> + Result, TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt, + Labels) -> [EntryDir|_] = filename:split(LastLogDir), Missing = case file:read_file(filename:join(EntryDir,?missing_suites_info)) of {ok,Bin} -> binary_to_term(Bin); _ -> [] end, - case make_one_index_entry(SuiteName, LastLogDir, {true,OldDirs}, Missing) of + {Label,Labels1} = + case proplists:get_value(EntryDir, Labels) of + undefined -> + case read_totals_file(filename:join(EntryDir,?totals_name)) of + {_,Lbl,_,_} -> {Lbl,[{EntryDir,Lbl}|Labels]}; + _ -> {"-",[{EntryDir,"-"}|Labels]} + end; + Lbl -> + {Lbl,Labels} + end, + case make_one_index_entry(SuiteName, LastLogDir, Label, {true,OldDirs}, Missing) of {Result1,Succ,Fail,USkip,ASkip,NotBuilt} -> %% for backwards compatibility AutoSkip1 = case catch AutoSkip+ASkip of @@ -1437,13 +1515,13 @@ make_all_suites_index3([{SuiteName,[LastLogDir|OldDirs]}|Rest], end, make_all_suites_index3(Rest, [Result|Result1], TotSucc+Succ, TotFail+Fail, UserSkip+USkip, AutoSkip1, - TotNotBuilt+NotBuilt); + TotNotBuilt+NotBuilt,Labels1); error -> make_all_suites_index3(Rest, Result, TotSucc, TotFail, - UserSkip, AutoSkip, TotNotBuilt) + UserSkip, AutoSkip, TotNotBuilt,Labels1) end; make_all_suites_index3([], Result, TotSucc, TotFail, UserSkip, AutoSkip, - TotNotBuilt) -> + TotNotBuilt,_) -> {ok, [Result|total_row(TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt,true)], {TotSucc,TotFail,UserSkip,AutoSkip,TotNotBuilt}}. diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index 7eb2c3cfef..2ea2ba106a 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2006-2010. 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% %% @@ -28,7 +28,7 @@ -export([abort/0,abort/1,progress/0]). --export([init_master/6, init_node_ctrl/3]). +-export([init_master/7, init_node_ctrl/3]). -export([status/2]). @@ -49,7 +49,8 @@ %%% OptTuples = {config,CfgFiles} | {dir,TestDirs} | {suite,Suites} | %%% {testcase,Cases} | {spec,TestSpecs} | {allow_user_terms,Bool} | %%% {logdir,LogDir} | {event_handler,EventHandlers} | -%%% {silent_connections,Conns} | {cover,CoverSpecFile} +%%% {silent_connections,Conns} | {cover,CoverSpecFile} | +%%% {userconfig, UserCfgFiles} %%% CfgFiles = string() | [string()] %%% TestDirs = string() | [string()] %%% Suites = atom() | [atom()] @@ -98,11 +99,16 @@ run([TS|TestSpecs],AllowUserTerms,InclNodes,ExclNodes) when is_list(TS), {error,Reason} -> {error,Reason}; TSRec=#testspec{logdir=AllLogDirs, - config=AllCfgFiles, + config=StdCfgFiles, + userconfig=UserCfgFiles, + include=AllIncludes, + init=AllInitOpts, event_handler=AllEvHs} -> + AllCfgFiles = {StdCfgFiles, UserCfgFiles}, RunSkipPerNode = ct_testspec:prepare_tests(TSRec), RunSkipPerNode2 = exclude_nodes(ExclNodes,RunSkipPerNode), - run_all(RunSkipPerNode2,AllLogDirs,AllCfgFiles,AllEvHs,[],[],TS1) + run_all(RunSkipPerNode2,AllLogDirs,AllCfgFiles,AllEvHs, + AllIncludes,[],[],AllInitOpts,TS1) end, [{TS,Result} | run(TestSpecs,AllowUserTerms,InclNodes,ExclNodes)]; run([],_,_,_) -> @@ -157,10 +163,15 @@ run_on_node([TS|TestSpecs],AllowUserTerms,Node) when is_list(TS),is_atom(Node) - {error,Reason} -> {error,Reason}; TSRec=#testspec{logdir=AllLogDirs, - config=AllCfgFiles, + config=StdCfgFiles, + init=AllInitOpts, + include=AllIncludes, + userconfig=UserCfgFiles, event_handler=AllEvHs} -> + AllCfgFiles = {StdCfgFiles, UserCfgFiles}, {Run,Skip} = ct_testspec:prepare_tests(TSRec,Node), - run_all([{Node,Run,Skip}],AllLogDirs,AllCfgFiles,AllEvHs,[],[],TS1) + run_all([{Node,Run,Skip}],AllLogDirs,AllCfgFiles,AllEvHs, + AllIncludes, [],[],AllInitOpts,TS1) end, [{TS,Result} | run_on_node(TestSpecs,AllowUserTerms,Node)]; run_on_node([],_,_) -> @@ -180,7 +191,9 @@ run_on_node(TestSpecs,Node) -> -run_all([{Node,Run,Skip}|Rest],AllLogDirs,AllCfgFiles,AllEvHs,NodeOpts,LogDirs,Specs) -> +run_all([{Node,Run,Skip}|Rest],AllLogDirs, + {AllStdCfgFiles, AllUserCfgFiles}=AllCfgFiles, + AllEvHs,AllIncludes,NodeOpts,LogDirs,InitOptions,Specs) -> LogDir = lists:foldl(fun({N,Dir},_Found) when N == Node -> Dir; @@ -191,29 +204,47 @@ run_all([{Node,Run,Skip}|Rest],AllLogDirs,AllCfgFiles,AllEvHs,NodeOpts,LogDirs,S (_Dir,Found) -> Found end,".",AllLogDirs), - CfgFiles = + + StdCfgFiles = lists:foldr(fun({N,F},Fs) when N == Node -> [F|Fs]; ({_N,_F},Fs) -> Fs; (F,Fs) -> [F|Fs] - end,[],AllCfgFiles), + end,[],AllStdCfgFiles), + UserCfgFiles = + lists:foldr(fun({N,F},Fs) when N == Node -> [{userconfig, F}|Fs]; + ({_N,_F},Fs) -> Fs; + (F,Fs) -> [{userconfig, F}|Fs] + end,[],AllUserCfgFiles), + + Includes = lists:foldr(fun({N,I},Acc) when N =:= Node -> + [I|Acc]; + ({_,_},Acc) -> + Acc; + (I,Acc) -> + [I | Acc] + end, [], AllIncludes), EvHs = lists:foldr(fun({N,H,A},Hs) when N == Node -> [{H,A}|Hs]; ({_N,_H,_A},Hs) -> Hs; ({H,A},Hs) -> [{H,A}|Hs] end,[],AllEvHs), + NO = {Node,[{prepared_tests,{Run,Skip},Specs}, {logdir,LogDir}, - {config,CfgFiles}, - {event_handler,EvHs}]}, - run_all(Rest,AllLogDirs,AllCfgFiles,AllEvHs,[NO|NodeOpts],[LogDir|LogDirs],Specs); -run_all([],AllLogDirs,_,AllEvHs,NodeOpts,LogDirs,Specs) -> + {include, Includes}, + {config,StdCfgFiles}, + {event_handler,EvHs}] ++ UserCfgFiles}, + run_all(Rest,AllLogDirs,AllCfgFiles,AllEvHs,AllIncludes, + [NO|NodeOpts],[LogDir|LogDirs],InitOptions,Specs); +run_all([],AllLogDirs,_,AllEvHs,_AllIncludes, + NodeOpts,LogDirs,InitOptions,Specs) -> Handlers = [{H,A} || {Master,H,A} <- AllEvHs, Master == master], MasterLogDir = case lists:keysearch(master,1,AllLogDirs) of {value,{_,Dir}} -> Dir; false -> "." end, log(tty,"Master Logdir","~s",[MasterLogDir]), - start_master(lists:reverse(NodeOpts),Handlers,MasterLogDir,LogDirs,Specs), + start_master(lists:reverse(NodeOpts),Handlers,MasterLogDir,LogDirs,InitOptions,Specs), ok. @@ -251,17 +282,17 @@ progress() -> %%% MASTER, runs on central controlling node. %%%----------------------------------------------------------------- start_master(NodeOptsList) -> - start_master(NodeOptsList,[],".",[],[]). + start_master(NodeOptsList,[],".",[],[],[]). -start_master(NodeOptsList,EvHandlers,MasterLogDir,LogDirs,Specs) -> +start_master(NodeOptsList,EvHandlers,MasterLogDir,LogDirs,InitOptions,Specs) -> Master = spawn_link(?MODULE,init_master,[self(),NodeOptsList,EvHandlers, - MasterLogDir,LogDirs,Specs]), + MasterLogDir,LogDirs,InitOptions,Specs]), receive {Master,Result} -> Result end. %%% @hidden -init_master(Parent,NodeOptsList,EvHandlers,MasterLogDir,LogDirs,Specs) -> +init_master(Parent,NodeOptsList,EvHandlers,MasterLogDir,LogDirs,InitOptions,Specs) -> case whereis(ct_master) of undefined -> register(ct_master,self()), @@ -314,10 +345,10 @@ init_master(Parent,NodeOptsList,EvHandlers,MasterLogDir,LogDirs,Specs) -> Pid when is_pid(Pid) -> ok end, - init_master1(Parent,NodeOptsList,LogDirs). + init_master1(Parent,NodeOptsList,InitOptions,LogDirs). -init_master1(Parent,NodeOptsList,LogDirs) -> - {Inaccessible,NodeOptsList1} = ping_nodes(NodeOptsList,[],[]), +init_master1(Parent,NodeOptsList,InitOptions,LogDirs) -> + {Inaccessible,NodeOptsList1,InitOptions1} = init_nodes(NodeOptsList,InitOptions), case Inaccessible of [] -> init_master2(Parent,NodeOptsList,LogDirs); @@ -331,7 +362,7 @@ init_master1(Parent,NodeOptsList,LogDirs) -> "Proceeding without: ~p",[Inaccessible]), init_master2(Parent,NodeOptsList1,LogDirs); "r\n" -> - init_master1(Parent,NodeOptsList,LogDirs); + init_master1(Parent,NodeOptsList,InitOptions1,LogDirs); _ -> log(html,"Aborting Tests","",[]), ct_master_event:stop(), @@ -542,6 +573,9 @@ get_pid(Node,NodeCtrlPids) -> undefined end. +ping_nodes(NodeOptions)-> + ping_nodes(NodeOptions, [], []). + ping_nodes([NO={Node,_Opts}|NOs],Inaccessible,NodeOpts) -> case net_adm:ping(Node) of pong -> @@ -678,13 +712,80 @@ call(Pid,Msg) -> {'DOWN', Ref, _, _, _} -> {error,master_died} end, - erlang:demonitor(Ref), + erlang:demonitor(Ref, [flush]), Return. reply(Result,To) -> To ! {self(),Result}, ok. +init_nodes(NodeOptions, InitOptions)-> + ping_nodes(NodeOptions), + start_nodes(InitOptions), + eval_on_nodes(InitOptions), + {Inaccessible, NodeOptions1}=ping_nodes(NodeOptions), + InitOptions1 = filter_accessible(InitOptions, Inaccessible), + {Inaccessible, NodeOptions1, InitOptions1}. + +% only nodes which are inaccessible now, should be initiated later +filter_accessible(InitOptions, Inaccessible)-> + [{Node,Option}||{Node,Option}<-InitOptions, lists:member(Node, Inaccessible)]. + +start_nodes(InitOptions)-> + lists:foreach(fun({NodeName, Options})-> + [NodeS,HostS]=string:tokens(atom_to_list(NodeName), "@"), + Node=list_to_atom(NodeS), + Host=list_to_atom(HostS), + HasNodeStart = lists:keymember(node_start, 1, Options), + IsAlive = lists:member(NodeName, nodes()), + case {HasNodeStart, IsAlive} of + {false, false}-> + io:format("WARNING: Node ~p is not alive but has no node_start option~n", [NodeName]); + {false, true}-> + io:format("Node ~p is alive~n", [NodeName]); + {true, false}-> + {node_start, NodeStart} = lists:keyfind(node_start, 1, Options), + {value, {callback_module, Callback}, NodeStart2}= + lists:keytake(callback_module, 1, NodeStart), + case Callback:start(Host, Node, NodeStart2) of + {ok, NodeName} -> + io:format("Node ~p started successfully with callback ~p~n", [NodeName,Callback]); + {error, Reason, _NodeName} -> + io:format("Failed to start node ~p with callback ~p! Reason: ~p~n", [NodeName, Callback, Reason]) + end; + {true, true}-> + io:format("WARNING: Node ~p is alive but has node_start option~n", [NodeName]) + end + end, + InitOptions). + +eval_on_nodes(InitOptions)-> + lists:foreach(fun({NodeName, Options})-> + HasEval = lists:keymember(eval, 1, Options), + IsAlive = lists:member(NodeName, nodes()), + case {HasEval, IsAlive} of + {false,_}-> + ok; + {true,false}-> + io:format("WARNING: Node ~p is not alive but has eval option ~n", [NodeName]); + {true,true}-> + {eval, MFAs} = lists:keyfind(eval, 1, Options), + evaluate(NodeName, MFAs) + end + end, + InitOptions). + +evaluate(Node, [{M,F,A}|MFAs])-> + case rpc:call(Node, M, F, A) of + {badrpc,Reason}-> + io:format("WARNING: Failed to call ~p:~p/~p on node ~p due to ~p~n", [M,F,length(A),Node,Reason]); + Result-> + io:format("Called ~p:~p/~p on node ~p, result: ~p~n", [M,F,length(A),Node,Result]) + end, + evaluate(Node, MFAs); +evaluate(_Node, [])-> + ok. + %cast(Msg) -> % cast(whereis(ct_master),Msg). diff --git a/lib/common_test/src/ct_master_logs.erl b/lib/common_test/src/ct_master_logs.erl index 63f60b1182..244faace06 100644 --- a/lib/common_test/src/ct_master_logs.erl +++ b/lib/common_test/src/ct_master_logs.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2006-2010. 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% %% @@ -44,7 +44,7 @@ start(LogDir,Nodes) -> MRef = erlang:monitor(process,Pid), receive {started,Pid,Result} -> - erlang:demonitor(MRef), + erlang:demonitor(MRef, [flush]), {Pid,Result}; {'DOWN',MRef,process,_,Reason} -> exit({could_not_start_process,?MODULE,Reason}) @@ -435,7 +435,7 @@ call(Msg) -> ?MODULE ! {Msg,{self(),Ref}}, receive {Ref, Result} -> - erlang:demonitor(MRef), + erlang:demonitor(MRef, [flush]), Result; {'DOWN',MRef,process,_,Reason} -> {error,{process_down,?MODULE,Reason}} diff --git a/lib/common_test/src/ct_repeat.erl b/lib/common_test/src/ct_repeat.erl index 7ac6e045d7..be3c485b75 100644 --- a/lib/common_test/src/ct_repeat.erl +++ b/lib/common_test/src/ct_repeat.erl @@ -1,26 +1,26 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2007-2010. 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 module that handles repeated test runs %%% %%% <p>This module exports functions for repeating tests. The following -%%% script flags (or equivalent ct:run_test/1 options) are supported: +%%% start flags (or equivalent ct:run_test/1 options) are supported: %%% -until <StopTime>, StopTime = YYMoMoDDHHMMSS | HHMMSS %%% -duration <DurTime>, DurTime = HHMMSS %%% -force_stop diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 6b1063f74c..7bd7dc7d66 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2010. All Rights Reserved. +%% Copyright Ericsson AB 2004-2011. 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,6 @@ -module(ct_run). - %% Script interface -export([script_start/0,script_usage/0]). @@ -46,26 +45,84 @@ -define(abs(Name), filename:absname(Name)). -define(testdir(Name, Suite), ct_util:get_testdir(Name, Suite)). +-record(opts, {label, + vts, + shell, + cover, + coverspec, + step, + logdir, + config = [], + event_handlers = [], + ct_hooks = [], + include = [], + silent_connections, + stylesheet, + multiply_timetraps = 1, + scale_timetraps = false, + testspecs = [], + tests}). + %%%----------------------------------------------------------------- %%% @spec script_start() -> void() %%% -%%% @doc Start tests via the run_test script. -%%% -%%% <p>Example:<br/><code>./run_test -config config.ctc -dir +%%% @doc Start tests via the ct_run program or script. +%%% +%%% <p>Example:<br/><code>./ct_run -config config.ctc -dir %%% $TEST_DIR</code></p> %%% -%%% <p>Example:<br/><code>./run_test -config config.ctc -suite +%%% <p>Example:<br/><code>./ct_run -config config.ctc -suite %%% $SUITE_PATH/$SUITE_NAME [-case $CASE_NAME]</code></p> %%% script_start() -> process_flag(trap_exit, true), - Args = merge_arguments(init:get_arguments()), + Init = init:get_arguments(), + CtArgs = lists:takewhile(fun({ct_erl_args,_}) -> false; + (_) -> true end, Init), + + %% convert relative dirs added with pa or pz (pre erl_args on + %% the ct_run command line) to absolute so that app modules + %% can be found even after CT changes CWD to logdir + rel_to_abs(CtArgs), + + Args = + case application:get_env(common_test, run_test_start_opts) of + {ok,EnvStartOpts} -> + FlagFilter = fun(Flags) -> + lists:filter(fun({root,_}) -> false; + ({progname,_}) -> false; + ({home,_}) -> false; + ({noshell,_}) -> false; + ({noinput,_}) -> false; + (_) -> true + end, Flags) + end, + %% used for purpose of testing the run_test interface + io:format(user, "~n-------------------- START ARGS --------------------~n", []), + io:format(user, "--- Init args:~n~p~n", [FlagFilter(Init)]), + io:format(user, "--- CT args:~n~p~n", [FlagFilter(CtArgs)]), + EnvArgs = opts2args(EnvStartOpts), + io:format(user, "--- Env opts -> args:~n~p~n =>~n~p~n", + [EnvStartOpts,EnvArgs]), + Merged = merge_arguments(CtArgs ++ EnvArgs), + io:format(user, "--- Merged args:~n~p~n", [FlagFilter(Merged)]), + io:format(user, "----------------------------------------------------~n~n", []), + Merged; + _ -> + merge_arguments(CtArgs) + end, + case proplists:get_value(help, Args) of + undefined -> script_start(Args); + _ -> script_usage() + end. + +script_start(Args) -> Tracing = start_trace(Args), - Res = + Res = case ct_repeat:loop_test(script, Args) of - false -> + false -> {ok,Cwd} = file:get_cwd(), - CTVsn = + CTVsn = case filename:basename(code:lib_dir(common_test)) of CTBase when is_list(CTBase) -> case string:tokens(CTBase, "-") of @@ -76,7 +133,7 @@ script_start() -> io:format("~nCommon Test~s starting (cwd is ~s)~n~n", [CTVsn,Cwd]), Self = self(), Pid = spawn_link(fun() -> script_start1(Self, Args) end), - receive + receive {'EXIT',Pid,Reason} -> case Reason of {user_error,What} -> @@ -98,326 +155,384 @@ script_start() -> Result end, stop_trace(Tracing), + timer:sleep(1000), Res. script_start1(Parent, Args) -> - case lists:keymember(preload, 1, Args) of - true -> preload(); - false -> ok - end, - - VtsOrShell = - case lists:keymember(vts, 1, Args) of - true -> - vts; - false -> - case lists:keymember(shell, 1, Args) of - true -> shell; - false -> false - end - end, - LogDir = - case lists:keysearch(logdir, 1, Args) of - {value,{logdir,[LogD]}} -> LogD; - false -> "." - end, - EvHandlers = - case lists:keysearch(event_handler, 1, Args) of - {value,{event_handler,Handlers}} -> - lists:map(fun(H) -> {list_to_atom(H),[]} end, Handlers); - false -> - [] - end, - Cover = - case lists:keysearch(cover, 1, Args) of - {value,{cover,CoverFile}} -> - {cover,?abs(CoverFile)}; - false -> - false - end, - - case lists:keysearch(ct_decrypt_key, 1, Args) of - {value,{_,[DecryptKey]}} -> + %% read general start flags + Label = get_start_opt(label, fun([Lbl]) -> Lbl end, 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), + LogDir = get_start_opt(logdir, fun([LogD]) -> LogD end, Args), + MultTT = get_start_opt(multiply_timetraps, + fun([MT]) -> list_to_integer(MT) end, 1, Args), + ScaleTT = get_start_opt(scale_timetraps, + fun([CT]) -> list_to_atom(CT); + ([]) -> true + end, false, Args), + EvHandlers = event_handler_args2opts(Args), + CTHooks = ct_hooks_args2opts(Args), + + %% check flags and set corresponding application env variables + + %% ct_decrypt_key | ct_decrypt_file + case proplists:get_value(ct_decrypt_key, Args) of + [DecryptKey] -> application:set_env(common_test, decrypt, {key,DecryptKey}); - false -> - case lists:keysearch(ct_decrypt_file, 1, Args) of - {value,{_,[DecryptFile]}} -> - application:set_env(common_test, decrypt, - {file,filename:absname(DecryptFile)}); - false -> + undefined -> + case proplists:get_value(ct_decrypt_file, Args) of + [DecryptFile] -> + application:set_env(common_test, decrypt, + {file,?abs(DecryptFile)}); + undefined -> application:unset_env(common_test, decrypt) end end, - - case lists:keysearch(no_auto_compile, 1, Args) of - {value,_} -> - application:set_env(common_test, auto_compile, false); - false -> - application:set_env(common_test, auto_compile, true), - - InclDirs = - case lists:keysearch(include,1,Args) of - {value,{include,Incl}} when is_list(hd(Incl)) -> - Incl; - {value,{include,Incl}} when is_list(Incl) -> - [Incl]; + %% no_auto_compile + include + IncludeDirs = + case proplists:get_value(no_auto_compile, Args) of + undefined -> + application:set_env(common_test, auto_compile, true), + InclDirs = + case proplists:get_value(include, Args) of + Incl when is_list(hd(Incl)) -> + Incl; + Incl when is_list(Incl) -> + [Incl]; + undefined -> + [] + end, + case os:getenv("CT_INCLUDE_PATH") of false -> - [] - end, - case os:getenv("CT_INCLUDE_PATH") of - false -> - application:set_env(common_test, include, InclDirs); - CtInclPath -> - InclDirs1 = string:tokens(CtInclPath,[$:,$ ,$,]), - application:set_env(common_test, include, InclDirs1++InclDirs) - end - end, - - case lists:keysearch(basic_html, 1, Args) of - {value,_} -> - application:set_env(common_test, basic_html, true); - false -> - application:set_env(common_test, basic_html, false) - end, - - Result = - case lists:keysearch(refresh_logs, 1, Args) of - {value,{refresh_logs,Refresh}} -> - LogDir1 = case Refresh of - [] -> LogDir; - [RefreshDir] -> ?abs(RefreshDir) - end, - {ok,Cwd} = file:get_cwd(), - file:set_cwd(LogDir1), - timer:sleep(500), % give the shell time to print version etc - io:nl(), - case catch ct_logs:make_all_suites_index(refresh) of - {'EXIT',ASReason} -> - file:set_cwd(Cwd), - {error,{all_suites_index,ASReason}}; - _ -> - case catch ct_logs:make_all_runs_index(refresh) of - {'EXIT',ARReason} -> - file:set_cwd(Cwd), - {error,{all_runs_index,ARReason}}; - _ -> - file:set_cwd(Cwd), - io:format("Logs in ~s refreshed!~n~n", [LogDir1]), - timer:sleep(500), % time to flush io before quitting - ok - end + application:set_env(common_test, include, InclDirs), + InclDirs; + CtInclPath -> + AllInclDirs = + string:tokens(CtInclPath,[$:,$ ,$,]) ++ InclDirs, + application:set_env(common_test, include, AllInclDirs), + AllInclDirs end; - false -> - case lists:keysearch(ct_config, 1, Args) of - {value,{ct_config,ConfigFiles}} -> - case lists:keysearch(spec, 1, Args) of - false -> - case get_configfiles(ConfigFiles, [], LogDir, - EvHandlers) of - ok -> - script_start2(VtsOrShell, ConfigFiles, - EvHandlers, Args, LogDir, - Cover); - Error -> - Error - end; - _ -> - script_start2(VtsOrShell, ConfigFiles, - EvHandlers, Args, LogDir, Cover) - end; - false -> - case install([{config,[]}, - {event_handler,EvHandlers}], - LogDir) of - ok -> - script_start2(VtsOrShell, [], EvHandlers, - Args, LogDir, Cover); - Error -> - Error - end - end + _ -> + application:set_env(common_test, auto_compile, false), + [] end, + %% silent connections + SilentConns = + get_start_opt(silent_connections, + fun(["all"]) -> []; + (Conns) -> [list_to_atom(Conn) || Conn <- Conns] + end, Args), + %% stylesheet + Stylesheet = get_start_opt(stylesheet, + fun([SS]) -> ?abs(SS) end, Args), + %% basic_html - used by ct_logs + case proplists:get_value(basic_html, Args) of + undefined -> + application:set_env(common_test, basic_html, false); + _ -> + application:set_env(common_test, basic_html, true) + end, + + StartOpts = #opts{label = Label, vts = Vts, shell = Shell, cover = Cover, + logdir = LogDir, event_handlers = EvHandlers, + ct_hooks = CTHooks, + include = IncludeDirs, + silent_connections = SilentConns, + stylesheet = Stylesheet, + multiply_timetraps = MultTT, + scale_timetraps = ScaleTT}, + + %% check if log files should be refreshed or go on to run tests... + Result = run_or_refresh(StartOpts, Args), + %% send final results to starting process waiting in script_start/0 Parent ! {self(), Result}. -get_configfiles([File|Files], Acc, LogDir, EvHandlers) -> - case filelib:is_file(File) of - true -> - get_configfiles(Files, [?abs(File)|Acc], - LogDir, EvHandlers); - false -> - {error,{cant_read_config_file,File}} - end; -get_configfiles([], Acc, LogDir, EvHandlers) -> - install([{config,lists:reverse(Acc)}, {event_handler,EvHandlers}], LogDir). +run_or_refresh(StartOpts = #opts{logdir = LogDir}, Args) -> + case proplists:get_value(refresh_logs, Args) of + undefined -> + script_start2(StartOpts, Args); + Refresh -> + LogDir1 = case Refresh of + [] -> which(logdir,LogDir); + [RefreshDir] -> ?abs(RefreshDir) + end, + {ok,Cwd} = file:get_cwd(), + file:set_cwd(LogDir1), + %% give the shell time to print version etc + timer:sleep(500), + io:nl(), + case catch ct_logs:make_all_suites_index(refresh) of + {'EXIT',ASReason} -> + file:set_cwd(Cwd), + {error,{all_suites_index,ASReason}}; + _ -> + case catch ct_logs:make_all_runs_index(refresh) of + {'EXIT',ARReason} -> + file:set_cwd(Cwd), + {error,{all_runs_index,ARReason}}; + _ -> + file:set_cwd(Cwd), + io:format("Logs in ~s refreshed!~n~n", [LogDir1]), + timer:sleep(500), % time to flush io before quitting + ok + end + end + end. -script_start2(false, ConfigFiles, EvHandlers, Args, LogDir, Cover) -> - case lists:keysearch(spec, 1, Args) of - {value,{spec,[]}} -> +script_start2(StartOpts = #opts{vts = undefined, + shell = undefined}, Args) -> + TestSpec = proplists:get_value(spec, Args), + {Terms,Opts} = + case TestSpec of + Specs when Specs =/= [], Specs =/= undefined -> + %% using testspec as input for test + Relaxed = get_start_opt(allow_user_terms, true, false, Args), + case catch ct_testspec:collect_tests_from_file(Specs, Relaxed) of + {E,Reason} when E == error ; E == 'EXIT' -> + {{error,Reason},StartOpts}; + TS -> + SpecStartOpts = get_data_for_node(TS, node()), + + Label = choose_val(StartOpts#opts.label, + SpecStartOpts#opts.label), + + LogDir = choose_val(StartOpts#opts.logdir, + SpecStartOpts#opts.logdir), + + Cover = choose_val(StartOpts#opts.cover, + SpecStartOpts#opts.cover), + MultTT = choose_val(StartOpts#opts.multiply_timetraps, + SpecStartOpts#opts.multiply_timetraps), + ScaleTT = choose_val(StartOpts#opts.scale_timetraps, + SpecStartOpts#opts.scale_timetraps), + AllEvHs = merge_vals([StartOpts#opts.event_handlers, + SpecStartOpts#opts.event_handlers]), + AllCTHooks = merge_vals( + [StartOpts#opts.ct_hooks, + SpecStartOpts#opts.ct_hooks]), + + AllInclude = merge_vals([StartOpts#opts.include, + SpecStartOpts#opts.include]), + application:set_env(common_test, include, AllInclude), + + {TS,StartOpts#opts{label = Label, + testspecs = Specs, + cover = Cover, + logdir = LogDir, + config = SpecStartOpts#opts.config, + event_handlers = AllEvHs, + ct_hooks = AllCTHooks, + include = AllInclude, + multiply_timetraps = MultTT, + scale_timetraps = ScaleTT}} + end; + _ -> + {undefined,StartOpts} + end, + %% read config/userconfig from start flags + InitConfig = ct_config:prepare_config_list(Args), + TheLogDir = which(logdir, Opts#opts.logdir), + case {TestSpec,Terms} of + {_,{error,_}=Error} -> + Error; + {[],_} -> {error,no_testspec_specified}; - {value,{spec,Specs}} -> - Relaxed = lists:keymember(allow_user_terms, 1, Args), - %% using testspec as input for test - case catch ct_testspec:collect_tests_from_file(Specs, Relaxed) of - {error,Reason} -> - {error,Reason}; - TS -> - {LogDir1,TSCoverFile,ConfigFiles1,EvHandlers1,Include1} = - get_data_for_node(TS,node()), - UserInclude = - case application:get_env(common_test, include) of - {ok,Include} -> Include++Include1; - _ -> Include1 - end, - application:set_env(common_test, include, UserInclude), - LogDir2 = which_logdir(LogDir,LogDir1), - CoverOpt = case {Cover,TSCoverFile} of - {false,undef} -> []; - {_,undef} -> [Cover]; - {false,_} -> [{cover,TSCoverFile}] - end, - case get_configfiles(ConfigFiles++ConfigFiles1, - [], LogDir2, - EvHandlers++EvHandlers1) of - ok -> - {Run,Skip} = ct_testspec:prepare_tests(TS, node()), - do_run(Run, Skip, CoverOpt, Args, LogDir2); - Error -> - Error - end + {undefined,_} -> % no testspec used + case check_and_install_configfiles(InitConfig, TheLogDir, + Opts#opts.event_handlers, + Opts#opts.ct_hooks) of + ok -> % go on read tests from start flags + script_start3(Opts#opts{config=InitConfig, + logdir=TheLogDir}, Args); + Error -> + Error end; - false -> - script_start3(false, ConfigFiles, EvHandlers, Args, LogDir, Cover) + {_,_} -> % testspec used + %% 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, + Opts#opts.ct_hooks) of + ok -> % read tests from spec + {Run,Skip} = ct_testspec:prepare_tests(Terms, node()), + do_run(Run, Skip, Opts#opts{config=AllConfig, + logdir=TheLogDir}, Args); + Error -> + Error + end end; -script_start2(VtsOrShell, ConfigFiles, EvHandlers, Args, LogDir, Cover) -> - script_start3(VtsOrShell, ConfigFiles, EvHandlers, Args, LogDir, Cover). -script_start3(VtsOrShell, ConfigFiles, EvHandlers, Args, LogDir, Cover) -> - case lists:keysearch(dir, 1, Args) of - {value,{dir,[]}} -> - {error,no_dir_specified}; - {value,{dir,Dirs}} -> - script_start4(VtsOrShell, ConfigFiles, EvHandlers, tests(Dirs), - Cover, Args, LogDir); +script_start2(StartOpts, Args) -> + %% read config/userconfig from start flags + InitConfig = ct_config:prepare_config_list(Args), + LogDir = which(logdir, StartOpts#opts.logdir), + case check_and_install_configfiles(InitConfig, LogDir, + StartOpts#opts.event_handlers, + StartOpts#opts.ct_hooks) of + ok -> % go on read tests from start flags + script_start3(StartOpts#opts{config=InitConfig, + logdir=LogDir}, Args); + Error -> + Error + end. + +check_and_install_configfiles(Configs, LogDir, EvHandlers, CTHooks) -> + case ct_config:check_config_files(Configs) of false -> - case lists:keysearch(suite, 1, Args) of - {value,{suite,[]}} -> + install([{config,Configs}, + {event_handler,EvHandlers}, + {ct_hooks,CTHooks}], LogDir); + {value,{error,{nofile,File}}} -> + {error,{cant_read_config_file,File}}; + {value,{error,{wrong_config,Message}}}-> + {error,{wrong_config,Message}}; + {value,{error,{callback,Info}}} -> + {error,{cant_load_callback_module,Info}} + end. + +script_start3(StartOpts, Args) -> + case proplists:get_value(dir, Args) of + [] -> + {error,no_dir_specified}; + Dirs when is_list(Dirs) -> + script_start4(StartOpts#opts{tests = tests(Dirs)}, Args); + undefined -> + case proplists:get_value(suite, Args) of + [] -> {error,no_suite_specified}; - {value,{suite,Suites}} -> - StepOrCover = - case lists:keysearch(step, 1, Args) of - {value,Step} -> Step; - false -> Cover - end, - S2M = fun(S) -> - {filename:dirname(S), - list_to_atom( - filename:rootname(filename:basename(S)))} - end, - DirMods = lists:map(S2M, Suites), - {Specified,GroupsAndCases} = - case {lists:keysearch(group, 1, Args), - lists:keysearch('case', 1, Args)} of - {{value,{_,Gs}},{value,{_,Cs}}} -> {true,Gs++Cs}; - {{value,{_,Gs}},_} -> {true,Gs}; - {_,{value,{_,Cs}}} -> {true,Cs}; - _ -> {false,[]} - end, - if Specified, length(GroupsAndCases) == 0 -> - {error,no_case_or_group_specified}; - Specified, length(DirMods) > 1 -> + Suites when is_list(Suites) -> + StartOpts1 = + get_start_opt(step, + fun(Step) -> + StartOpts#opts{step = Step, + cover = undefined} + end, StartOpts, Args), + DirMods = [suite_to_test(S) || S <- Suites], + case groups_and_cases(proplists:get_value(group, Args), + proplists:get_value(testcase, Args)) of + Error = {error,_} -> + Error; + [] when DirMods =/= [] -> + Ts = tests(DirMods), + script_start4(StartOpts1#opts{tests = Ts}, Args); + GroupsAndCases when length(DirMods) == 1 -> + Ts = tests(DirMods, GroupsAndCases), + script_start4(StartOpts1#opts{tests = Ts}, Args); + [_,_|_] when length(DirMods) > 1 -> {error,multiple_suites_and_cases}; - length(GroupsAndCases) > 0, length(DirMods) == 1 -> - GsAndCs = lists:map(fun(C) -> list_to_atom(C) end, - GroupsAndCases), - script_start4(VtsOrShell, ConfigFiles, EvHandlers, - tests(DirMods, GsAndCs), - StepOrCover, Args, LogDir); - not Specified, length(DirMods) > 0 -> - script_start4(VtsOrShell, ConfigFiles, EvHandlers, - tests(DirMods), - StepOrCover, Args, LogDir); - true -> - {error,incorrect_suite_and_case_options} + _ -> + {error,incorrect_suite_option} end; - false when VtsOrShell=/=false -> - script_start4(VtsOrShell, ConfigFiles, EvHandlers, - [], Cover, Args, LogDir); - false -> - script_usage(), - {error,incorrect_usage} + undefined -> + if StartOpts#opts.vts ; StartOpts#opts.shell -> + script_start4(StartOpts#opts{tests = []}, Args); + true -> + script_usage(), + {error,incorrect_usage} + end end end. -script_start4(vts, ConfigFiles, EvHandlers, Tests, false, _Args, LogDir) -> +script_start4(#opts{vts = true, config = Config, event_handlers = EvHandlers, + tests = Tests, logdir = LogDir}, _Args) -> + ConfigFiles = + lists:foldl(fun({ct_config_plain,CfgFiles}, AllFiles) when + is_list(hd(CfgFiles)) -> + AllFiles ++ CfgFiles; + ({ct_config_plain,CfgFile}, AllFiles) when + is_integer(hd(CfgFile)) -> + AllFiles ++ [CfgFile]; + (_, AllFiles) -> + AllFiles + end, [], Config), vts:init_data(ConfigFiles, EvHandlers, ?abs(LogDir), Tests); -script_start4(shell, ConfigFiles, EvHandlers, _Tests, false, Args, LogDir) -> - Opts = [{config,ConfigFiles},{event_handler,EvHandlers}], - if ConfigFiles == [] -> + +script_start4(#opts{label = Label, shell = true, config = Config, + event_handlers = EvHandlers, + ct_hooks = CTHooks, + logdir = LogDir, testspecs = Specs}, _Args) -> + %% label - used by ct_logs + application:set_env(common_test, test_label, Label), + + InstallOpts = [{config,Config},{event_handler,EvHandlers}, + {ct_hooks, CTHooks}], + if Config == [] -> ok; true -> - io:format("\nInstalling: ~p\n\n", [ConfigFiles]) + io:format("\nInstalling: ~p\n\n", [Config]) end, - case install(Opts) of + case install(InstallOpts) of ok -> ct_util:start(interactive, LogDir), - log_ts_names(Args), + log_ts_names(Specs), io:nl(), ok; Error -> Error end; -script_start4(vts, _CfgFs, _EvHs, _Tests, _Cover={cover,_}, _Args, _LogDir) -> - %% Add support later (maybe). - script_usage(), - erlang:halt(); -script_start4(shell, _CfgFs, _EvHs, _Tests, _Cover={cover,_}, _Args, _LogDir) -> - %% Add support later (maybe). - script_usage(); -script_start4(false, _CfgFs, _EvHs, Tests, Cover={cover,_}, Args, LogDir) -> - do_run(Tests, [], [Cover], Args, LogDir); -script_start4(false, _ConfigFiles, _EvHandlers, Tests, false, Args, LogDir) -> - do_run(Tests, [], [], Args, LogDir); -script_start4(false, _ConfigFiles, _EvHandlers, Test, Step, Args, LogDir) -> - do_run(Test, [], [Step], Args, LogDir); -script_start4(vts, _ConfigFiles, _EvHandlers, _Test, _Step, _Args, _LogDir) -> - script_usage(), + +script_start4(#opts{vts = true, cover = Cover}, _) -> + case Cover of + undefined -> + script_usage(); + _ -> + %% Add support later (maybe). + io:format("\nCan't run cover in vts mode.\n\n", []) + end, erlang:halt(); -script_start4(shell, _ConfigFiles, _EvHandlers, _Test, _Step, _Args, _LogDir) -> - script_usage(). + +script_start4(#opts{shell = true, cover = Cover}, _) -> + case Cover of + undefined -> + script_usage(); + _ -> + %% Add support later (maybe). + io:format("\nCan't run cover in interactive mode.\n\n", []) + end; + +script_start4(Opts = #opts{tests = Tests}, Args) -> + do_run(Tests, [], Opts, Args). %%%----------------------------------------------------------------- %%% @spec script_usage() -> ok -%%% @doc Print script usage information for <code>run_test</code>. +%%% @doc Print usage information for <code>ct_run</code>. script_usage() -> io:format("\n\nUsage:\n\n"), io:format("Run tests in web based GUI:\n\n" - "\trun_test -vts [-browser Browser]" + "\tct_run -vts [-browser Browser]" "\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]" "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]" "\n\t[-dir TestDir1 TestDir2 .. TestDirN] |" "\n\t[-suite Suite [-case Case]]" - "\n\t[-include InclDir1 InclDir2 .. InclDirN]" + "\n\t[-include InclDir1 InclDir2 .. InclDirN]" "\n\t[-no_auto_compile]" + "\n\t[-multiply_timetraps N]" + "\n\t[-scale_timetraps]" "\n\t[-basic_html]\n\n"), io:format("Run tests from command line:\n\n" - "\trun_test [-dir TestDir1 TestDir2 .. TestDirN] |" + "\tct_run [-dir TestDir1 TestDir2 .. TestDirN] |" "\n\t[-suite Suite1 Suite2 .. SuiteN [-case Case1 Case2 .. CaseN]]" "\n\t[-step [config | keep_inactive]]" "\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]" + "\n\t[-userconfig CallbackModule ConfigFile1 .. ConfigFileN]" "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]" "\n\t[-logdir LogDir]" "\n\t[-silent_connections [ConnType1 ConnType2 .. ConnTypeN]]" "\n\t[-stylesheet CSSFile]" "\n\t[-cover CoverCfgFile]" "\n\t[-event_handler EvHandler1 EvHandler2 .. EvHandlerN]" - "\n\t[-include InclDir1 InclDir2 .. InclDirN]" + "\n\t[-ct_hooks CTHook1 CTHook2 .. CTHookN]" + "\n\t[-include InclDir1 InclDir2 .. InclDirN]" "\n\t[-no_auto_compile]" - "\n\t[-basic_html]" - "\n\t[-repeat N [-force_stop]] |" + "\n\t[-multiply_timetraps N]" + "\n\t[-scale_timetraps]" + "\n\t[-basic_html]" + "\n\t[-repeat N [-force_stop]] |" "\n\t[-duration HHMMSS [-force_stop]] |" "\n\t[-until [YYMoMoDD]HHMMSS [-force_stop]]\n\n"), io:format("Run tests using test specification:\n\n" - "\trun_test -spec TestSpec1 TestSpec2 .. TestSpecN" + "\tct_run -spec TestSpec1 TestSpec2 .. TestSpecN" "\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]" "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]" "\n\t[-logdir LogDir]" @@ -426,21 +541,23 @@ script_usage() -> "\n\t[-stylesheet CSSFile]" "\n\t[-cover CoverCfgFile]" "\n\t[-event_handler EvHandler1 EvHandler2 .. EvHandlerN]" - "\n\t[-include InclDir1 InclDir2 .. InclDirN]" + "\n\t[-ct_hooks CTHook1 CTHook2 .. CTHookN]" + "\n\t[-include InclDir1 InclDir2 .. InclDirN]" "\n\t[-no_auto_compile]" - "\n\t[-basic_html]" - "\n\t[-repeat N [-force_stop]] |" + "\n\t[-multiply_timetraps N]" + "\n\t[-scale_timetraps]" + "\n\t[-basic_html]" + "\n\t[-repeat N [-force_stop]] |" "\n\t[-duration HHMMSS [-force_stop]] |" "\n\t[-until [YYMoMoDD]HHMMSS [-force_stop]]\n\n"), io:format("Refresh the HTML index files:\n\n" - "\trun_test -refresh_logs [LogDir]" + "\tct_run -refresh_logs [LogDir]" "[-logdir LogDir] " "[-basic_html]\n\n"), io:format("Run CT in interactive mode:\n\n" - "\trun_test -shell" + "\tct_run -shell" "\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]" "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]\n\n"). - %%%----------------------------------------------------------------- %%% @hidden @@ -449,6 +566,9 @@ install(Opts) -> install(Opts, "."). install(Opts, LogDir) -> + + ConfOpts = ct_config:add_default_callback(Opts), + case application:get_env(common_test, decrypt) of {ok,_} -> ok; @@ -465,10 +585,10 @@ install(Opts, LogDir) -> VarFile = variables_file_name(LogDir), case file:open(VarFile, [write]) of {ok,Fd} -> - [io:format(Fd, "~p.\n", [Opt]) || Opt <- Opts], + [io:format(Fd, "~p.\n", [Opt]) || Opt <- ConfOpts ], file:close(Fd), ok; - {error,Reason} -> + {error,Reason} -> io:format("CT failed to install configuration data. Please " "verify that the log directory exists and that " "write permission is set.\n\n", []), @@ -487,69 +607,62 @@ variables_file_name(Dir) -> filename:join(Dir, "variables-"++atom_to_list(node())). %%%----------------------------------------------------------------- -%%% @hidden +%%% @spec run_test(Opts) -> Result +%%% Opts = [tuple()] +%%% Result = [TestResult] | {error,Reason} +%%% +%%% @doc Start tests from the erlang shell or from an erlang program. %%% @equiv ct:run_test/1 +%%%----------------------------------------------------------------- -%% Opts = [OptTuples] -%% OptTuples = {config,CfgFiles} | {dir,TestDirs} | {suite,Suites} | -%% {testcase,Cases} | {spec,TestSpecs} | {allow_user_terms,Bool} | -%% {logdir,LogDir} | {cover,CoverSpecFile} | {step,StepOpts} | -%% {silent_connections,Conns} | {event_handler,EventHandlers} | -%% {include,InclDirs} | {auto_compile,Bool} | -%% {repeat,N} | {duration,DurTime} | {until,StopTime} | {force_stop,Bool} | -%% {decrypt,KeyOrFile} - -run_test(Opt) when is_tuple(Opt) -> - run_test([Opt]); - -run_test(Opts) when is_list(Opts) -> - case lists:keysearch(refresh_logs, 1, Opts) of - {value,{_,RefreshDir}} -> - refresh_logs(?abs(RefreshDir)), - ok; - false -> - Tracing = start_trace(Opts), +run_test(StartOpt) when is_tuple(StartOpt) -> + run_test([StartOpt]); + +run_test(StartOpts) when is_list(StartOpts) -> + case proplists:get_value(refresh_logs, StartOpts) of + undefined -> + Tracing = start_trace(StartOpts), {ok,Cwd} = file:get_cwd(), - io:format("~nCommon Test starting (cwd is ~s)~n~n", [Cwd]), + io:format("~nCommon Test starting (cwd is ~s)~n~n", [Cwd]), Res = - case ct_repeat:loop_test(func, Opts) of + case ct_repeat:loop_test(func, StartOpts) of false -> - case catch run_test1(Opts) of - {'EXIT',Reason} -> + case catch run_test1(StartOpts) of + {'EXIT',Reason} -> file:set_cwd(Cwd), {error,Reason}; - Result -> + Result -> Result end; Result -> Result end, stop_trace(Tracing), - Res + Res; + RefreshDir -> + refresh_logs(?abs(RefreshDir)), + ok end. -run_test1(Opts) -> - LogDir = - case lists:keysearch(logdir, 1, Opts) of - {value,{_,LD}} when is_list(LD) -> LD; - false -> "." - end, - CfgFiles = - case lists:keysearch(config, 1, Opts) of - {value,{_,Files=[File|_]}} when is_list(File) -> - Files; - {value,{_,File=[C|_]}} when is_integer(C) -> - [File]; - {value,{_,[]}} -> - []; - false -> - [] - end, +run_test1(StartOpts) -> + %% label + Label = get_start_opt(label, fun(Lbl) when is_list(Lbl) -> Lbl; + (Lbl) when is_atom(Lbl) -> atom_to_list(Lbl) + end, StartOpts), + %% logdir + LogDir = get_start_opt(logdir, fun(LD) when is_list(LD) -> LD end, + StartOpts), + %% config & userconfig + CfgFiles = ct_config:get_config_file_list(StartOpts), + + %% event handlers EvHandlers = - case lists:keysearch(event_handler, 1, Opts) of - {value,{_,H}} when is_atom(H) -> + case proplists:get_value(event_handler, StartOpts) of + undefined -> + []; + H when is_atom(H) -> [{H,[]}]; - {value,{_,H}} -> + H -> Hs = if is_tuple(H) -> [H]; is_list(H) -> H; @@ -564,41 +677,42 @@ run_test1(Opts) -> {EH,Args}; (_) -> [] - end, Hs)); - _ -> - [] - end, - SilentConns = - case lists:keysearch(silent_connections, 1, Opts) of - {value,{_,all}} -> - []; - {value,{_,Conns}} -> - Conns; - _ -> - undefined - end, - Cover = - case lists:keysearch(cover, 1, Opts) of - {value,{_,CoverFile}} -> - [{cover,?abs(CoverFile)}]; - _ -> - [] + end, Hs)) end, + + %% CT Hooks + CTHooks = get_start_opt(ct_hooks, value, [], StartOpts), + + %% silent connections + SilentConns = get_start_opt(silent_connections, + fun(all) -> []; + (Conns) -> Conns + end, StartOpts), + %% stylesheet + Stylesheet = get_start_opt(stylesheet, + fun(SS) -> ?abs(SS) end, + StartOpts), + %% code coverage + Cover = get_start_opt(cover, + fun(CoverFile) -> ?abs(CoverFile) end, StartOpts), + + %% timetrap manipulation + MultiplyTT = get_start_opt(multiply_timetraps, value, 1, StartOpts), + ScaleTT = get_start_opt(scale_timetraps, value, false, StartOpts), + + %% auto compile & include files Include = - case lists:keysearch(auto_compile, 1, Opts) of - {value,{auto_compile,ACBool}} -> - application:set_env(common_test, auto_compile, ACBool), - []; - _ -> + case proplists:get_value(auto_compile, StartOpts) of + undefined -> application:set_env(common_test, auto_compile, true), InclDirs = - case lists:keysearch(include, 1, Opts) of - {value,{include,Incl}} when is_list(hd(Incl)) -> - Incl; - {value,{include,Incl}} when is_list(Incl) -> - [Incl]; - false -> - [] + case proplists:get_value(include, StartOpts) of + undefined -> + []; + Incl when is_list(hd(Incl)) -> + Incl; + Incl when is_list(Incl) -> + [Incl] end, case os:getenv("CT_INCLUDE_PATH") of false -> @@ -609,117 +723,187 @@ run_test1(Opts) -> AllInclDirs = InclDirs1++InclDirs, application:set_env(common_test, include, AllInclDirs), AllInclDirs - end + end; + ACBool -> + application:set_env(common_test, auto_compile, ACBool), + [] end, - case lists:keysearch(decrypt, 1, Opts) of - {value,{_,Key={key,_}}} -> + %% decrypt config file + case proplists:get_value(decrypt, StartOpts) of + undefined -> + application:unset_env(common_test, decrypt); + Key={key,_} -> application:set_env(common_test, decrypt, Key); - {value,{_,{file,KeyFile}}} -> - application:set_env(common_test, decrypt, {file,filename:absname(KeyFile)}); - false -> - application:unset_env(common_test, decrypt) + {file,KeyFile} -> + application:set_env(common_test, decrypt, {file,?abs(KeyFile)}) end, - case lists:keysearch(basic_html, 1, Opts) of - {value,{basic_html,BasicHtmlBool}} -> - application:set_env(common_test, basic_html, BasicHtmlBool); - _ -> - application:set_env(common_test, basic_html, false) + %% basic html - used by ct_logs + case proplists:get_value(basic_html, StartOpts) of + undefined -> + application:set_env(common_test, basic_html, false); + BasicHtmlBool -> + application:set_env(common_test, basic_html, BasicHtmlBool) end, - case lists:keysearch(spec, 1, Opts) of - {value,{_,Specs}} -> - Relaxed = - case lists:keysearch(allow_user_terms, 1, Opts) of - {value,{_,true}} -> true; - _ -> false - end, - %% using testspec(s) as input for test - run_spec_file(LogDir, CfgFiles, EvHandlers, Include, Specs, Relaxed, Cover, - replace_opt([{silent_connections,SilentConns}], Opts)); - false -> - case lists:keysearch(prepared_tests, 1, Opts) of + %% stepped execution + Step = get_start_opt(step, value, StartOpts), + + Opts = #opts{label = Label, + cover = Cover, step = Step, logdir = LogDir, config = CfgFiles, + event_handlers = EvHandlers, + ct_hooks = CTHooks, + include = Include, + silent_connections = SilentConns, + stylesheet = Stylesheet, + multiply_timetraps = MultiplyTT, + scale_timetraps = ScaleTT}, + + %% test specification + case proplists:get_value(spec, StartOpts) of + undefined -> + case lists:keysearch(prepared_tests, 1, StartOpts) of {value,{_,{Run,Skip},Specs}} -> % use prepared tests - run_prepared(LogDir, CfgFiles, EvHandlers, - Run, Skip, Cover, - replace_opt([{silent_connections,SilentConns}, - {spec,Specs}],Opts)); - false -> % use dir|suite|case - StepOrCover = - case lists:keysearch(step, 1, Opts) of - {value,Step} -> [Step]; - false -> Cover - end, - run_dir(LogDir, CfgFiles, EvHandlers, StepOrCover, - replace_opt([{silent_connections,SilentConns}], Opts)) - end + run_prepared(Run, Skip, Opts#opts{testspecs = Specs}, + StartOpts); + false -> + run_dir(Opts, StartOpts) + end; + Specs -> + Relaxed = get_start_opt(allow_user_terms, value, false, StartOpts), + %% using testspec(s) as input for test + run_spec_file(Relaxed, Opts#opts{testspecs = Specs}, StartOpts) end. -replace_opt([O={Key,_Val}|Os], Opts) -> - [O | replace_opt(Os, lists:keydelete(Key, 1, Opts))]; -replace_opt([], Opts) -> - Opts. - -run_spec_file(LogDir, CfgFiles, EvHandlers, Include, Specs, Relaxed, Cover, Opts) -> +run_spec_file(Relaxed, + Opts = #opts{testspecs = Specs, config = CfgFiles}, + StartOpts) -> Specs1 = case Specs of [X|_] when is_integer(X) -> [Specs]; _ -> Specs end, - AbsSpecs = lists:map(fun(SF) -> ?abs(SF) end, Specs1), + AbsSpecs = lists:map(fun(SF) -> ?abs(SF) end, Specs1), log_ts_names(AbsSpecs), case catch ct_testspec:collect_tests_from_file(AbsSpecs, Relaxed) of - {error,CTReason} -> + {Error,CTReason} when Error == error ; Error == 'EXIT' -> exit(CTReason); TS -> - {LogDir1,TSCoverFile,CfgFiles1,EvHandlers1,Include1} = - get_data_for_node(TS, node()), - application:set_env(common_test, include, Include++Include1), - LogDir2 = which_logdir(LogDir, LogDir1), - CoverOpt = case {Cover,TSCoverFile} of - {[],undef} -> []; - {_,undef} -> Cover; - {[],_} -> [{cover,TSCoverFile}] - end, - case get_configfiles(CfgFiles++CfgFiles1, [], LogDir2, - EvHandlers++EvHandlers1) of + SpecOpts = get_data_for_node(TS, node()), + Label = choose_val(Opts#opts.label, + SpecOpts#opts.label), + LogDir = choose_val(Opts#opts.logdir, + SpecOpts#opts.logdir), + AllConfig = merge_vals([CfgFiles, SpecOpts#opts.config]), + Cover = choose_val(Opts#opts.cover, + SpecOpts#opts.cover), + MultTT = choose_val(Opts#opts.multiply_timetraps, + SpecOpts#opts.multiply_timetraps), + ScaleTT = choose_val(Opts#opts.scale_timetraps, + SpecOpts#opts.scale_timetraps), + AllEvHs = merge_vals([Opts#opts.event_handlers, + SpecOpts#opts.event_handlers]), + AllInclude = merge_vals([Opts#opts.include, + SpecOpts#opts.include]), + + AllCTHooks = merge_vals([Opts#opts.ct_hooks, + SpecOpts#opts.ct_hooks]), + + application:set_env(common_test, include, AllInclude), + + case check_and_install_configfiles(AllConfig, + which(logdir,LogDir), + AllEvHs, + AllCTHooks) of ok -> + Opts1 = Opts#opts{label = Label, + cover = Cover, + logdir = which(logdir, LogDir), + config = AllConfig, + event_handlers = AllEvHs, + include = AllInclude, + testspecs = AbsSpecs, + multiply_timetraps = MultTT, + scale_timetraps = ScaleTT, + ct_hooks = AllCTHooks}, {Run,Skip} = ct_testspec:prepare_tests(TS, node()), - do_run(Run, Skip, CoverOpt, - replace_opt([{spec,AbsSpecs}], Opts), - LogDir2); + reformat_result(catch do_run(Run, Skip, Opts1, StartOpts)); {error,GCFReason} -> exit(GCFReason) end end. -run_prepared(LogDir, CfgFiles, EvHandlers, Run, Skip, Cover, Opts) -> - case get_configfiles(CfgFiles, [], LogDir, EvHandlers) of +run_prepared(Run, Skip, Opts = #opts{logdir = LogDir, + config = CfgFiles, + event_handlers = EvHandlers, + ct_hooks = CTHooks}, + StartOpts) -> + LogDir1 = which(logdir, LogDir), + case check_and_install_configfiles(CfgFiles, LogDir1, + EvHandlers, CTHooks) of ok -> - do_run(Run, Skip, Cover, Opts, LogDir); + reformat_result(catch do_run(Run, Skip, Opts#opts{logdir = LogDir1}, + StartOpts)); {error,Reason} -> exit(Reason) - end. - -run_dir(LogDir, CfgFiles, EvHandlers, StepOrCover, Opts) -> - AbsCfgFiles = - lists:map(fun(F) -> - AbsName = ?abs(F), - case filelib:is_file(AbsName) of - true -> AbsName; - false -> exit({no_such_file,AbsName}) - end - end, CfgFiles), - - case install([{config,AbsCfgFiles},{event_handler,EvHandlers}], LogDir) of + end. + +check_config_file(Callback, File)-> + case code:is_loaded(Callback) of + false -> + case code:load_file(Callback) of + {module,_} -> ok; + {error,Why} -> exit({cant_load_callback_module,Why}) + end; + _ -> + ok + end, + case Callback:check_parameter(File) of + {ok,{file,File}}-> + ?abs(File); + {ok,{config,_}}-> + File; + {error,{wrong_config,Message}}-> + exit({wrong_config,{Callback,Message}}); + {error,{nofile,File}}-> + exit({no_such_file,?abs(File)}) + end. + +run_dir(Opts = #opts{logdir = LogDir, + config = CfgFiles, + event_handlers = EvHandlers, + ct_hooks = CTHook }, StartOpts) -> + LogDir1 = which(logdir, LogDir), + Opts1 = Opts#opts{logdir = LogDir1}, + AbsCfgFiles = + lists:map(fun({Callback,FileList})-> + case code:is_loaded(Callback) of + {file,_Path}-> + ok; + false -> + case code:load_file(Callback) of + {module,Callback}-> + ok; + {error,_}-> + exit({no_such_module,Callback}) + end + end, + {Callback, + lists:map(fun(File)-> + check_config_file(Callback, File) + end, FileList)} + end, CfgFiles), + case install([{config,AbsCfgFiles}, + {event_handler,EvHandlers}, + {ct_hooks, CTHook}], LogDir1) of ok -> ok; {error,IReason} -> exit(IReason) end, - case lists:keysearch(dir,1,Opts) of + case lists:keysearch(dir, 1, StartOpts) of {value,{_,Dirs=[Dir|_]}} when not is_integer(Dir), length(Dirs)>1 -> %% multiple dirs (no suite) - do_run(tests(Dirs), [], StepOrCover, Opts, LogDir); + reformat_result(catch do_run(tests(Dirs), [], Opts1, StartOpts)); false -> % no dir %% fun for converting suite name to {Dir,Mod} tuple S2M = fun(S) when is_list(S) -> @@ -728,105 +912,139 @@ run_dir(LogDir, CfgFiles, EvHandlers, StepOrCover, Opts) -> (A) -> {".",A} end, - case lists:keysearch(suite, 1, Opts) of + case lists:keysearch(suite, 1, StartOpts) of {value,{_,Suite}} when is_integer(hd(Suite)) ; is_atom(Suite) -> {Dir,Mod} = S2M(Suite), - case listify(proplists:get_value(group, Opts, [])) ++ - listify(proplists:get_value(testcase, Opts, [])) of + case groups_and_cases(proplists:get_value(group, StartOpts), + proplists:get_value(testcase, StartOpts)) of + Error = {error,_} -> + exit(Error); [] -> - do_run(tests(Dir, listify(Mod)), [], StepOrCover, Opts, LogDir); + reformat_result(catch do_run(tests(Dir, listify(Mod)), + [], Opts1, StartOpts)); GsAndCs -> - do_run(tests(Dir, Mod, GsAndCs), [], StepOrCover, Opts, LogDir) + reformat_result(catch do_run(tests(Dir, Mod, GsAndCs), + [], Opts1, StartOpts)) end; {value,{_,Suites}} -> - do_run(tests(lists:map(S2M, Suites)), [], StepOrCover, Opts, LogDir); + reformat_result(catch do_run(tests(lists:map(S2M, Suites)), + [], Opts1, StartOpts)); _ -> exit(no_tests_specified) - end; + end; {value,{_,Dir}} -> - case lists:keysearch(suite, 1, Opts) of + case lists:keysearch(suite, 1, StartOpts) of {value,{_,Suite}} when is_integer(hd(Suite)) ; is_atom(Suite) -> - Mod = if is_atom(Suite) -> Suite; - true -> list_to_atom(Suite) + Mod = if is_atom(Suite) -> Suite; + true -> list_to_atom(Suite) end, - case listify(proplists:get_value(group, Opts, [])) ++ - listify(proplists:get_value(testcase, Opts, [])) of + case groups_and_cases(proplists:get_value(group, StartOpts), + proplists:get_value(testcase, StartOpts)) of + Error = {error,_} -> + exit(Error); [] -> - do_run(tests(Dir, listify(Mod)), [], StepOrCover, Opts, LogDir); + reformat_result(catch do_run(tests(Dir, listify(Mod)), + [], Opts1, StartOpts)); GsAndCs -> - do_run(tests(Dir, Mod, GsAndCs), [], StepOrCover, Opts, LogDir) + reformat_result(catch do_run(tests(Dir, Mod, GsAndCs), + [], Opts1, StartOpts)) end; {value,{_,Suites=[Suite|_]}} when is_list(Suite) -> Mods = lists:map(fun(Str) -> list_to_atom(Str) end, Suites), - do_run(tests(delistify(Dir), Mods), [], StepOrCover, Opts, LogDir); + reformat_result(catch do_run(tests(delistify(Dir), Mods), + [], Opts1, StartOpts)); {value,{_,Suites}} -> - do_run(tests(delistify(Dir), Suites), [], StepOrCover, Opts, LogDir); + reformat_result(catch do_run(tests(delistify(Dir), Suites), + [], Opts1, StartOpts)); false -> % no suite, only dir - do_run(tests(listify(Dir)), [], StepOrCover, Opts, LogDir) - end + reformat_result(catch do_run(tests(listify(Dir)), + [], Opts1, StartOpts)) + end end. %%%----------------------------------------------------------------- -%%% @hidden +%%% @spec run_testspec(TestSpec) -> Result +%%% TestSpec = [term()] %%% +%%% @doc Run test specified by <code>TestSpec</code>. The terms are +%%% the same as those used in test specification files. +%%% @equiv ct:run_testspec/1 +%%%----------------------------------------------------------------- -%% using testspec(s) as input for test run_testspec(TestSpec) -> {ok,Cwd} = file:get_cwd(), io:format("~nCommon Test starting (cwd is ~s)~n~n", [Cwd]), case catch run_testspec1(TestSpec) of - {'EXIT',Reason} -> + {'EXIT',Reason} -> file:set_cwd(Cwd), {error,Reason}; - Result -> + Result -> Result end. run_testspec1(TestSpec) -> - case ct_testspec:collect_tests_from_list(TestSpec,false) of - {error,CTReason} -> + case catch ct_testspec:collect_tests_from_list(TestSpec, false) of + {E,CTReason} when E == error ; E == 'EXIT' -> exit(CTReason); TS -> - {LogDir,TSCoverFile,CfgFiles,EvHandlers,Include} = - get_data_for_node(TS,node()), - case os:getenv("CT_INCLUDE_PATH") of - false -> - application:set_env(common_test, include, Include); - CtInclPath -> - EnvInclude = string:tokens(CtInclPath, [$:,$ ,$,]), - application:set_env(common_test, include, EnvInclude++Include) - end, - CoverOpt = if TSCoverFile == undef -> []; - true -> [{cover,TSCoverFile}] - end, - case get_configfiles(CfgFiles,[],LogDir,EvHandlers) of + Opts = get_data_for_node(TS, node()), + + AllInclude = + case os:getenv("CT_INCLUDE_PATH") of + false -> + Opts#opts.include; + CtInclPath -> + EnvInclude = string:tokens(CtInclPath, [$:,$ ,$,]), + EnvInclude++Opts#opts.include + end, + 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, + Opts#opts.ct_hooks) of ok -> - {Run,Skip} = ct_testspec:prepare_tests(TS,node()), - do_run(Run,Skip,CoverOpt,[],LogDir); + Opts1 = Opts#opts{testspecs = [], + logdir = LogDir1, + include = AllInclude}, + {Run,Skip} = ct_testspec:prepare_tests(TS, node()), + reformat_result(catch do_run(Run, Skip, Opts1, [])); {error,GCFReason} -> exit(GCFReason) end end. - -get_data_for_node(#testspec{logdir=LogDirs, - cover=CoverFs, - config=Cfgs, - event_handler=EvHs, - include=Incl}, Node) -> - LogDir = case lists:keysearch(Node,1,LogDirs) of - {value,{Node,Dir}} -> Dir; - false -> "." +get_data_for_node(#testspec{label = Labels, + logdir = LogDirs, + cover = CoverFs, + config = Cfgs, + userconfig = UsrCfgs, + event_handler = EvHs, + ct_hooks = CTHooks, + include = Incl, + multiply_timetraps = MTs, + scale_timetraps = STs}, Node) -> + Label = proplists:get_value(Node, Labels), + LogDir = case proplists:get_value(Node, LogDirs) of + undefined -> "."; + Dir -> Dir end, - Cover = case lists:keysearch(Node,1,CoverFs) of - {value,{Node,CovFile}} -> CovFile; - false -> undef - end, - ConfigFiles = [F || {N,F} <- Cfgs, N==Node], + Cover = proplists:get_value(Node, CoverFs), + MT = proplists:get_value(Node, MTs), + ST = proplists:get_value(Node, STs), + 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], + FiltCTHooks = [Hook || {N,Hook} <- CTHooks, N==Node], Include = [I || {N,I} <- Incl, N==Node], - {LogDir,Cover,ConfigFiles,EvHandlers,Include}. - + #opts{label = Label, + logdir = LogDir, + cover = Cover, + config = ConfigFiles, + event_handlers = EvHandlers, + ct_hooks = FiltCTHooks, + include = Include, + multiply_timetraps = MT, + scale_timetraps = ST}. refresh_logs(LogDir) -> {ok,Cwd} = file:get_cwd(), @@ -851,11 +1069,19 @@ refresh_logs(LogDir) -> end end. -which_logdir(".",Dir) -> - Dir; -which_logdir(Dir,_) -> +which(logdir, undefined) -> + "."; +which(logdir, Dir) -> Dir. - + +choose_val(undefined, V1) -> + V1; +choose_val(V0, _V1) -> + V0. + +merge_vals(Vs) -> + lists:append(Vs). + listify([C|_]=Str) when is_integer(C) -> [Str]; listify(L) when is_list(L) -> L; listify(E) -> [E]. @@ -869,22 +1095,45 @@ delistify(E) -> E. %%% @equiv ct:run/3 run(TestDir, Suite, Cases) -> install([]), - do_run(tests(TestDir, Suite, Cases), []). + reformat_result(catch do_run(tests(TestDir, Suite, Cases), [])). %%%----------------------------------------------------------------- %%% @hidden %%% @equiv ct:run/2 run(TestDir, Suite) when is_list(TestDir), is_integer(hd(TestDir)) -> install([]), - do_run(tests(TestDir, Suite), []). + reformat_result(catch do_run(tests(TestDir, Suite), [])). %%%----------------------------------------------------------------- %%% @hidden %%% @equiv ct:run/1 run(TestDirs) -> install([]), - do_run(tests(TestDirs), []). + reformat_result(catch do_run(tests(TestDirs), [])). +reformat_result({user_error,Reason}) -> + {error,Reason}; +reformat_result(Result) -> + Result. + +suite_to_test(Suite) -> + {filename:dirname(Suite),list_to_atom(filename:rootname(filename:basename(Suite)))}. + +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}. tests(TestDir, Suites, []) when is_list(TestDir), is_integer(hd(TestDir)) -> [{?testdir(TestDir,Suites),ensure_atom(Suites),all}]; @@ -901,30 +1150,52 @@ tests(TestDir) when is_list(TestDir), is_integer(hd(TestDir)) -> tests(TestDirs) when is_list(TestDirs), is_list(hd(TestDirs)) -> [{?testdir(TestDir,all),all,all} || TestDir <- TestDirs]. -do_run(Tests, Opt) -> - do_run(Tests, [], Opt, [], "."). +do_run(Tests, Misc) when is_list(Misc) -> + do_run(Tests, Misc, "."). -do_run(Tests, Opt, LogDir) -> - do_run(Tests, [], Opt, [], LogDir). +do_run(Tests, Misc, LogDir) when is_list(Misc) -> + Opts = + case proplists:get_value(step, Misc) of + undefined -> + #opts{}; + 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, Skip, Opts, Args) -> + #opts{label = Label, cover = Cover} = Opts, + + %% label - used by ct_logs + TestLabel = + if Label == undefined -> undefined; + is_atom(Label) -> atom_to_list(Label); + is_list(Label) -> Label; + true -> undefined + end, + application:set_env(common_test, test_label, TestLabel), -do_run(Tests, Skip, Opt, Args, LogDir) -> case code:which(test_server) of non_existing -> exit({error,no_path_to_test_server}); _ -> - Opt1 = - case lists:keysearch(cover, 1, Opt) of - {value,{_,CoverFile}} -> - case ct_cover:get_spec(CoverFile) of - {error,Reason} -> - exit({error,Reason}); - Spec -> - [{cover_spec,Spec} | - lists:keydelete(cover, 1, Opt)] - end; - _ -> - Opt - end, + Opts1 = if Cover == undefined -> + Opts; + true -> + case ct_cover:get_spec(Cover) of + {error,Reason} -> + exit({error,Reason}); + CoverSpec -> + Opts#opts{coverspec = CoverSpec} + end + end, %% This env variable is used by test_server to determine %% which framework it runs under. case os:getenv("TEST_SERVER_FRAMEWORK") of @@ -935,60 +1206,58 @@ do_run(Tests, Skip, Opt, Args, LogDir) -> Other -> erlang:display(list_to_atom("Note: TEST_SERVER_FRAMEWORK = " ++ Other)) end, - case ct_util:start(LogDir) of + case ct_util:start(Opts#opts.logdir) of {error,interactive_mode} -> io:format("CT is started in interactive mode. " "To exit this mode, run ct:stop_interactive().\n" "To enter the interactive mode again, " "run ct:start_interactive()\n\n",[]), {error,interactive_mode}; - _Pid -> - %% save style sheet info - case lists:keysearch(stylesheet, 1, Args) of - {value,{_,SSFile}} -> - ct_util:set_testdata({stylesheet,SSFile}); - _ -> - ct_util:set_testdata({stylesheet,undefined}) - end, - - case lists:keysearch(silent_connections, 1, Args) of - {value,{silent_connections,undefined}} -> - ok; - {value,{silent_connections,[]}} -> + %% save stylesheet info + ct_util:set_testdata({stylesheet,Opts#opts.stylesheet}), + %% enable silent connections + case Opts#opts.silent_connections of + [] -> Conns = ct_util:override_silence_all_connections(), ct_logs:log("Silent connections", "~p", [Conns]); - {value,{silent_connections,Cs}} -> - Conns = lists:map(fun(S) when is_list(S) -> - list_to_atom(S); - (A) -> A - end, Cs), + Conns when is_list(Conns) -> ct_util:override_silence_connections(Conns), ct_logs:log("Silent connections", "~p", [Conns]); _ -> ok end, - log_ts_names(Args), + log_ts_names(Opts1#opts.testspecs), TestSuites = suite_tuples(Tests), - {SuiteMakeErrors,AllMakeErrors} = + {_TestSuites1,SuiteMakeErrors,AllMakeErrors} = case application:get_env(common_test, auto_compile) of {ok,false} -> - SuitesNotFound = verify_suites(TestSuites), - {SuitesNotFound,SuitesNotFound}; + {TestSuites1,SuitesNotFound} = + verify_suites(TestSuites), + {TestSuites1,SuitesNotFound,SuitesNotFound}; _ -> {SuiteErrs,HelpErrs} = auto_compile(TestSuites), - {SuiteErrs,SuiteErrs++HelpErrs} + {TestSuites,SuiteErrs,SuiteErrs++HelpErrs} end, case continue(AllMakeErrors) of true -> SavedErrors = save_make_errors(SuiteMakeErrors), ct_repeat:log_loop_info(Args), - {Tests1,Skip1} = final_tests(Tests,[],Skip,SavedErrors), - R = do_run_test(Tests1, Skip1, Opt1), - ct_util:stop(normal), - R; + + {Tests1,Skip1} = final_tests(Tests,Skip,SavedErrors), + + R = (catch do_run_test(Tests1, Skip1, Opts1)), + case R of + {EType,_} = Error when EType == user_error ; + EType == error -> + ct_util:stop(clean), + exit(Error); + _ -> + ct_util:stop(normal), + R + end; false -> io:nl(), ct_util:stop(clean), @@ -1012,7 +1281,7 @@ auto_compile(TestSuites) -> case application:get_env(common_test, include) of {ok,UserInclDirs} when length(UserInclDirs) > 0 -> io:format("Including the following directories:~n"), - [begin io:format("~p~n",[UserInclDir]), {i,UserInclDir} end || + [begin io:format("~p~n",[UserInclDir]), {i,UserInclDir} end || UserInclDir <- UserInclDirs]; _ -> [] @@ -1020,11 +1289,11 @@ auto_compile(TestSuites) -> SuiteMakeErrors = lists:flatmap(fun({TestDir,Suite} = TS) -> case run_make(suites, TestDir, Suite, UserInclude) of - {error,{make_failed,Bad}} -> + {error,{make_failed,Bad}} -> [{TS,Bad}]; - {error,_} -> + {error,_} -> [{TS,[filename:join(TestDir,"*_SUITE")]}]; - _ -> + _ -> [] end end, TestSuites), @@ -1048,39 +1317,63 @@ auto_compile(TestSuites) -> true -> % already visited {Done,Failed} end - end, {[],[]}, TestSuites), + end, {[],[]}, TestSuites), {SuiteMakeErrors,lists:reverse(HelpMakeErrors)}. %% verify that specified test suites exist (if auto compile is disabled) verify_suites(TestSuites) -> io:nl(), - Verify = - fun({Dir,Suite},NotFound) -> + Verify = + fun({Dir,Suite}=DS,{Found,NotFound}) -> case locate_test_dir(Dir, Suite) of {ok,TestDir} -> if Suite == all -> - NotFound; + {[DS|Found],NotFound}; true -> - Beam = filename:join(TestDir, atom_to_list(Suite)++".beam"), + Beam = filename:join(TestDir, + atom_to_list(Suite)++".beam"), case filelib:is_regular(Beam) of - true -> - NotFound; - false -> - Name = filename:join(TestDir, atom_to_list(Suite)), - io:format("Suite ~w not found in directory ~s~n", - [Suite,TestDir]), - [{{Dir,Suite},[Name]} | NotFound] + true -> + {[DS|Found],NotFound}; + false -> + case code:is_loaded(Suite) of + {file,SuiteFile} -> + %% test suite is already loaded and + %% since auto_compile == false, + %% let's assume the user has + %% loaded the beam file explicitly + ActualDir = filename:dirname(SuiteFile), + {[{ActualDir,Suite}|Found],NotFound}; + false -> + Name = + filename:join(TestDir, + atom_to_list(Suite)), + io:format(user, + "Suite ~w not found" + "in directory ~s~n", + [Suite,TestDir]), + {Found,[{DS,[Name]}|NotFound]} + end end end; {error,_Reason} -> - io:format("Directory ~s is invalid~n", [Dir]), - Name = filename:join(Dir, atom_to_list(Suite)), - [{{Dir,Suite},[Name]} | NotFound] + case code:is_loaded(Suite) of + {file,SuiteFile} -> + %% test suite is already loaded and since + %% auto_compile == false, let's assume the + %% user has loaded the beam file explicitly + ActualDir = filename:dirname(SuiteFile), + {[{ActualDir,Suite}|Found],NotFound}; + false -> + io:format(user, "Directory ~s is invalid~n", [Dir]), + Name = filename:join(Dir, atom_to_list(Suite)), + {Found,[{DS,[Name]}|NotFound]} + end end end, - lists:reverse(lists:foldl(Verify, [], TestSuites)). - - + {ActualFound,Missing} = lists:foldl(Verify, {[],[]}, TestSuites), + {lists:reverse(ActualFound),lists:reverse(Missing)}. + save_make_errors([]) -> []; save_make_errors(Errors) -> @@ -1096,7 +1389,7 @@ get_bad_suites([{{_TestDir,_Suite},Failed}|Errors], BadSuites) -> get_bad_suites([], BadSuites) -> BadSuites. - + %%%----------------------------------------------------------------- %%% @hidden @@ -1107,7 +1400,7 @@ step(TestDir, Suite, Case) -> %%%----------------------------------------------------------------- %%% @hidden %%% @equiv ct:step/4 -step(TestDir, Suite, Case, Opts) when is_list(TestDir), is_atom(Suite), is_atom(Case), +step(TestDir, Suite, Case, Opts) when is_list(TestDir), is_atom(Suite), is_atom(Case), Suite =/= all, Case =/= all -> do_run([{TestDir,Suite,Case}], [{step,Opts}]). @@ -1121,8 +1414,13 @@ suite_tuples([{TestDir,Suite,_} | Tests]) when is_atom(Suite) -> suite_tuples([]) -> []. -final_tests([{TestDir,Suites,_}|Tests], - Final, Skip, Bad) when is_list(Suites), is_atom(hd(Suites)) -> +final_tests(Tests, Skip, Bad) -> + {Tests1,Skip1} = final_tests1(Tests, [], Skip, Bad), + Skip2 = final_skip(Skip1, []), + {Tests1,Skip2}. + +final_tests1([{TestDir,Suites,_}|Tests], Final, Skip, Bad) when + is_list(Suites), is_atom(hd(Suites)) -> % Separate = % fun(S,{DoSuite,Dont}) -> % case lists:keymember({TestDir,S},1,Bad) of @@ -1140,10 +1438,10 @@ final_tests([{TestDir,Suites,_}|Tests], Skip1 = [{TD,S,"Make failed"} || {{TD,S},_} <- Bad, S1 <- Suites, S == S1, TD == TestDir], - Final1 = [{TestDir,S,all} || S <- Suites], - final_tests(Tests, lists:reverse(Final1)++Final, Skip++Skip1, Bad); + Final1 = [{TestDir,S,all} || S <- Suites], + final_tests1(Tests, lists:reverse(Final1)++Final, Skip++Skip1, Bad); -final_tests([{TestDir,all,all}|Tests], Final, Skip, Bad) -> +final_tests1([{TestDir,all,all}|Tests], Final, Skip, Bad) -> MissingSuites = case lists:keysearch({TestDir,all}, 1, Bad) of {value,{_,Failed}} -> @@ -1153,27 +1451,59 @@ final_tests([{TestDir,all,all}|Tests], Final, Skip, Bad) -> end, Missing = [{TestDir,S,"Make failed"} || S <- MissingSuites], Final1 = [{TestDir,all,all}|Final], - final_tests(Tests, Final1, Skip++Missing, Bad); + final_tests1(Tests, Final1, Skip++Missing, Bad); -final_tests([{TestDir,Suite,Cases}|Tests], - Final, Skip, Bad) when Cases==[]; Cases==all -> - final_tests([{TestDir,[Suite],all}|Tests], Final, Skip, Bad); +final_tests1([{TestDir,Suite,Cases}|Tests], Final, Skip, Bad) when + Cases==[]; Cases==all -> + final_tests1([{TestDir,[Suite],all}|Tests], Final, Skip, Bad); -final_tests([{TestDir,Suite,Cases}|Tests], Final, Skip, Bad) -> +final_tests1([{TestDir,Suite,GrsOrCs}|Tests], Final, Skip, Bad) when + is_list(GrsOrCs) -> case lists:keymember({TestDir,Suite}, 1, Bad) of - false -> - Do = {TestDir,Suite,Cases}, - final_tests(Tests, [Do|Final], Skip, Bad); true -> - Do = {TestDir,Suite,Cases}, - Skip1 = Skip ++ [{TestDir,Suite,Cases,"Make failed"}], - final_tests(Tests, [Do|Final], Skip1, Bad) + Skip1 = Skip ++ [{TestDir,Suite,all,"Make failed"}], + final_tests1(Tests, [{TestDir,Suite,all}|Final], Skip1, Bad); + false -> + GrsOrCs1 = + lists:flatmap( + %% 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, []); + ({skipped,Group,TCs}) -> + [ct_framework:make_conf(TestDir, Suite, + Group, [skipped], TCs)]; + ({Group,TCs}) -> + [ct_framework:make_conf(TestDir, Suite, + Group, [], TCs)]; + (TC) -> + [TC] + end, GrsOrCs), + Do = {TestDir,Suite,GrsOrCs1}, + final_tests1(Tests, [Do|Final], Skip, Bad) end; -final_tests([], Final, Skip, _Bad) -> +final_tests1([], Final, Skip, _Bad) -> {lists:reverse(Final),Skip}. -continue([]) -> +final_skip([{TestDir,Suite,{all,all},Reason}|Skips], Final) -> + SkipConf = ct_framework: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), + Skip = {TestDir,Suite,Conf,Reason}, + final_skip(Skips, [Skip|Final]); + +final_skip([Skip|Skips], Final) -> + final_skip(Skips, [Skip|Final]); + +final_skip([], Final) -> + lists:reverse(Final). + +continue([]) -> true; continue(_MakeErrors) -> io:nl(), @@ -1214,7 +1544,7 @@ set_group_leader_same_as_shell() -> false end end, - case [P || P <- processes(), GS2or3(P), + case [P || P <- processes(), GS2or3(P), true == lists:keymember(shell,1,element(2,process_info(P,dictionary)))] of [GL|_] -> group_leader(GL, self()); @@ -1238,29 +1568,29 @@ check_and_add([{TestDir0,M,_} | Tests], Added) -> check_and_add([], _) -> ok. -do_run_test(Tests, Skip, Opt) -> +do_run_test(Tests, Skip, Opts) -> case check_and_add(Tests, []) of ok -> ct_util:set_testdata({stats,{0,0,{0,0}}}), ct_util:set_testdata({cover,undefined}), test_server_ctrl:start_link(local), - case lists:keysearch(cover_spec, 1, Opt) of - {value,{_,CovData={CovFile, - CovNodes, - _CovImport, - CovExport, - #cover{app = CovApp, - level = CovLevel, - excl_mods = CovExcl, - incl_mods = CovIncl, - cross = CovCross, - src = _CovSrc}}}} -> + case Opts#opts.coverspec of + CovData={CovFile, + CovNodes, + _CovImport, + CovExport, + #cover{app = CovApp, + level = CovLevel, + excl_mods = CovExcl, + incl_mods = CovIncl, + cross = CovCross, + src = _CovSrc}} -> ct_logs:log("COVER INFO","Using cover specification file: ~s~n" "App: ~w~n" "Cross cover: ~w~n" "Including ~w modules~n" "Excluding ~w modules", - [CovFile,CovApp,CovCross,length(CovIncl),length(CovExcl)]), + [CovFile,CovApp,CovCross,length(CovIncl),length(CovExcl)]), %% cover export file will be used for export and import %% between tests so make sure it doesn't exist initially @@ -1293,33 +1623,38 @@ do_run_test(Tests, Skip, Opt) -> true; _ -> false - end, + end, + %% let test_server expand the test tuples and count no of cases {Suites,NoOfCases} = count_test_cases(Tests, Skip), Suites1 = delete_dups(Suites), NoOfTests = length(Tests), NoOfSuites = length(Suites1), - ct_util:warn_duplicates(Suites1), + ct_util:warn_duplicates(Suites1), {ok,Cwd} = file:get_cwd(), io:format("~nCWD set to: ~p~n", [Cwd]), if NoOfCases == unknown -> - io:format("~nTEST INFO: ~w test(s), ~w suite(s)~n~n", + io:format("~nTEST INFO: ~w test(s), ~w suite(s)~n~n", [NoOfTests,NoOfSuites]), - ct_logs:log("TEST INFO","~w test(s), ~w suite(s)", + ct_logs:log("TEST INFO","~w test(s), ~w suite(s)", [NoOfTests,NoOfSuites]); true -> - io:format("~nTEST INFO: ~w test(s), ~w case(s) in ~w suite(s)~n~n", + io:format("~nTEST INFO: ~w test(s), ~w case(s) in ~w suite(s)~n~n", [NoOfTests,NoOfCases,NoOfSuites]), - ct_logs:log("TEST INFO","~w test(s), ~w case(s) in ~w suite(s)", + ct_logs:log("TEST INFO","~w test(s), ~w case(s) in ~w suite(s)", [NoOfTests,NoOfCases,NoOfSuites]) end, + + test_server_ctrl:multiply_timetraps(Opts#opts.multiply_timetraps), + test_server_ctrl:scale_timetraps(Opts#opts.scale_timetraps), + ct_event:notify(#event{name=start_info, node=node(), data={NoOfTests,NoOfSuites,NoOfCases}}), - CleanUp = add_jobs(Tests, Skip, Opt, []), + CleanUp = add_jobs(Tests, Skip, Opts, []), unlink(whereis(test_server_ctrl)), - catch test_server_ctrl:wait_finish(), - %% check if last testcase has left a "dead" trace window + catch test_server_ctrl:wait_finish(), + %% check if last testcase has left a "dead" trace window %% behind, and if so, kill it case ct_util:get_testdata(interpret) of {_What,kill,{TCPid,AttPid}} -> @@ -1327,8 +1662,8 @@ do_run_test(Tests, Skip, Opt) -> _ -> ok end, - lists:foreach(fun(Suite) -> - maybe_cleanup_interpret(Suite, Opt) + lists:foreach(fun(Suite) -> + maybe_cleanup_interpret(Suite, Opts#opts.step) end, CleanUp); Error -> Error @@ -1344,21 +1679,32 @@ count_test_cases(Tests, Skip) -> SendResult = fun(Me, Result) -> Me ! {no_of_cases,Result} end, TSPid = test_server_ctrl:start_get_totals(SendResult), Ref = erlang:monitor(process, TSPid), - add_jobs(Tests, Skip, [], []), - {Suites,NoOfCases} = count_test_cases1(length(Tests), 0, [], Ref), - erlang:demonitor(Ref), - test_server_ctrl:stop_get_totals(), - {Suites,NoOfCases}. + add_jobs(Tests, Skip, #opts{}, []), + Counted = (catch count_test_cases1(length(Tests), 0, [], Ref)), + erlang:demonitor(Ref, [flush]), + case Counted of + {error,{test_server_died}} = Error -> + throw(Error); + {error,Reason} -> + unlink(whereis(test_server_ctrl)), + test_server_ctrl:stop(), + throw({user_error,Reason}); + Result -> + test_server_ctrl:stop_get_totals(), + Result + end. count_test_cases1(0, N, Suites, _) -> {lists:flatten(Suites), N}; count_test_cases1(Jobs, N, Suites, Ref) -> receive - {no_of_cases,{Ss,N1}} -> + {_,{error,_Reason} = Error} -> + throw(Error); + {no_of_cases,{Ss,N1}} -> count_test_cases1(Jobs-1, add_known(N,N1), [Ss|Suites], Ref); - {'DOWN', Ref, _, _, _} -> - {[],0} - end. + {'DOWN', Ref, _, _, Info} -> + throw({error,{test_server_died,Info}}) + end. add_known(unknown, _) -> unknown; @@ -1367,72 +1713,109 @@ add_known(_, unknown) -> add_known(N, N1) -> N+N1. -add_jobs([{TestDir,all,_}|Tests], Skip, Opt, CleanUp) -> +add_jobs([{TestDir,all,_}|Tests], Skip, Opts, CleanUp) -> Name = get_name(TestDir), case catch test_server_ctrl:add_dir_with_skip(Name, TestDir, skiplist(TestDir,Skip)) of - {'EXIT',_} -> + {'EXIT',_} -> CleanUp; _ -> wait_for_idle(), - add_jobs(Tests, Skip, Opt, CleanUp) + add_jobs(Tests, Skip, Opts, CleanUp) end; -add_jobs([{TestDir,[Suite],all}|Tests], Skip, Opt, CleanUp) when is_atom(Suite) -> - add_jobs([{TestDir,Suite,all}|Tests], Skip, Opt, CleanUp); -add_jobs([{TestDir,Suites,all}|Tests], Skip, Opt, CleanUp) when is_list(Suites) -> +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) -> Name = get_name(TestDir) ++ ".suites", case catch test_server_ctrl:add_module_with_skip(Name, Suites, skiplist(TestDir,Skip)) of - {'EXIT',_} -> + {'EXIT',_} -> CleanUp; _ -> wait_for_idle(), - add_jobs(Tests, Skip, Opt, CleanUp) + add_jobs(Tests, Skip, Opts, CleanUp) end; -add_jobs([{TestDir,Suite,all}|Tests], Skip, Opt, CleanUp) -> - case maybe_interpret(Suite, all, Opt) of +add_jobs([{TestDir,Suite,all}|Tests], Skip, Opts, CleanUp) -> + case maybe_interpret(Suite, all, Opts) of ok -> Name = get_name(TestDir) ++ "." ++ atom_to_list(Suite), case catch test_server_ctrl:add_module_with_skip(Name, [Suite], skiplist(TestDir,Skip)) of - {'EXIT',_} -> + {'EXIT',_} -> + CleanUp; + _ -> + wait_for_idle(), + add_jobs(Tests, Skip, Opts, [Suite|CleanUp]) + end; + Error -> + Error + end; + +%% group (= conf case in test_server) +add_jobs([{TestDir,Suite,Confs}|Tests], Skip, Opts, CleanUp) when + element(1, hd(Confs)) == conf -> + Group = fun(Conf) -> proplists:get_value(name, element(2, Conf)) end, + TestCases = fun(Conf) -> element(4, Conf) end, + TCTestName = fun(all) -> ""; + ([C]) when is_atom(C) -> "." ++ atom_to_list(C); + (Cs) when is_list(Cs) -> ".cases" + end, + GrTestName = + case Confs of + [Conf] -> + "." ++ atom_to_list(Group(Conf)) ++ TCTestName(TestCases(Conf)); + _ -> + ".groups" + end, + TestName = get_name(TestDir) ++ "." ++ atom_to_list(Suite) ++ GrTestName, + case maybe_interpret(Suite, init_per_group, Opts) of + ok -> + case catch test_server_ctrl:add_conf_with_skip(TestName, Suite, Confs, + skiplist(TestDir,Skip)) of + {'EXIT',_} -> CleanUp; _ -> wait_for_idle(), - add_jobs(Tests, Skip, Opt, [Suite|CleanUp]) + add_jobs(Tests, Skip, Opts, [Suite|CleanUp]) end; Error -> Error end; -add_jobs([{TestDir,Suite,[Case]}|Tests], Skip, Opt, CleanUp) when is_atom(Case) -> - add_jobs([{TestDir,Suite,Case}|Tests], Skip, Opt, CleanUp); -add_jobs([{TestDir,Suite,Cases}|Tests], Skip, Opt, CleanUp) when is_list(Cases) -> - case maybe_interpret(Suite, Cases, Opt) of + +%% test 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) -> + 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", - case catch test_server_ctrl:add_cases_with_skip(Name, Suite, Cases, + case catch test_server_ctrl:add_cases_with_skip(Name, Suite, Cases1, skiplist(TestDir,Skip)) of - {'EXIT',_} -> + {'EXIT',_} -> CleanUp; _ -> wait_for_idle(), - add_jobs(Tests, Skip, Opt, [Suite|CleanUp]) + add_jobs(Tests, Skip, Opts, [Suite|CleanUp]) end; Error -> Error end; -add_jobs([{TestDir,Suite,Case}|Tests], Skip, Opt, CleanUp) when is_atom(Case) -> - case maybe_interpret(Suite, Case, Opt) of +add_jobs([{TestDir,Suite,Case}|Tests], Skip, Opts, CleanUp) when is_atom(Case) -> + case maybe_interpret(Suite, Case, Opts) of ok -> - Name = get_name(TestDir) ++ "." ++ atom_to_list(Suite) ++ "." ++ + 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 - {'EXIT',_} -> + {'EXIT',_} -> CleanUp; _ -> wait_for_idle(), - add_jobs(Tests, Skip, Opt, [Suite|CleanUp]) + add_jobs(Tests, Skip, Opts, [Suite|CleanUp]) end; Error -> Error @@ -1453,7 +1836,7 @@ wait_for_idle() -> idle -> ok; {'DOWN', Ref, _, _, _} -> error end, - erlang:demonitor(Ref), + erlang:demonitor(Ref, [flush]), ct_util:update_last_run_index(), Result end. @@ -1482,7 +1865,7 @@ get_name(Dir) -> end, Base = filename:basename(TestDir), case filename:basename(filename:dirname(TestDir)) of - "" -> + "" -> Base; TopDir -> TopDir ++ "." ++ Base @@ -1513,15 +1896,15 @@ run_make(Targets, TestDir0, Mod, UserInclude) -> {i,CtInclude}, {i,XmerlInclude}, debug_info], - Result = + Result = if Mod == all ; Targets == helpmods -> case (catch ct_make:all([noexec|ErlFlags])) of - {'EXIT',_} = Failure -> + {'EXIT',_} = Failure -> Failure; MakeInfo -> FileTest = fun(F, suites) -> is_suite(F); - (F, helpmods) -> not is_suite(F); - (_, _) -> true end, + (F, helpmods) -> not is_suite(F) + end, Files = lists:flatmap(fun({F,out_of_date}) -> case FileTest(F, Targets) of true -> [F]; @@ -1535,7 +1918,7 @@ run_make(Targets, TestDir0, Mod, UserInclude) -> true -> (catch ct_make:files([Mod], [load|ErlFlags])) end, - + ok = file:set_cwd(Cwd), %% send finished_make notification ct_event:notify(#event{name=finished_make, @@ -1549,7 +1932,7 @@ run_make(Targets, TestDir0, Mod, UserInclude) -> {error,{make_crashed,TestDir,Reason}}; {error,ModInfo} -> io:format("{error,make_failed}\n", []), - Bad = [filename:join(TestDir, M) || {M,R} <- ModInfo, + Bad = [filename:join(TestDir, M) || {M,R} <- ModInfo, R == error], {error,{make_failed,Bad}} end; @@ -1561,8 +1944,8 @@ run_make(Targets, TestDir0, Mod, UserInclude) -> get_dir(App, Dir) -> filename:join(code:lib_dir(App), Dir). -maybe_interpret(Suite, Cases, [{step,StepOpts}]) -> - %% if other suite has run before this one, check if last testcase +maybe_interpret(Suite, Cases, #opts{step = StepOpts}) when StepOpts =/= undefined -> + %% if other suite has run before this one, check if last testcase %% has left a "dead" trace window behind, and if so, kill it case ct_util:get_testdata(interpret) of {_What,kill,{TCPid,AttPid}} -> @@ -1605,7 +1988,7 @@ maybe_interpret2(Suite, Cases, StepOpts) -> WinOp = case lists:member(keep_inactive, ensure_atom(StepOpts)) of true -> no_kill; false -> kill - end, + end, ct_util:set_testdata({interpret,{{Suite,Cases},WinOp, {undefined,undefined}}}), ok. @@ -1621,37 +2004,44 @@ set_break_on_config(Suite, StepOpts) -> ok end. -maybe_cleanup_interpret(Suite, [{step,_}]) -> - i:iq(Suite); -maybe_cleanup_interpret(_, _) -> - ok. +maybe_cleanup_interpret(_, undefined) -> + ok; +maybe_cleanup_interpret(Suite, _) -> + i:iq(Suite). + +log_ts_names([]) -> + ok; +log_ts_names(Specs) -> + List = lists:map(fun(Name) -> + Name ++ " " + end, Specs), + ct_logs:log("Test Specification file(s)", "~s", + [lists:flatten(List)]). -log_ts_names(Args) -> - case lists:keysearch(spec, 1, Args) of - {value,{_,Specs}} -> - List = lists:map(fun(Name) -> - Name ++ " " - end, Specs), - ct_logs:log("Test Specification file(s)", "~s", - [lists:flatten(List)]); - _ -> - ok - end. - merge_arguments(Args) -> merge_arguments(Args, []). merge_arguments([LogDir={logdir,_}|Args], Merged) -> merge_arguments(Args, handle_arg(replace, LogDir, Merged)); + merge_arguments([CoverFile={cover,_}|Args], Merged) -> merge_arguments(Args, handle_arg(replace, CoverFile, Merged)); -merge_arguments([Arg={_,_}|Args], Merged) -> + +merge_arguments([{'case',TC}|Args], Merged) -> + merge_arguments(Args, handle_arg(merge, {testcase,TC}, Merged)); + +merge_arguments([Arg|Args], Merged) -> merge_arguments(Args, handle_arg(merge, Arg, Merged)); + merge_arguments([], Merged) -> Merged. handle_arg(replace, {Key,Elems}, [{Key,_}|Merged]) -> [{Key,Elems}|Merged]; +handle_arg(merge, {event_handler_init,Elems}, [{event_handler_init,PrevElems}|Merged]) -> + [{event_handler_init,PrevElems++["add"|Elems]}|Merged]; +handle_arg(merge, {userconfig,Elems}, [{userconfig,PrevElems}|Merged]) -> + [{userconfig,PrevElems++["add"|Elems]}|Merged]; handle_arg(merge, {Key,Elems}, [{Key,PrevElems}|Merged]) -> [{Key,PrevElems++Elems}|Merged]; handle_arg(Op, Arg, [Other|Merged]) -> @@ -1659,6 +2049,205 @@ handle_arg(Op, Arg, [Other|Merged]) -> handle_arg(_,Arg,[]) -> [Arg]. +get_start_opt(Key, IfExists, Args) -> + get_start_opt(Key, IfExists, undefined, Args). + +get_start_opt(Key, IfExists, IfNotExists, Args) -> + case lists:keysearch(Key, 1, Args) of + {value,{Key,Val}} when is_function(IfExists) -> + IfExists(Val); + {value,{Key,Val}} when IfExists == value -> + Val; + {value,{Key,_Val}} -> + IfExists; + _ -> + IfNotExists + end. + +ct_hooks_args2opts(Args) -> + ct_hooks_args2opts( + proplists:get_value(ct_hooks, Args, []),[]). + +ct_hooks_args2opts([CTH,Arg,"and"| Rest],Acc) -> + ct_hooks_args2opts(Rest,[{list_to_atom(CTH), + parse_cth_args(Arg)}|Acc]); +ct_hooks_args2opts([CTH], Acc) -> + ct_hooks_args2opts([CTH,"and"],Acc); +ct_hooks_args2opts([CTH, "and" | Rest], Acc) -> + ct_hooks_args2opts(Rest,[list_to_atom(CTH)|Acc]); +ct_hooks_args2opts([CTH, Args], Acc) -> + ct_hooks_args2opts([CTH, Args, "and"],Acc); +ct_hooks_args2opts([],Acc) -> + lists:reverse(Acc). + +parse_cth_args(String) -> + try + true = io_lib:printable_list(String), + {ok,Toks,_} = erl_scan:string(String++"."), + {ok, Args} = erl_parse:parse_term(Toks), + Args + catch _:_ -> + String + end. + + +event_handler_args2opts(Args) -> + case proplists:get_value(event_handler, Args) of + undefined -> + event_handler_args2opts([], Args); + EHs -> + event_handler_args2opts([{list_to_atom(EH),[]} || EH <- EHs], Args) + end. +event_handler_args2opts(Default, Args) -> + case proplists:get_value(event_handler_init, Args) of + undefined -> + Default; + EHs -> + event_handler_init_args2opts(EHs) + end. +event_handler_init_args2opts([EH, Arg, "and" | EHs]) -> + [{list_to_atom(EH),lists:flatten(io_lib:format("~s",[Arg]))} | + event_handler_init_args2opts(EHs)]; +event_handler_init_args2opts([EH, Arg]) -> + [{list_to_atom(EH),lists:flatten(io_lib:format("~s",[Arg]))}]; +event_handler_init_args2opts([]) -> + []. + +%% This function reads pa and pz arguments, converts dirs from relative +%% to absolute, and re-inserts them in the code path. The order of the +%% dirs in the code path remain the same. Note however that since this +%% function is only used for arguments "pre run_test erl_args", the order +%% relative dirs "post run_test erl_args" is not kept! +rel_to_abs(CtArgs) -> + {PA,PZ} = get_pa_pz(CtArgs, [], []), + io:format(user, "~n", []), + [begin + code:del_path(filename:basename(D)), + Abs = filename:absname(D), + code:add_pathz(Abs), + if D /= Abs -> + io:format(user, "Converting ~p to ~p and re-inserting " + "with add_pathz/1~n", + [D, Abs]); + true -> + ok + end + end || D <- PZ], + [begin + code:del_path(filename:basename(D)), + Abs = filename:absname(D), + code:add_patha(Abs), + if D /= Abs -> + io:format(user, "Converting ~p to ~p and re-inserting " + "with add_patha/1~n", + [D, Abs]); + true ->ok + end + end || D <- PA], + io:format(user, "~n", []). + +get_pa_pz([{pa,Dirs} | Args], PA, PZ) -> + get_pa_pz(Args, PA ++ Dirs, PZ); +get_pa_pz([{pz,Dirs} | Args], PA, PZ) -> + get_pa_pz(Args, PA, PZ ++ Dirs); +get_pa_pz([_ | Args], PA, PZ) -> + get_pa_pz(Args, PA, PZ); +get_pa_pz([], PA, PZ) -> + {PA,PZ}. + +%% This function translates ct:run_test/1 start options +%% to ct_run start arguments (on the init arguments format) - +%% this is useful mainly for testing the ct_run start functions. +opts2args(EnvStartOpts) -> + lists:flatmap(fun({config,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) -> + [{userconfig,[atom_to_list(CBM) | CfgStrs]}]; + ({userconfig,UserCfg}) when is_list(UserCfg) -> + Strs = + lists:map(fun({CBM,CfgStr=[X|_]}) when is_integer(X) -> + [atom_to_list(CBM),CfgStr,"and"]; + ({CBM,CfgStrs}) when is_list(CfgStrs) -> + [atom_to_list(CBM) | CfgStrs] ++ ["and"] + end, UserCfg), + [_LastAnd|StrsR] = lists:reverse(lists:flatten(Strs)), + [{userconfig,lists:reverse(StrsR)}]; + ({testcase,Case}) when is_atom(Case) -> + [{'case',[atom_to_list(Case)]}]; + ({testcase,Cases}) -> + [{'case',[atom_to_list(C) || C <- Cases]}]; + ({'case',Cases}) -> + [{'case',[atom_to_list(C) || C <- Cases]}]; + ({allow_user_terms,true}) -> + [{allow_user_terms,[]}]; + ({allow_user_terms,false}) -> + []; + ({auto_compile,false}) -> + [{no_auto_compile,[]}]; + ({auto_compile,true}) -> + []; + ({scale_timetraps,true}) -> + [{scale_timetraps,[]}]; + ({scale_timetraps,false}) -> + []; + ({force_stop,true}) -> + [{force_stop,[]}]; + ({force_stop,false}) -> + []; + ({decrypt,{key,Key}}) -> + [{ct_decrypt_key,[Key]}]; + ({decrypt,{file,File}}) -> + [{ct_decrypt_file,[File]}]; + ({basic_html,true}) -> + ({basic_html,[]}); + ({basic_html,false}) -> + []; + ({event_handler,EH}) when is_atom(EH) -> + [{event_handler,[atom_to_list(EH)]}]; + ({event_handler,EHs}) when is_list(EHs) -> + [{event_handler,[atom_to_list(EH) || EH <- EHs]}]; + ({event_handler,{EH,Arg}}) when is_atom(EH) -> + ArgStr = lists:flatten(io_lib:format("~p", [Arg])), + [{event_handler_init,[atom_to_list(EH),ArgStr]}]; + ({event_handler,{EHs,Arg}}) when is_list(EHs) -> + ArgStr = lists:flatten(io_lib:format("~p", [Arg])), + Strs = lists:map(fun(EH) -> + [atom_to_list(EH),ArgStr,"and"] + end, EHs), + [_LastAnd|StrsR] = lists:reverse(lists:flatten(Strs)), + [{event_handler_init,lists:reverse(StrsR)}]; + ({ct_hooks,[]}) -> + []; + ({ct_hooks,CTHs}) when is_list(CTHs) -> + io:format(user,"ct_hooks: ~p",[CTHs]), + Strs = lists:flatmap( + fun({CTH,Arg}) -> + [atom_to_list(CTH), + lists:flatten( + io_lib:format("~p",[Arg])), + "and"]; + (CTH) when is_atom(CTH) -> + [atom_to_list(CTH),"and"] + end,CTHs), + [_LastAnd|StrsR] = lists:reverse(Strs), + io:format(user,"return: ~p",[lists:reverse(StrsR)]), + [{ct_hooks,lists:reverse(StrsR)}]; + ({Opt,As=[A|_]}) when is_atom(A) -> + [{Opt,[atom_to_list(Atom) || Atom <- As]}]; + ({Opt,Strs=[S|_]}) when is_list(S) -> + [{Opt,Strs}]; + ({Opt,A}) when is_atom(A) -> + [{Opt,[atom_to_list(A)]}]; + ({Opt,I}) when is_integer(I) -> + [{Opt,[integer_to_list(I)]}]; + ({Opt,S}) when is_list(S) -> + [{Opt,[S]}]; + (Opt) -> + Opt + end, EnvStartOpts). + locate_test_dir(Dir, Suite) -> TestDir = case ct_util:is_test_dir(Dir) of true -> Dir; @@ -1723,18 +2312,18 @@ start_trace(Args) -> case file:consult(TraceSpec) of {ok,Terms} -> case catch do_trace(Terms) of - ok -> + ok -> true; {_,Error} -> io:format("Warning! Tracing not started. Reason: ~p~n~n", [Error]), false - end; + end; {_,Error} -> io:format("Warning! Tracing not started. Reason: ~p~n~n", [Error]), false - end; + end; false -> false end. @@ -1743,64 +2332,32 @@ 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,[{'_',[],[{exception_trace}, + {message,{caller}}]}]) of {error,What} -> exit({error,{tracing_failed,What}}); _ -> ok - end; + end; ({f,M,F}) -> - case dbg:tpl(M,F,[{'_',[],[{return_trace}]}]) of + case dbg:tpl(M,F,[{'_',[],[{exception_trace}, + {message,{caller}}]}]) of {error,What} -> exit({error,{tracing_failed,What}}); _ -> ok - end; + end; (Huh) -> exit({error,{unrecognized_trace_term,Huh}}) end, Terms), ok. - + stop_trace(true) -> dbg:stop_clear(); stop_trace(false) -> ok. -preload() -> - io:format("~nLoading Common Test and Test Server modules...~n~n"), - preload_mod([ct_logs, - ct_make, - ct_telnet, - ct, - ct_master, - ct_testspec, - ct_cover, - ct_master_event, - ct_util, - ct_event, - ct_master_logs, - ct_framework, - teln, - ct_ftp, - ct_rpc, - unix_telnet, - ct_gen_conn, - ct_line, - ct_snmp, - test_server_sup, - test_server, - test_server_ctrl, - test_server_h, - test_server_line, - test_server_node]). - -preload_mod([M|Ms]) -> - case code:is_loaded(M) of - false -> - {module,M} = code:load_file(M), - preload_mod(Ms); - _ -> - ok - end; -preload_mod([]) -> - ok. - ensure_atom(Atom) when is_atom(Atom) -> Atom; ensure_atom(String) when is_list(String), is_integer(hd(String)) -> @@ -1809,4 +2366,3 @@ ensure_atom(List) when is_list(List) -> [ensure_atom(Item) || Item <- List]; ensure_atom(Other) -> Other. - diff --git a/lib/common_test/src/ct_slave.erl b/lib/common_test/src/ct_slave.erl new file mode 100644 index 0000000000..aa3413fa89 --- /dev/null +++ b/lib/common_test/src/ct_slave.erl @@ -0,0 +1,439 @@ +%%-------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. 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 for starting and stopping nodes for +%%% Large Scale Testing. +%%% +%%% <p>This module exports functions which are used by the Common Test Master +%%% to start and stop "slave" nodes. It is the default callback module for the +%%% <code>{init, node_start}</code> term of the Test Specification.</p> + +%%---------------------------------------------------------------------- +%% File : ct_slave.erl +%% Description : CT module for starting nodes for large-scale testing. +%% +%% Created : 7 April 2010 +%%---------------------------------------------------------------------- +-module(ct_slave). + +-export([start/1, start/2, start/3, stop/1, stop/2]). + +-export([slave_started/2, slave_ready/2, monitor_master/1]). + +-record(options, {username, password, boot_timeout, init_timeout, + startup_timeout, startup_functions, monitor_master, + kill_if_fail, erl_flags}). + +%%%----------------------------------------------------------------- +%%% @spec start(Node) -> Result +%%% Node = atom() +%%% Result = {ok, NodeName} | +%%% {error, already_started, NodeName} | +%%% {error, started_not_connected, NodeName} | +%%% {error, boot_timeout, NodeName} | +%%% {error, init_timeout, NodeName} | +%%% {error, startup_timeout, NodeName} | +%%% {error, not_alive, NodeName} +%%% NodeName = atom() +%%% @doc Starts an Erlang node with name <code>Node</code> on the local host. +%%% @see start/3 +start(Node) -> + start(gethostname(), Node). + +%%%----------------------------------------------------------------- +%%% @spec start(Host, Node) -> Result +%%% Node = atom() +%%% Host = atom() +%%% Result = {ok, NodeName} | +%%% {error, already_started, NodeName} | +%%% {error, started_not_connected, NodeName} | +%%% {error, boot_timeout, NodeName} | +%%% {error, init_timeout, NodeName} | +%%% {error, startup_timeout, NodeName} | +%%% {error, not_alive, NodeName} +%%% NodeName = atom() +%%% @doc Starts an Erlang node with name <code>Node</code> on host +%%% <code>Host</code> with the default options. +%%% @see start/3 +start(Host, Node) -> + start(Host, Node, []). + +%%%----------------------------------------------------------------- +%%% @spec start(Host, Node, Opts) -> Result +%%% Node = atom() +%%% Host = atom() +%%% Opts = [OptTuples] +%%% OptTuples = {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, ErlangFlags} +%%% Username = string() +%%% Password = string() +%%% BootTimeout = integer() +%%% InitTimeout = integer() +%%% StartupTimeout = integer() +%%% StartupFunctions = [StartupFunctionSpec] +%%% StartupFunctionSpec = {Module, Function, Arguments} +%%% Module = atom() +%%% Function = atom() +%%% Arguments = [term] +%%% Monitor = bool() +%%% KillIfFail = bool() +%%% ErlangFlags = string() +%%% Result = {ok, NodeName} | {error, already_started, NodeName} | +%%% {error, started_not_connected, NodeName} | +%%% {error, boot_timeout, NodeName} | +%%% {error, init_timeout, NodeName} | +%%% {error, startup_timeout, NodeName} | +%%% {error, not_alive, NodeName} +%%% NodeName = atom() +%%% @doc Starts an Erlang node with name <code>Node</code> on host +%%% <code>Host</code> as specified by the combination of options in +%%% <code>Opts</code>. +%%% +%%% <p>Options <code>Username</code> and <code>Password</code> will be used +%%% to log in onto the remote host <code>Host</code>. +%%% Username, if omitted, defaults to the current user name, +%%% and password is empty by default.</p> +%%% +%%% <p>A list of functions specified in the <code>Startup</code> option will be +%%% executed after startup of the node. Note that all used modules should be +%%% present in the code path on the <code>Host</code>.</p> +%%% +%%% <p>The timeouts are applied as follows: +%%% <list> +%%% <item> +%%% <code>BootTimeout</code> - time to start the Erlang node, in seconds. +%%% Defaults to 3 seconds. If node does not become pingable within this time, +%%% the result <code>{error, boot_timeout, NodeName}</code> is returned; +%%% </item> +%%% <item> +%%% <code>InitTimeout</code> - time to wait for the node until it calls the +%%% internal callback function informing master about successfull startup. +%%% Defaults to one second. +%%% In case of timed out message the result +%%% <code>{error, init_timeout, NodeName}</code> is returned; +%%% </item> +%%% <item> +%%% <code>StartupTimeout</code> - time to wait intil the node finishes to run +%%% the <code>StartupFunctions</code>. Defaults to one second. +%%% If this timeout occurs, the result +%%% <code>{error, startup_timeout, NodeName}</code> is returned. +%%% </item> +%%% </list></p> +%%% +%%% <p>Option <code>monitor_master</code> specifies, if the slave node should be +%%% stopped in case of master node stop. Defaults to false.</p> +%%% +%%% <p>Option <code>kill_if_fail</code> specifies, if the slave node should be +%%% killed in case of a timeout during initialization or startup. +%%% Defaults to true. Note that node also may be still alive it the boot +%%% timeout occurred, but it will not be killed in this case.</p> +%%% +%%% <p>Option <code>erlang_flags</code> specifies, which flags will be added +%%% to the parameters of the <code>erl</code> executable.</p> +%%% +%%% <p>Special return values are: +%%% <list> +%%% <item><code>{error, already_started, NodeName}</code> - if the node with +%%% the given name is already started on a given host;</item> +%%% <item><code>{error, started_not_connected, NodeName}</code> - if node is +%%% started, but not connected to the master node.</item> +%%% <item><code>{error, not_alive, NodeName}</code> - if node on which the +%%% <code>ct_slave:start/3</code> is called, is not alive. Note that +%%% <code>NodeName</code> is the name of current node in this case.</item> +%%% </list></p> +%%% +start(Host, Node, Options) -> + ENode = enodename(Host, Node), + case erlang:is_alive() of + false-> + {error, not_alive, node()}; + true-> + case is_started(ENode) of + false-> + OptionsRec = fetch_options(Options), + do_start(Host, Node, OptionsRec); + {true, not_connected}-> + {error, started_not_connected, ENode}; + {true, connected}-> + {error, already_started, ENode} + end + end. + +%%% @spec stop(Node) -> Result +%%% Node = atom() +%%% Result = {ok, NodeName} | +%%% {error, not_started, NodeName} | +%%% {error, not_connected, NodeName} | +%%% {error, stop_timeout, NodeName} +%%% NodeName = atom() +%%% @doc Stops the running Erlang node with name <code>Node</code> on +%%% the localhost. +stop(Node) -> + stop(gethostname(), Node). + +%%% @spec stop(Host, Node) -> Result +%%% Host = atom() +%%% Node = atom() +%%% Result = {ok, NodeName} | +%%% {error, not_started, NodeName} | +%%% {error, not_connected, NodeName} | +%%% {error, stop_timeout, NodeName} +%%% NodeName = atom() +%%% @doc Stops the running Erlang node with name <code>Node</code> on +%%% host <code>Host</code>. +stop(Host, Node) -> + ENode = enodename(Host, Node), + case is_started(ENode) of + {true, connected}-> + do_stop(ENode); + {true, not_connected}-> + {error, not_connected, ENode}; + false-> + {error, not_started, ENode} + end. + +%%% fetch an option value from the tagged tuple list with default +get_option_value(Key, OptionList, Default) -> + case lists:keyfind(Key, 1, OptionList) of + false-> + Default; + {Key, Value}-> + Value + end. + +%%% convert option list to the option record, fill all defaults +fetch_options(Options) -> + UserName = get_option_value(username, Options, []), + Password = get_option_value(password, Options, []), + BootTimeout = get_option_value(boot_timeout, Options, 3), + InitTimeout = get_option_value(init_timeout, Options, 1), + StartupTimeout = get_option_value(startup_timeout, Options, 1), + StartupFunctions = get_option_value(startup_functions, 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, []), + #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}. + +% send a message when slave node is started +% @hidden +slave_started(ENode, MasterPid) -> + MasterPid ! {node_started, ENode}, + ok. + +% send a message when slave node has finished startup +% @hidden +slave_ready(ENode, MasterPid) -> + MasterPid ! {node_ready, ENode}, + ok. + +% start monitoring of the master node +% @hidden +monitor_master(MasterNode) -> + spawn(fun() -> monitor_master_int(MasterNode) end). + +% code of the masterdeath-waiter process +monitor_master_int(MasterNode) -> + erlang:monitor_node(MasterNode, true), + receive + {nodedown, MasterNode}-> + init:stop() + end. + +% check if node is listed in the nodes() +is_connected(ENode) -> + [N||N<-nodes(), N==ENode] == [ENode]. + +% check if node is alive (ping and disconnect if pingable) +is_started(ENode) -> + case is_connected(ENode) of + true-> + {true, connected}; + false-> + case net_adm:ping(ENode) of + pang-> + false; + pong-> + erlang:disconnect_node(ENode), + {true, not_connected} + end + end. + +% make a Erlang node name from name and hostname +enodename(Host, Node) -> + list_to_atom(atom_to_list(Node)++"@"++atom_to_list(Host)). + +% performs actual start of the "slave" node +do_start(Host, Node, Options) -> + ENode = enodename(Host, Node), + Functions = + lists:concat([[{ct_slave, slave_started, [ENode, self()]}], + Options#options.startup_functions, + [{ct_slave, slave_ready, [ENode, self()]}]]), + Functions2 = if + Options#options.monitor_master-> + [{ct_slave, monitor_master, [node()]}|Functions]; + true-> + Functions + end, + MasterHost = gethostname(), + if + MasterHost == Host -> + spawn_local_node(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-> + call_functions(ENode, Functions2), + receive + {node_started, ENode}-> + receive + {node_ready, ENode}-> + {ok, ENode} + after StartupTimeout*1000-> + {error, startup_timeout, ENode} + end + after InitTimeout*1000 -> + {error, init_timeout, ENode} + end; + pang-> + {error, boot_timeout, ENode} + end, + case Result of + {ok, ENode}-> + ok; + {error, Timeout, ENode} + when ((Timeout==init_timeout) or (Timeout==startup_timeout)) and + Options#options.kill_if_fail-> + do_stop(ENode); + _-> ok + end, + Result. + +% are we using fully qualified hostnames +long_or_short() -> + case net_kernel:longnames() of + true-> + " -name "; + false-> + " -sname " + end. + +% get the localhost's name, depending on the using name policy +gethostname() -> + Hostname = case net_kernel:longnames() of + true-> + net_adm:localhost(); + _-> + {ok, Name}=inet:gethostname(), + Name + end, + list_to_atom(Hostname). + +% get cmd for starting Erlang +get_cmd(Node, Flags) -> + Cookie = erlang:get_cookie(), + "erl -detached -noinput -setcookie "++ atom_to_list(Cookie) ++ + long_or_short() ++ atom_to_list(Node) ++ " " ++ Flags. + +% spawn node locally +spawn_local_node(Node, Options) -> + ErlFlags = Options#options.erl_flags, + Cmd = get_cmd(Node, ErlFlags), + open_port({spawn, Cmd}, [stream]). + +% start crypto and ssh if not yet started +check_for_ssh_running() -> + case application:get_application(crypto) of + undefined-> + application:start(crypto), + case application:get_application(ssh) of + undefined-> + application:start(ssh); + {ok, ssh}-> + ok + end; + {ok, crypto}-> + ok + end. + +% spawn node remotely +spawn_remote_node(Host, Node, Options) -> + Username = Options#options.username, + Password = Options#options.password, + ErlFlags = Options#options.erl_flags, + SSHOptions = case {Username, Password} of + {[], []}-> + []; + {_, []}-> + [{user, Username}]; + {_, _}-> + [{user, Username}, {password, Password}] + end ++ [{silently_accept_hosts, true}], + check_for_ssh_running(), + {ok, SSHConnRef} = ssh:connect(atom_to_list(Host), 22, SSHOptions), + {ok, SSHChannelId} = ssh_connection:session_channel(SSHConnRef, infinity), + ssh_connection:exec(SSHConnRef, SSHChannelId, get_cmd(Node, ErlFlags), infinity). + +% call functions on a remote Erlang node +call_functions(_Node, []) -> + ok; +call_functions(Node, [{M, F, A}|Functions]) -> + rpc:call(Node, M, F, A), + call_functions(Node, Functions). + +% wait N seconds until node is pingable +wait_for_node_alive(_Node, 0) -> + pang; +wait_for_node_alive(Node, N) -> + timer:sleep(1000), + case net_adm:ping(Node) of + pong-> + pong; + pang-> + wait_for_node_alive(Node, N-1) + end. + +% call init:stop on a remote node +do_stop(ENode) -> + spawn(ENode, init, stop, []), + wait_for_node_dead(ENode, 5). + +% wait N seconds until node is disconnected +wait_for_node_dead(Node, 0) -> + {error, stop_timeout, Node}; +wait_for_node_dead(Node, N) -> + timer:sleep(1000), + case lists:member(Node, nodes()) of + true-> + wait_for_node_dead(Node, N-1); + false-> + {ok, Node} + end. diff --git a/lib/common_test/src/ct_snmp.erl b/lib/common_test/src/ct_snmp.erl index 7ff88ad7d3..8fe63e8ed1 100644 --- a/lib/common_test/src/ct_snmp.erl +++ b/lib/common_test/src/ct_snmp.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-2010. 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% %% @@ -332,7 +332,7 @@ set_info(Config) -> register_users(MgrAgentConfName, Users) -> {snmp, SnmpVals} = ct:get_config(MgrAgentConfName), NewSnmpVals = lists:keyreplace(users, 1, SnmpVals, {users, Users}), - ct_util:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), + ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), setup_users(Users). %%% @spec register_agents(MgrAgentConfName, ManagedAgents) -> ok | {error, Reason} @@ -347,7 +347,7 @@ register_agents(MgrAgentConfName, ManagedAgents) -> {snmp, SnmpVals} = ct:get_config(MgrAgentConfName), NewSnmpVals = lists:keyreplace(managed_agents, 1, SnmpVals, {managed_agents, ManagedAgents}), - ct_util:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), + ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), setup_managed_agents(ManagedAgents). %%% @spec register_usm_users(MgrAgentConfName, UsmUsers) -> ok | {error, Reason} @@ -361,7 +361,7 @@ register_agents(MgrAgentConfName, ManagedAgents) -> register_usm_users(MgrAgentConfName, UsmUsers) -> {snmp, SnmpVals} = ct:get_config(MgrAgentConfName), NewSnmpVals = lists:keyreplace(users, 1, SnmpVals, {usm_users, UsmUsers}), - ct_util:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), + ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), EngineID = ct:get_config({MgrAgentConfName, engine_id}, ?ENGINE_ID), setup_usm_users(UsmUsers, EngineID). @@ -376,7 +376,7 @@ unregister_users(MgrAgentConfName) -> ct:get_config({MgrAgentConfName, users})), {snmp, SnmpVals} = ct:get_config(MgrAgentConfName), NewSnmpVals = lists:keyreplace(users, 1, SnmpVals, {users, []}), - ct_util:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), + ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), takedown_users(Users). %%% @spec unregister_agents(MgrAgentConfName) -> ok | {error, Reason} @@ -393,7 +393,7 @@ unregister_agents(MgrAgentConfName) -> {snmp, SnmpVals} = ct:get_config(MgrAgentConfName), NewSnmpVals = lists:keyreplace(managed_agents, 1, SnmpVals, {managed_agents, []}), - ct_util:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), + ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), takedown_managed_agents(ManagedAgents). @@ -409,7 +409,7 @@ update_usm_users(MgrAgentConfName, UsmUsers) -> {snmp, SnmpVals} = ct:get_config(MgrAgentConfName), NewSnmpVals = lists:keyreplace(usm_users, 1, SnmpVals, {usm_users, UsmUsers}), - ct_util:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), + ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), EngineID = ct:get_config({MgrAgentConfName, engine_id}, ?ENGINE_ID), do_update_usm_users(UsmUsers, EngineID). diff --git a/lib/common_test/src/ct_telnet_client.erl b/lib/common_test/src/ct_telnet_client.erl index 1a12c5e343..d703b39ac5 100644 --- a/lib/common_test/src/ct_telnet_client.erl +++ b/lib/common_test/src/ct_telnet_client.erl @@ -35,8 +35,6 @@ -export([open/1, open/2, open/3, open/4, close/1]). -export([send_data/2, get_data/1]). --define(DBG, false). - -define(TELNET_PORT, 23). -define(OPEN_TIMEOUT,10000). -define(IDLE_TIMEOUT,10000). @@ -287,35 +285,38 @@ get_subcmd([?SE | Rest], Acc) -> get_subcmd([Opt | Rest], Acc) -> get_subcmd(Rest, [Opt | Acc]). - +-ifdef(debug). dbg(_Str,_Args) -> - if ?DBG -> io:format(_Str,_Args); - true -> ok + io:format(_Str,_Args). + +cmd_dbg(_Cmd) -> + case _Cmd of + [?IAC|Cmd1] -> + cmd_dbg(Cmd1); + [Ctrl|Opts] -> + CtrlStr = + case Ctrl of + ?DO -> "DO"; + ?DONT -> "DONT"; + ?WILL -> "WILL"; + ?WONT -> "WONT"; + ?NOP -> "NOP"; + _ -> "CMD" + end, + Opts1 = + case Opts of + [Opt] -> Opt; + _ -> Opts + end, + io:format("~s(~w): ~w\n", [CtrlStr,Ctrl,Opts1]); + Any -> + io:format("Unexpected in cmd_dbg:~n~w~n",[Any]) end. +-else. +dbg(_Str,_Args) -> + ok. + cmd_dbg(_Cmd) -> - if ?DBG -> - case _Cmd of - [?IAC|Cmd1] -> - cmd_dbg(Cmd1); - [Ctrl|Opts] -> - CtrlStr = - case Ctrl of - ?DO -> "DO"; - ?DONT -> "DONT"; - ?WILL -> "WILL"; - ?WONT -> "WONT"; - ?NOP -> "NOP"; - _ -> "CMD" - end, - Opts1 = - case Opts of - [Opt] -> Opt; - _ -> Opts - end, - io:format("~s(~w): ~w\n", [CtrlStr,Ctrl,Opts1]); - Any -> - io:format("Unexpected in cmd_dbg:~n~w~n",[Any]) - end; - true -> ok - end. + ok. +-endif. diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index 4378ec5a52..d845358bb2 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2010. All Rights Reserved. +%% Copyright Ericsson AB 2006-2011. 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 @@ -17,7 +17,7 @@ %% %CopyrightEnd% %% -%%% @doc Common Test Framework functions handlig test specifikations. +%%% @doc Common Test Framework functions handling test specifications. %%% %%% <p>This module exports functions that are used within CT to %%% scan and parse test specifikations.</p> @@ -68,7 +68,8 @@ prepare_tests(TestSpec) when is_record(TestSpec,testspec) -> %% Create initial list of {Node,{Run,Skip}} tuples NodeList = lists:map(fun(N) -> {N,{[],[]}} end, list_nodes(TestSpec)), %% Get all Run tests sorted per node basis. - NodeList1 = run_per_node(Run,NodeList), + NodeList1 = run_per_node(Run,NodeList, + TestSpec#testspec.merge_tests), %% Get all Skip entries sorted per node basis. NodeList2 = skip_per_node(Skip,NodeList1), %% Change representation. @@ -89,11 +90,17 @@ prepare_tests(TestSpec) when is_record(TestSpec,testspec) -> %% run_per_node/2 takes the Run list as input and returns a list %% of {Node,RunPerNode,[]} tuples where the tests have been sorted %% on a per node basis. -run_per_node([{{Node,Dir},Test}|Ts],Result) -> +run_per_node([{{Node,Dir},Test}|Ts],Result, MergeTests) -> {value,{Node,{Run,Skip}}} = lists:keysearch(Node,1,Result), - Run1 = merge_tests(Dir,Test,Run), - run_per_node(Ts,insert_in_order({Node,{Run1,Skip}},Result)); -run_per_node([],Result) -> + Run1 = case MergeTests of + false -> + append({Dir, Test}, Run); + true -> + merge_tests(Dir,Test,Run) + end, + run_per_node(Ts,insert_in_order({Node,{Run1,Skip}},Result), + MergeTests); +run_per_node([],Result,_) -> Result. merge_tests(Dir,Test={all,_},TestDirs) -> @@ -185,7 +192,15 @@ prepare_cases(Node,Dir,Suite,Cases) -> {[{{Node,Dir},{Suite,all}}],SkipAll}; Skipped -> %% note: this adds a test even if only skip is specified - PrepC = lists:foldr(fun({C,{skip,_Cmt}},Acc) -> + PrepC = lists:foldr(fun({{G,Cs},{skip,_Cmt}}, Acc) when + is_atom(G) -> + case lists:keymember(G, 1, Cases) of + true -> + Acc; + false -> + [{skipped,G,Cs}|Acc] + end; + ({C,{skip,_Cmt}},Acc) -> case lists:member(C,Cases) of true -> Acc; @@ -194,7 +209,7 @@ prepare_cases(Node,Dir,Suite,Cases) -> end; (C,Acc) -> [C|Acc] end, [], Cases), - {{{Node,Dir},{Suite,PrepC}},Skipped} + {{{Node,Dir},{Suite,PrepC}},Skipped} end. get_skipped_suites(Node,Dir,Suites) -> @@ -210,7 +225,7 @@ get_skipped_cases(Node,Dir,Suite,Cases) -> case lists:keysearch(all,1,Cases) of {value,{all,{skip,Cmt}}} -> [{{Node,Dir},{Suite,Cmt}}]; - false -> + _ -> get_skipped_cases1(Node,Dir,Suite,Cases) end. @@ -270,34 +285,11 @@ collect_tests(Terms,TestSpec,Relaxed) -> put(relaxed,Relaxed), TestSpec1 = get_global(Terms,TestSpec), TestSpec2 = get_all_nodes(Terms,TestSpec1), - case catch evaluate(Terms,TestSpec2) of - {error,{Node,{M,F,A},Reason}} -> - io:format("Error! Common Test failed to evaluate ~w:~w/~w on ~w. " - "Reason: ~p~n~n", [M,F,A,Node,Reason]); - _ -> ok - end, - add_tests(Terms,TestSpec2). - -evaluate([{eval,NodeRef,{M,F,Args}}|Ts],Spec) -> - Node = ref2node(NodeRef,Spec#testspec.nodes), - case rpc:call(Node,M,F,Args) of - {badrpc,Reason} -> - throw({error,{Node,{M,F,length(Args)},Reason}}); - _ -> - ok - end, - evaluate(Ts,Spec); -evaluate([{eval,{M,F,Args}}|Ts],Spec) -> - case catch apply(M,F,Args) of - {'EXIT',Reason} -> - throw({error,{node(),{M,F,length(Args)},Reason}}); - _ -> - ok - end, - evaluate(Ts,Spec); -evaluate([],_Spec) -> - ok. + {Terms2, TestSpec3} = filter_init_terms(Terms, [], TestSpec2), + add_tests(Terms2,TestSpec3). +get_global([{merge_tests, Bool} | Ts], Spec) -> + get_global(Ts,Spec#testspec{ merge_tests = Bool }); get_global([{alias,Ref,Dir}|Ts],Spec=#testspec{alias=Refs}) -> get_global(Ts,Spec#testspec{alias=[{Ref,get_absdir(Dir,Spec)}|Refs]}); get_global([{node,Ref,Node}|Ts],Spec=#testspec{nodes=Refs}) -> @@ -305,6 +297,26 @@ get_global([{node,Ref,Node}|Ts],Spec=#testspec{nodes=Refs}) -> get_global([_|Ts],Spec) -> get_global(Ts,Spec); get_global([],Spec) -> Spec. +get_absfile(Callback, FullName,#testspec{spec_dir=SpecDir}) -> + % we need to temporary switch to new cwd here, because + % otherwise config files cannot be found + {ok, OldWd} = file:get_cwd(), + ok = file:set_cwd(SpecDir), + R = Callback:check_parameter(FullName), + ok = file:set_cwd(OldWd), + case R of + {ok, {file, FullName}}-> + File = filename:basename(FullName), + Dir = get_absname(filename:dirname(FullName),SpecDir), + filename:join(Dir,File); + {ok, {config, FullName}}-> + FullName; + {error, {nofile, FullName}}-> + FullName; + {error, {wrong_config, FullName}}-> + FullName + end. + get_absfile(FullName,#testspec{spec_dir=SpecDir}) -> File = filename:basename(FullName), Dir = get_absname(filename:dirname(FullName),SpecDir), @@ -353,6 +365,66 @@ get_all_nodes([_|Ts],Spec) -> get_all_nodes([],Spec) -> Spec. +filter_init_terms([{init, InitOptions}|Ts], NewTerms, Spec)-> + filter_init_terms([{init, list_nodes(Spec), InitOptions}|Ts], NewTerms, Spec); +filter_init_terms([{init, NodeRef, InitOptions}|Ts], NewTerms, Spec) + when is_atom(NodeRef)-> + filter_init_terms([{init, [NodeRef], InitOptions}|Ts], NewTerms, Spec); +filter_init_terms([{init, NodeRefs, InitOption}|Ts], NewTerms, Spec) when is_tuple(InitOption) -> + filter_init_terms([{init, NodeRefs, [InitOption]}|Ts], NewTerms, Spec); +filter_init_terms([{init, [NodeRef|NodeRefs], InitOptions}|Ts], NewTerms, Spec=#testspec{init=InitData})-> + NodeStartOptions = case lists:keyfind(node_start, 1, InitOptions) of + {node_start, NSOptions}-> + case lists:keyfind(callback_module, 1, NSOptions) of + {callback_module, _Callback}-> + NSOptions; + false-> + [{callback_module, ct_slave}|NSOptions] + end; + false-> + [] + end, + EvalTerms = case lists:keyfind(eval, 1, InitOptions) of + {eval, MFA} when is_tuple(MFA)-> + [MFA]; + {eval, MFAs} when is_list(MFAs)-> + MFAs; + false-> + [] + end, + Node = ref2node(NodeRef,Spec#testspec.nodes), + InitData2 = add_option({node_start, NodeStartOptions}, Node, InitData, true), + InitData3 = add_option({eval, EvalTerms}, Node, InitData2, false), + filter_init_terms([{init, NodeRefs, InitOptions}|Ts], NewTerms, Spec#testspec{init=InitData3}); +filter_init_terms([{init, [], _}|Ts], NewTerms, Spec)-> + filter_init_terms(Ts, NewTerms, Spec); +filter_init_terms([Term|Ts], NewTerms, Spec)-> + filter_init_terms(Ts, [Term|NewTerms], Spec); +filter_init_terms([], NewTerms, Spec)-> + {lists:reverse(NewTerms), Spec}. + +add_option({Key, Value}, Node, List, WarnIfExists) when is_list(Value)-> + OldOptions = case lists:keyfind(Node, 1, List) of + {Node, Options}-> + Options; + false-> + [] + end, + NewOption = case lists:keyfind(Key, 1, OldOptions) of + {Key, OldOption} when WarnIfExists, OldOption/=[]-> + io:format("There is an option ~w=~w already defined for node ~p, skipping new ~w~n", + [Key, OldOption, Node, Value]), + OldOption; + {Key, OldOption}-> + OldOption ++ Value; + false-> + Value + end, + lists:keystore(Node, 1, List, + {Node, lists:keystore(Key, 1, OldOptions, {Key, NewOption})}); +add_option({Key, Value}, Node, List, WarnIfExists)-> + add_option({Key, [Value]}, Node, List, WarnIfExists). + save_nodes(Nodes,Spec=#testspec{nodes=NodeRefs}) -> NodeRefs1 = lists:foldr(fun(all_nodes,NR) -> @@ -375,6 +447,15 @@ save_nodes(Nodes,Spec=#testspec{nodes=NodeRefs}) -> list_nodes(#testspec{nodes=NodeRefs}) -> lists:map(fun({_Ref,Node}) -> Node end, NodeRefs). + + +%% --------------------------------------------------------- +%% / \ +%% | When adding tests, remember to update valid_terms/0 also! | +%% \ / +%% --------------------------------------------------------- + + %% Associate a "global" logdir with all nodes %% except those with specific logdir, e.g: %% ["/tmp/logdir",{ct1@finwe,"/tmp/logdir2"}] @@ -400,6 +481,24 @@ add_tests([{logdir,Node,Dir}|Ts],Spec) -> add_tests([{logdir,Dir}|Ts],Spec) -> add_tests([{logdir,all_nodes,Dir}|Ts],Spec); +%% --- label --- +add_tests([{label,all_nodes,Lbl}|Ts],Spec) -> + Labels = Spec#testspec.label, + Tests = [{label,N,Lbl} || N <- list_nodes(Spec), + lists:keymember(ref2node(N,Spec#testspec.nodes), + 1,Labels) == false], + add_tests(Tests++Ts,Spec); +add_tests([{label,Nodes,Lbl}|Ts],Spec) when is_list(Nodes) -> + Ts1 = separate(Nodes,label,[Lbl],Ts,Spec#testspec.nodes), + add_tests(Ts1,Spec); +add_tests([{label,Node,Lbl}|Ts],Spec) -> + Labels = Spec#testspec.label, + Labels1 = [{ref2node(Node,Spec#testspec.nodes),Lbl} | + lists:keydelete(ref2node(Node,Spec#testspec.nodes),1,Labels)], + add_tests(Ts,Spec#testspec{label=Labels1}); +add_tests([{label,Lbl}|Ts],Spec) -> + add_tests([{label,all_nodes,Lbl}|Ts],Spec); + %% --- cover --- add_tests([{cover,all_nodes,File}|Ts],Spec) -> Tests = lists:map(fun(N) -> {cover,N,File} end, list_nodes(Spec)), @@ -415,6 +514,36 @@ add_tests([{cover,Node,File}|Ts],Spec) -> add_tests([{cover,File}|Ts],Spec) -> add_tests([{cover,all_nodes,File}|Ts],Spec); +%% --- multiply_timetraps --- +add_tests([{multiply_timetraps,all_nodes,MT}|Ts],Spec) -> + Tests = lists:map(fun(N) -> {multiply_timetraps,N,MT} end, list_nodes(Spec)), + add_tests(Tests++Ts,Spec); +add_tests([{multiply_timetraps,Nodes,MT}|Ts],Spec) when is_list(Nodes) -> + Ts1 = separate(Nodes,multiply_timetraps,[MT],Ts,Spec#testspec.nodes), + add_tests(Ts1,Spec); +add_tests([{multiply_timetraps,Node,MT}|Ts],Spec) -> + MTs = Spec#testspec.multiply_timetraps, + MTs1 = [{ref2node(Node,Spec#testspec.nodes),MT} | + lists:keydelete(ref2node(Node,Spec#testspec.nodes),1,MTs)], + add_tests(Ts,Spec#testspec{multiply_timetraps=MTs1}); +add_tests([{multiply_timetraps,MT}|Ts],Spec) -> + add_tests([{multiply_timetraps,all_nodes,MT}|Ts],Spec); + +%% --- scale_timetraps --- +add_tests([{scale_timetraps,all_nodes,ST}|Ts],Spec) -> + Tests = lists:map(fun(N) -> {scale_timetraps,N,ST} end, list_nodes(Spec)), + add_tests(Tests++Ts,Spec); +add_tests([{scale_timetraps,Nodes,ST}|Ts],Spec) when is_list(Nodes) -> + Ts1 = separate(Nodes,scale_timetraps,[ST],Ts,Spec#testspec.nodes), + add_tests(Ts1,Spec); +add_tests([{scale_timetraps,Node,ST}|Ts],Spec) -> + STs = Spec#testspec.scale_timetraps, + STs1 = [{ref2node(Node,Spec#testspec.nodes),ST} | + lists:keydelete(ref2node(Node,Spec#testspec.nodes),1,STs)], + add_tests(Ts,Spec#testspec{scale_timetraps=STs1}); +add_tests([{scale_timetraps,ST}|Ts],Spec) -> + add_tests([{scale_timetraps,all_nodes,ST}|Ts],Spec); + %% --- config --- add_tests([{config,all_nodes,Files}|Ts],Spec) -> Tests = lists:map(fun(N) -> {config,N,Files} end, list_nodes(Spec)), @@ -434,6 +563,27 @@ add_tests([{config,Node,F}|Ts],Spec) -> add_tests([{config,Files}|Ts],Spec) -> add_tests([{config,all_nodes,Files}|Ts],Spec); + +%% --- userconfig --- +add_tests([{userconfig,all_nodes,CBF}|Ts],Spec) -> + Tests = lists:map(fun(N) -> {userconfig,N,CBF} end, list_nodes(Spec)), + add_tests(Tests++Ts,Spec); +add_tests([{userconfig,Nodes,CBF}|Ts],Spec) when is_list(Nodes) -> + Ts1 = separate(Nodes,userconfig,[CBF],Ts,Spec#testspec.nodes), + add_tests(Ts1,Spec); +add_tests([{userconfig,Node,[{Callback, Config}|CBF]}|Ts],Spec) -> + Cfgs = Spec#testspec.userconfig, + Node1 = ref2node(Node,Spec#testspec.nodes), + add_tests([{userconfig,Node,CBF}|Ts], + Spec#testspec{userconfig=[{Node1,{Callback, + get_absfile(Callback, Config ,Spec)}}|Cfgs]}); +add_tests([{userconfig,_Node,[]}|Ts],Spec) -> + add_tests(Ts,Spec); +add_tests([{userconfig,Node,CBF}|Ts],Spec) -> + add_tests([{userconfig,Node,[CBF]}|Ts],Spec); +add_tests([{userconfig,CBF}|Ts],Spec) -> + add_tests([{userconfig,all_nodes,CBF}|Ts],Spec); + %% --- event_handler --- add_tests([{event_handler,all_nodes,Hs}|Ts],Spec) -> Tests = lists:map(fun(N) -> {event_handler,N,Hs,[]} end, list_nodes(Spec)), @@ -482,6 +632,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]}); +%% --- ct_hooks -- +add_tests([{ct_hooks, all_nodes, Hooks} | Ts], Spec) -> + Tests = [{ct_hooks,N,Hooks} || N <- list_nodes(Spec)], + add_tests(Tests ++ Ts, Spec); +add_tests([{ct_hooks, Node, [Hook|Hooks]}|Ts], Spec) -> + SuiteCbs = Spec#testspec.ct_hooks, + Node1 = ref2node(Node,Spec#testspec.nodes), + add_tests([{ct_hooks, Node, Hooks} | Ts], + Spec#testspec{ct_hooks = [{Node1,Hook} | SuiteCbs]}); +add_tests([{ct_hooks, _Node, []}|Ts], Spec) -> + add_tests(Ts, Spec); +add_tests([{ct_hooks, Hooks}|Ts], Spec) -> + add_tests([{ct_hooks, all_nodes, Hooks}|Ts], Spec); + %% --- include --- add_tests([{include,all_nodes,InclDirs}|Ts],Spec) -> Tests = lists:map(fun(N) -> {include,N,InclDirs} end, list_nodes(Spec)), @@ -513,7 +677,41 @@ add_tests([{suites,Node,Dir,Ss}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = insert_suites(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Ss,Tests), + Ss,Tests, Spec#testspec.merge_tests), + add_tests(Ts,Spec#testspec{tests=Tests1}); + +%% --- groups --- +%% Later make it possible to specify group execution properties +%% that will override thse in the suite. Also make it possible +%% create dynamic groups in specification, i.e. to group test cases +%% by means of groups defined only in the test specification. +add_tests([{groups,all_nodes,Dir,Suite,Gs}|Ts],Spec) -> + add_tests([{groups,list_nodes(Spec),Dir,Suite,Gs}|Ts],Spec); +add_tests([{groups,all_nodes,Dir,Suite,Gs,{cases,TCs}}|Ts],Spec) -> + add_tests([{groups,list_nodes(Spec),Dir,Suite,Gs,{cases,TCs}}|Ts],Spec); +add_tests([{groups,Dir,Suite,Gs}|Ts],Spec) -> + add_tests([{groups,all_nodes,Dir,Suite,Gs}|Ts],Spec); +add_tests([{groups,Dir,Suite,Gs,{cases,TCs}}|Ts],Spec) -> + add_tests([{groups,all_nodes,Dir,Suite,Gs,{cases,TCs}}|Ts],Spec); +add_tests([{groups,Nodes,Dir,Suite,Gs}|Ts],Spec) when is_list(Nodes) -> + Ts1 = separate(Nodes,groups,[Dir,Suite,Gs],Ts,Spec#testspec.nodes), + add_tests(Ts1,Spec); +add_tests([{groups,Nodes,Dir,Suite,Gs,{cases,TCs}}|Ts],Spec) when is_list(Nodes) -> + Ts1 = separate(Nodes,groups,[Dir,Suite,Gs,{cases,TCs}],Ts,Spec#testspec.nodes), + add_tests(Ts1,Spec); +add_tests([{groups,Node,Dir,Suite,Gs}|Ts],Spec) -> + Tests = Spec#testspec.tests, + Tests1 = insert_groups(ref2node(Node,Spec#testspec.nodes), + ref2dir(Dir,Spec#testspec.alias), + Suite,Gs,all,Tests, + Spec#testspec.merge_tests), + add_tests(Ts,Spec#testspec{tests=Tests1}); +add_tests([{groups,Node,Dir,Suite,Gs,{cases,TCs}}|Ts],Spec) -> + Tests = Spec#testspec.tests, + Tests1 = insert_groups(ref2node(Node,Spec#testspec.nodes), + ref2dir(Dir,Spec#testspec.alias), + Suite,Gs,TCs,Tests, + Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); %% --- cases --- @@ -528,7 +726,7 @@ add_tests([{cases,Node,Dir,Suite,Cs}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = insert_cases(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Suite,Cs,Tests), + Suite,Cs,Tests, Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); %% --- skip_suites --- @@ -543,7 +741,38 @@ add_tests([{skip_suites,Node,Dir,Ss,Cmt}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = skip_suites(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Ss,Cmt,Tests), + Ss,Cmt,Tests, + Spec#testspec.merge_tests), + add_tests(Ts,Spec#testspec{tests=Tests1}); + +%% --- skip_groups --- +add_tests([{skip_groups,all_nodes,Dir,Suite,Gs,Cmt}|Ts],Spec) -> + add_tests([{skip_groups,list_nodes(Spec),Dir,Suite,Gs,Cmt}|Ts],Spec); +add_tests([{skip_groups,all_nodes,Dir,Suite,Gs,{cases,TCs},Cmt}|Ts],Spec) -> + add_tests([{skip_groups,list_nodes(Spec),Dir,Suite,Gs,{cases,TCs},Cmt}|Ts],Spec); +add_tests([{skip_groups,Dir,Suite,Gs,Cmt}|Ts],Spec) -> + add_tests([{skip_groups,all_nodes,Dir,Suite,Gs,Cmt}|Ts],Spec); +add_tests([{skip_groups,Dir,Suite,Gs,{cases,TCs},Cmt}|Ts],Spec) -> + add_tests([{skip_groups,all_nodes,Dir,Suite,Gs,{cases,TCs},Cmt}|Ts],Spec); +add_tests([{skip_groups,Nodes,Dir,Suite,Gs,Cmt}|Ts],Spec) when is_list(Nodes) -> + Ts1 = separate(Nodes,skip_groups,[Dir,Suite,Gs,Cmt],Ts,Spec#testspec.nodes), + add_tests(Ts1,Spec); +add_tests([{skip_groups,Nodes,Dir,Suite,Gs,{cases,TCs},Cmt}|Ts],Spec) when is_list(Nodes) -> + Ts1 = separate(Nodes,skip_groups,[Dir,Suite,Gs,{cases,TCs},Cmt],Ts,Spec#testspec.nodes), + add_tests(Ts1,Spec); +add_tests([{skip_groups,Node,Dir,Suite,Gs,Cmt}|Ts],Spec) -> + Tests = Spec#testspec.tests, + Tests1 = skip_groups(ref2node(Node,Spec#testspec.nodes), + ref2dir(Dir,Spec#testspec.alias), + Suite,Gs,all,Cmt,Tests, + Spec#testspec.merge_tests), + add_tests(Ts,Spec#testspec{tests=Tests1}); +add_tests([{skip_groups,Node,Dir,Suite,Gs,{cases,TCs},Cmt}|Ts],Spec) -> + Tests = Spec#testspec.tests, + Tests1 = skip_groups(ref2node(Node,Spec#testspec.nodes), + ref2dir(Dir,Spec#testspec.alias), + Suite,Gs,TCs,Cmt,Tests, + Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); %% --- skip_cases --- @@ -558,7 +787,7 @@ add_tests([{skip_cases,Node,Dir,Suite,Cs,Cmt}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = skip_cases(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Suite,Cs,Cmt,Tests), + Suite,Cs,Cmt,Tests,Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); %% --- handled/errors --- @@ -568,6 +797,9 @@ add_tests([{alias,_,_}|Ts],Spec) -> % handled add_tests([{node,_,_}|Ts],Spec) -> % handled add_tests(Ts,Spec); +add_tests([{merge_tests, _} | Ts], Spec) -> % handled + add_tests(Ts,Spec); + %% check if it's a CT term that has bad format or if the user seems to %% have added something of his/her own, which we'll let pass if relaxed %% mode is enabled. @@ -614,18 +846,77 @@ separate([],_,_,_) -> %% Representation: -%% {{Node,Dir},[{Suite1,[case11,case12,...]},{Suite2,[case21,case22,...]},...]} -%% {{Node,Dir},[{Suite1,{skip,Cmt}},{Suite2,[{case21,{skip,Cmt}},case22,...]},...]} - -insert_suites(Node,Dir,[S|Ss],Tests) -> - Tests1 = insert_cases(Node,Dir,S,all,Tests), - insert_suites(Node,Dir,Ss,Tests1); -insert_suites(_Node,_Dir,[],Tests) -> +%% {{Node,Dir},[{Suite1,[GrOrCase11,GrOrCase12,...]}, +%% {Suite2,[GrOrCase21,GrOrCase22,...]},...]} +%% {{Node,Dir},[{Suite1,{skip,Cmt}}, +%% {Suite2,[{GrOrCase21,{skip,Cmt}},GrOrCase22,...]},...]} +%% GrOrCase = {GroupName,[Case1,Case2,...]} | Case + +insert_suites(Node,Dir,[S|Ss],Tests, MergeTests) -> + Tests1 = insert_cases(Node,Dir,S,all,Tests,MergeTests), + insert_suites(Node,Dir,Ss,Tests1,MergeTests); +insert_suites(_Node,_Dir,[],Tests,_MergeTests) -> Tests; -insert_suites(Node,Dir,S,Tests) -> - insert_suites(Node,Dir,[S],Tests). +insert_suites(Node,Dir,S,Tests,MergeTests) -> + insert_suites(Node,Dir,[S],Tests,MergeTests). + +insert_groups(Node,Dir,Suite,Group,Cases,Tests,MergeTests) + when is_atom(Group) -> + 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], + 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) -> + 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), + 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) + when is_atom(Case) -> + Cases = if Case == all -> all; true -> [Case] end, + insert_groups(Node,Dir,Suite,Groups,Cases,Tests, MergeTests). + +insert_groups1(_Suite,_Groups,all) -> + all; +insert_groups1(Suite,Groups,Suites0) -> + case lists:keysearch(Suite,1,Suites0) of + {value,{Suite,all}} -> + Suites0; + {value,{Suite,GrAndCases0}} -> + GrAndCases = insert_groups2(Groups,GrAndCases0), + insert_in_order({Suite,GrAndCases},Suites0); + false -> + insert_in_order({Suite,Groups},Suites0) + end. -insert_cases(Node,Dir,Suite,Cases,Tests) when is_list(Cases) -> +insert_groups2(_Groups,all) -> + all; +insert_groups2([Group={GrName,Cases}|Groups],GrAndCases) -> + case lists:keysearch(GrName,1,GrAndCases) of + {value,{GrName,all}} -> + GrAndCases; + {value,{GrName,Cases0}} -> + Cases1 = insert_in_order(Cases,Cases0), + insert_groups2(Groups,insert_in_order({GrName,Cases1},GrAndCases)); + false -> + insert_groups2(Groups,insert_in_order(Group,GrAndCases)) + end; +insert_groups2([],GrAndCases) -> + GrAndCases. + +insert_cases(Node,Dir,Suite,Cases,Tests,false) when is_list(Cases) -> + append({{Node,Dir},[{Suite,Cases}]},Tests); +insert_cases(Node,Dir,Suite,Cases,Tests,true) when is_list(Cases) -> case lists:keysearch({Node,Dir},1,Tests) of {value,{{Node,Dir},[{all,_}]}} -> Tests; @@ -635,8 +926,8 @@ insert_cases(Node,Dir,Suite,Cases,Tests) when is_list(Cases) -> false -> insert_in_order({{Node,Dir},[{Suite,Cases}]},Tests) end; -insert_cases(Node,Dir,Suite,Case,Tests) when is_atom(Case) -> - insert_cases(Node,Dir,Suite,[Case],Tests). +insert_cases(Node,Dir,Suite,Case,Tests,MergeTests) when is_atom(Case) -> + insert_cases(Node,Dir,Suite,[Case],Tests,MergeTests). insert_cases1(_Suite,_Cases,all) -> all; @@ -651,15 +942,59 @@ insert_cases1(Suite,Cases,Suites0) -> insert_in_order({Suite,Cases},Suites0) end. -skip_suites(Node,Dir,[S|Ss],Cmt,Tests) -> - Tests1 = skip_cases(Node,Dir,S,all,Cmt,Tests), - skip_suites(Node,Dir,Ss,Cmt,Tests1); -skip_suites(_Node,_Dir,[],_Cmt,Tests) -> +skip_suites(Node,Dir,[S|Ss],Cmt,Tests,MergeTests) -> + Tests1 = skip_cases(Node,Dir,S,all,Cmt,Tests,MergeTests), + skip_suites(Node,Dir,Ss,Cmt,Tests1,MergeTests); +skip_suites(_Node,_Dir,[],_Cmt,Tests,_MergeTests) -> Tests; -skip_suites(Node,Dir,S,Cmt,Tests) -> - skip_suites(Node,Dir,[S],Cmt,Tests). +skip_suites(Node,Dir,S,Cmt,Tests,MergeTests) -> + skip_suites(Node,Dir,[S],Cmt,Tests,MergeTests). + +skip_groups(Node,Dir,Suite,Group,all,Cmt,Tests,MergeTests) + when is_atom(Group) -> + skip_groups(Node,Dir,Suite,[Group],all,Cmt,Tests,MergeTests); +skip_groups(Node,Dir,Suite,Group,Cases,Cmt,Tests,MergeTests) + when is_atom(Group) -> + skip_groups(Node,Dir,Suite,[Group],Cases,Cmt,Tests,MergeTests); +skip_groups(Node,Dir,Suite,Groups,Case,Cmt,Tests,MergeTests) + when is_atom(Case),Case =/= all -> + skip_groups(Node,Dir,Suite,Groups,[Case],Cmt,Tests,MergeTests); +skip_groups(Node,Dir,Suite,Groups,Cases,Cmt,Tests,false) when + ((Cases == all) or is_list(Cases)) and is_list(Groups) -> + Suites1 = skip_groups1(Suite,[{Gr,Cases} || Gr <- Groups],Cmt,[]), + append({{Node,Dir},Suites1},Tests); +skip_groups(Node,Dir,Suite,Groups,Cases,Cmt,Tests,true) when + ((Cases == all) or is_list(Cases)) and is_list(Groups) -> + Suites = + case lists:keysearch({Node,Dir},1,Tests) of + {value,{{Node,Dir},Suites0}} -> + Suites0; + false -> + [] + end, + Suites1 = skip_groups1(Suite,[{Gr,Cases} || Gr <- Groups],Cmt,Suites), + insert_in_order({{Node,Dir},Suites1},Tests); +skip_groups(Node,Dir,Suite,Groups,Case,Cmt,Tests,MergeTests) + when is_atom(Case) -> + Cases = if Case == all -> all; true -> [Case] end, + skip_groups(Node,Dir,Suite,Groups,Cases,Cmt,Tests,MergeTests). + +skip_groups1(Suite,Groups,Cmt,Suites0) -> + SkipGroups = lists:map(fun(Group) -> + {Group,{skip,Cmt}} + end,Groups), + case lists:keysearch(Suite,1,Suites0) of + {value,{Suite,GrAndCases0}} -> + GrAndCases1 = GrAndCases0 ++ SkipGroups, + insert_in_order({Suite,GrAndCases1},Suites0); + false -> + insert_in_order({Suite,SkipGroups},Suites0) + end. -skip_cases(Node,Dir,Suite,Cases,Cmt,Tests) when is_list(Cases) -> +skip_cases(Node,Dir,Suite,Cases,Cmt,Tests,false) when is_list(Cases) -> + Suites1 = skip_cases1(Suite,Cases,Cmt,[]), + append({{Node,Dir},Suites1},Tests); +skip_cases(Node,Dir,Suite,Cases,Cmt,Tests,true) when is_list(Cases) -> Suites = case lists:keysearch({Node,Dir},1,Tests) of {value,{{Node,Dir},Suites0}} -> @@ -669,8 +1004,8 @@ skip_cases(Node,Dir,Suite,Cases,Cmt,Tests) when is_list(Cases) -> end, Suites1 = skip_cases1(Suite,Cases,Cmt,Suites), insert_in_order({{Node,Dir},Suites1},Tests); -skip_cases(Node,Dir,Suite,Case,Cmt,Tests) when is_atom(Case) -> - skip_cases(Node,Dir,Suite,[Case],Cmt,Tests). +skip_cases(Node,Dir,Suite,Case,Cmt,Tests,MergeTests) when is_atom(Case) -> + skip_cases(Node,Dir,Suite,[Case],Cmt,Tests,MergeTests). skip_cases1(Suite,Cases,Cmt,Suites0) -> SkipCases = lists:map(fun(C) -> @@ -684,6 +1019,9 @@ skip_cases1(Suite,Cases,Cmt,Suites0) -> insert_in_order({Suite,SkipCases},Suites0) end. +append(Elem, List) -> + List ++ [Elem]. + insert_in_order([E|Es],List) -> List1 = insert_elem(E,List,[]), insert_in_order(Es,List1); @@ -753,21 +1091,37 @@ valid_terms() -> {cover,3}, {config,2}, {config,3}, + {userconfig,2}, + {userconfig,3}, {alias,3}, + {merge_tests,1}, {logdir,2}, {logdir,3}, + {label,2}, + {label,3}, {event_handler,2}, {event_handler,3}, {event_handler,4}, + {ct_hooks,2}, + {ct_hooks,3}, + {multiply_timetraps,2}, + {multiply_timetraps,3}, + {scale_timetraps,2}, + {scale_timetraps,3}, {include,2}, {include,3}, - {suites,3}, {suites,4}, + {groups,4}, + {groups,5}, + {groups,6}, {cases,4}, {cases,5}, {skip_suites,4}, {skip_suites,5}, + {skip_groups,5}, + {skip_groups,6}, + {skip_groups,7}, {skip_cases,5}, {skip_cases,6} ]. @@ -816,7 +1170,3 @@ common_letters([L|Ls],Term,Count) -> end; common_letters([],_,Count) -> Count. - - - - diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index ba3d789f8d..115207beed 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2003-2011. 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% %% @@ -30,12 +30,11 @@ -export([register_connection/4,unregister_connection/1, does_connection_exist/3,get_key_from_name/1]). --export([require/1, require/2, get_config/1, get_config/2, get_config/3, - set_default_config/2, set_default_config/3, delete_default_config/1, - get_all_config/0, update_config/2, - release_allocated/0, close_connections/0]). +-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]). @@ -46,6 +45,8 @@ silence_all_connections/0, silence_connections/1, is_silenced/1, reset_silent_connections/0]). +-export([get_mode/0, create_table/3, read_opts/0]). + -export([set_cwd/1, reset_cwd/0]). -export([parse_table/1]). @@ -56,23 +57,15 @@ -export([is_test_dir/1, get_testdir/2]). --export([encrypt_config_file/2, encrypt_config_file/3, - decrypt_config_file/2, decrypt_config_file/3]). - --export([kill_attached/2, get_attached/1]). +-export([kill_attached/2, get_attached/1, ct_make_ref/0]). -export([warn_duplicates/1]). -include("ct_event.hrl"). -include("ct_util.hrl"). --record(ct_conf,{key,value,ref,name='_UNDEF',default=false}). -%% default = {true,suite} | {true,testcase} | false - -record(suite_data, {key,name,value}). --define(cryptfile, ".ct_config.crypt"). - %%%----------------------------------------------------------------- %%% @spec start(Mode) -> Pid | exit(Error) %%% Mode = normal | interactive @@ -119,7 +112,6 @@ start(Mode,LogDir) -> do_start(Parent,Mode,LogDir) -> process_flag(trap_exit,true), register(ct_util_server,self()), - create_table(?attr_table,bag,#ct_conf.key), create_table(?conn_table,#conn.handle), create_table(?board_table,2), create_table(?suite_table,#suite_data.key), @@ -135,7 +127,6 @@ do_start(Parent,Mode,LogDir) -> Parent ! {self(),Error}, exit(Error) end, - %% start an event manager (if not already started by master) case ct_event:start_link() of {error,{already_started,_}} -> @@ -148,38 +139,45 @@ do_start(Parent,Mode,LogDir) -> ct_event:add_handler([{vts,VtsPid}]) end end, - case read_config_files(Opts) of - ok -> - %% add user handlers - case lists:keysearch(event_handler,1,Opts) of - {value,{_,Handlers}} -> - Add = fun({H,Args}) -> - case catch gen_event:add_handler(?CT_EVMGR_REF,H,Args) of - ok -> ok; - {'EXIT',Why} -> exit(Why); - Other -> exit({event_handler,Other}) - end - end, - case catch lists:foreach(Add,Handlers) of - {'EXIT',Reason} -> - Parent ! {self(),Reason}; - _ -> - ok - end; - false -> + %% start ct_config server + ct_config:start(Mode), + %% add user event handlers + case lists:keysearch(event_handler,1,Opts) of + {value,{_,Handlers}} -> + Add = fun({H,Args}) -> + case catch gen_event:add_handler(?CT_EVMGR_REF,H,Args) of + ok -> ok; + {'EXIT',Why} -> exit(Why); + Other -> exit({event_handler,Other}) + end + end, + case catch lists:foreach(Add,Handlers) of + {'EXIT',Reason} -> + Parent ! {self(),Reason}; + _ -> ok - end, - {StartTime,TestLogDir} = ct_logs:init(Mode), - ct_event:notify(#event{name=test_start, - node=node(), - data={StartTime, - lists:flatten(TestLogDir)}}), - Parent ! {self(),started}, - loop(Mode,[],StartDir); - ReadError -> - Parent ! {self(),ReadError}, - exit(ReadError) - end. + end; + false -> + ok + end, + {StartTime,TestLogDir} = ct_logs:init(Mode), + + %% Initiate ct_hooks + case catch ct_hooks:init(Opts) of + ok -> + ok; + {_,CTHReason} -> + ct_logs:tc_print('Suite Callback',CTHReason,[]), + Parent ! {self(), CTHReason}, + self() ! {{stop,normal},{self(),make_ref()}} + end, + + ct_event:notify(#event{name=test_start, + node=node(), + data={StartTime, + lists:flatten(TestLogDir)}}), + Parent ! {self(),started}, + loop(Mode,[],StartDir). create_table(TableName,KeyPos) -> create_table(TableName,set,KeyPos). @@ -197,105 +195,6 @@ read_opts() -> {error,{bad_installation,Error}} end. -read_config_files(Opts) -> - ConfigFiles = - lists:foldl(fun({config,Files},Acc) -> - Acc ++ Files; - (_,Acc) -> - Acc - end,[],Opts), - read_config_files1(ConfigFiles). - -read_config_files1([ConfigFile|Files]) -> - case file:consult(ConfigFile) of - {ok,Config} -> - set_config(Config), - read_config_files1(Files); - {error,enoent} -> - {user_error,{config_file_error,ConfigFile,enoent}}; - {error,Reason} -> - Key = - case application:get_env(common_test, decrypt) of - {ok,KeyOrFile} -> - case KeyOrFile of - {key,K} -> - K; - {file,F} -> - get_crypt_key_from_file(F) - end; - _ -> - get_crypt_key_from_file() - end, - case Key of - {error,no_crypt_file} -> - {user_error,{config_file_error,ConfigFile,Reason}}; - {error,CryptError} -> - {user_error,{decrypt_file_error,ConfigFile,CryptError}}; - _ when is_list(Key) -> - case decrypt_config_file(ConfigFile, undefined, {key,Key}) of - {ok,CfgBin} -> - case read_config_terms(CfgBin) of - {error,ReadFail} -> - {user_error,{config_file_error,ConfigFile,ReadFail}}; - Config -> - set_config(Config), - read_config_files1(Files) - end; - {error,DecryptFail} -> - {user_error,{decrypt_config_error,ConfigFile,DecryptFail}} - end; - _ -> - {user_error,{bad_decrypt_key,ConfigFile,Key}} - end - end; -read_config_files1([]) -> - ok. - -read_config_terms(Bin) when is_binary(Bin) -> - case catch binary_to_list(Bin) of - {'EXIT',_} -> - {error,invalid_textfile}; - Lines -> - read_config_terms(Lines) - end; -read_config_terms(Lines) when is_list(Lines) -> - read_config_terms1(erl_scan:tokens([], Lines, 0), 1, [], []). - -read_config_terms1({done,{ok,Ts,EL},Rest}, L, Terms, _) -> - case erl_parse:parse_term(Ts) of - {ok,Term} when Rest == [] -> - lists:reverse([Term|Terms]); - {ok,Term} -> - read_config_terms1(erl_scan:tokens([], Rest, 0), - EL+1, [Term|Terms], Rest); - _ -> - {error,{bad_term,{L,EL}}} - end; -read_config_terms1({done,{eof,_},_}, _, Terms, Rest) when Rest == [] -> - lists:reverse(Terms); -read_config_terms1({done,{eof,EL},_}, L, _, _) -> - {error,{bad_term,{L,EL}}}; -read_config_terms1({done,{error,Info,EL},_}, L, _, _) -> - {error,{Info,{L,EL}}}; -read_config_terms1({more,_}, L, Terms, Rest) -> - case string:tokens(Rest, [$\n,$\r,$\t]) of - [] -> - lists:reverse(Terms); - _ -> - {error,{bad_term,L}} - end. - -set_default_config(NewConfig, Scope) -> - call({set_default_config, {NewConfig, Scope}}). - -set_default_config(Name, NewConfig, Scope) -> - call({set_default_config, {Name, NewConfig, Scope}}). - -delete_default_config(Scope) -> - call({delete_default_config, Scope}). - -update_config(Name, Config) -> - call({update_config, {Name, Config}}). save_suite_data(Key, Value) -> call({save_suite_data, {Key, undefined, Value}}). @@ -303,6 +202,12 @@ save_suite_data(Key, 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}). @@ -342,26 +247,6 @@ loop(Mode,TestData,StartDir) -> ct_logs:make_last_run_index(), return(From,ok), loop(Mode,TestData,StartDir); - {{require,Name,Tag,SubTags},From} -> - Result = do_require(Name,Tag,SubTags), - return(From,Result), - loop(Mode,TestData,StartDir); - {{set_default_config,{Config,Scope}},From} -> - set_config(Config,{true,Scope}), - return(From,ok), - loop(Mode,TestData,StartDir); - {{set_default_config,{Name,Config,Scope}},From} -> - set_config(Name,Config,{true,Scope}), - return(From,ok), - loop(Mode,TestData,StartDir); - {{delete_default_config,Scope},From} -> - delete_config({true,Scope}), - return(From,ok), - loop(Mode,TestData,StartDir); - {{update_config,{Name,NewConfig}},From} -> - update_conf(Name,NewConfig), - return(From,ok), - loop(Mode,TestData,StartDir); {{save_suite_data,{Key,Name,Value}},From} -> ets:insert(?suite_table, #suite_data{key=Key, name=Name, @@ -403,6 +288,9 @@ loop(Mode,TestData,StartDir) -> TestData1 = lists:keydelete(Key,1,TestData), return(From,ok), loop(Mode,[New|TestData1],StartDir); + {{get_testdata, all}, From} -> + return(From, TestData), + loop(From, TestData, StartDir); {{get_testdata,Key},From} -> case lists:keysearch(Key,1,TestData) of {value,{Key,Val}} -> @@ -434,15 +322,22 @@ loop(Mode,TestData,StartDir) -> ct_event:sync_notify(#event{name=test_done, node=node(), data=Time}), - ets:delete(?attr_table), + Callbacks = ets:lookup_element(?suite_table, + ct_hooks, + #suite_data.value), + ct_hooks:terminate(Callbacks), close_connections(ets:tab2list(?conn_table)), ets:delete(?conn_table), ets:delete(?board_table), ets:delete(?suite_table), ct_logs:close(How), - file:set_cwd(StartDir), ct_event:stop(), + 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); @@ -463,6 +358,8 @@ close_connections([#conn{handle=Handle,callback=CB}|Conns]) -> close_connections([]) -> ok. +get_key_from_name(Name)-> + ct_config:get_key_from_name(Name). %%%----------------------------------------------------------------- %%% @spec register_connection(TargetName,Address,Callback,Handle) -> @@ -480,7 +377,7 @@ close_connections([]) -> %%% test is finished by calling <code>Callback:close/1</code>.</p> register_connection(TargetName,Address,Callback,Handle) -> TargetRef = - case get_ref_from_name(TargetName) of + case ct_config:get_ref_from_name(TargetName) of {ok,Ref} -> Ref; _ -> @@ -518,7 +415,7 @@ unregister_connection(Handle) -> %%% %%% @doc Check if a connection already exists. does_connection_exist(TargetName,Address,Callback) -> - case get_ref_from_name(TargetName) of + case ct_config:get_ref_from_name(TargetName) of {ok,TargetRef} -> case ets:select(?conn_table,[{#conn{handle='$1', targetref=TargetRef, @@ -548,7 +445,7 @@ does_connection_exist(TargetName,Address,Callback) -> %%% @doc Return all connections for the <code>Callback</code> on the %%% given target (<code>TargetName</code>). get_connections(TargetName,Callback) -> - case get_ref_from_name(TargetName) of + case ct_config:get_ref_from_name(TargetName) of {ok,Ref} -> {ok,ets:select(?conn_table,[{#conn{handle='$1', address='$2', @@ -568,250 +465,11 @@ get_target_name(ConnPid) -> [], ['$1']}]) of [TargetRef] -> - get_name_from_ref(TargetRef); + ct_config:get_name_from_ref(TargetRef); [] -> {error,{unknown_connection,ConnPid}} end. - -%%%----------------------------------------------------------------- -%%% @hidden -%%% @equiv ct:require/1 -require(Key) when is_atom(Key) -> - require({Key,[]}); -require({Key,SubKeys}) when is_atom(Key) -> - allocate('_UNDEF',Key,to_list(SubKeys)); -require(Key) -> - {error,{invalid,Key}}. - - -%%%----------------------------------------------------------------- -%%% @hidden -%%% @equiv ct:require/2 -require(Name,Key) when is_atom(Key) -> - require(Name,{Key,[]}); -require(Name,{Key,SubKeys}) when is_atom(Name), is_atom(Key) -> - call({require,Name,Key,to_list(SubKeys)}); -require(Name,Keys) -> - {error,{invalid,{Name,Keys}}}. - -to_list(X) when is_list(X) -> X; -to_list(X) -> [X]. - -do_require(Name,Key,SubKeys) when is_list(SubKeys) -> - case get_key_from_name(Name) of - {error,_} -> - allocate(Name,Key,SubKeys); - {ok,Key} -> - %% already allocated - check that it has all required subkeys - Vals = [Val || {_Ref,Val} <- lookup_name(Name)], - case get_subconfig(SubKeys,Vals) of - {ok,_SubMapped} -> - ok; - Error -> - Error - end; - {ok,OtherKey} -> - {error,{name_in_use,Name,OtherKey}} - end. - -allocate(Name,Key,SubKeys) -> - case ets:match_object(?attr_table,#ct_conf{key=Key,name='_UNDEF',_='_'}) of - [] -> - {error,{not_available,Key}}; - Available -> - case allocate_subconfig(Name,SubKeys,Available,false) of - ok -> - ok; - Error -> - Error - end - end. - -allocate_subconfig(Name,SubKeys,[C=#ct_conf{value=Value}|Rest],Found) -> - case do_get_config(SubKeys,Value,[]) of - {ok,_SubMapped} -> - ets:insert(?attr_table,C#ct_conf{name=Name}), - allocate_subconfig(Name,SubKeys,Rest,true); - _Error -> - allocate_subconfig(Name,SubKeys,Rest,Found) - end; -allocate_subconfig(_Name,_SubKeys,[],true) -> - ok; -allocate_subconfig(_Name,SubKeys,[],false) -> - {error,{not_available,SubKeys}}. - - - - -%%%----------------------------------------------------------------- -%%% @hidden -%%% @equiv ct:get_config/1 -get_config(KeyOrName) -> - get_config(KeyOrName,undefined,[]). - -%%%----------------------------------------------------------------- -%%% @hidden -%%% @equiv ct:get_config/2 -get_config(KeyOrName,Default) -> - get_config(KeyOrName,Default,[]). - -%%%----------------------------------------------------------------- -%%% @hidden -%%% @equiv ct:get_config/3 -get_config(KeyOrName,Default,Opts) when is_atom(KeyOrName) -> - case lookup_config(KeyOrName) of - [] -> - Default; - [{_Ref,Val}|_] = Vals -> - case {lists:member(all,Opts),lists:member(element,Opts)} of - {true,true} -> - [{KeyOrName,V} || {_R,V} <- lists:sort(Vals)]; - {true,false} -> - [V || {_R,V} <- lists:sort(Vals)]; - {false,true} -> - {KeyOrName,Val}; - {false,false} -> - Val - end - end; - -get_config({KeyOrName,SubKey},Default,Opts) -> - case lookup_config(KeyOrName) of - [] -> - Default; - Vals -> - Vals1 = case [Val || {_Ref,Val} <- lists:sort(Vals)] of - Result=[L|_] when is_list(L) -> - case L of - [{_,_}|_] -> - Result; - _ -> - [] - end; - _ -> - [] - end, - case get_subconfig([SubKey],Vals1,[],Opts) of - {ok,[{_,SubVal}|_]=SubVals} -> - case {lists:member(all,Opts),lists:member(element,Opts)} of - {true,true} -> - [{{KeyOrName,SubKey},Val} || {_,Val} <- SubVals]; - {true,false} -> - [Val || {_SubKey,Val} <- SubVals]; - {false,true} -> - {{KeyOrName,SubKey},SubVal}; - {false,false} -> - SubVal - end; - _ -> - Default - end - end. - - -get_subconfig(SubKeys,Values) -> - get_subconfig(SubKeys,Values,[],[]). - -get_subconfig(SubKeys,[Value|Rest],Mapped,Opts) -> - case do_get_config(SubKeys,Value,[]) of - {ok,SubMapped} -> - case lists:member(all,Opts) of - true -> - get_subconfig(SubKeys,Rest,Mapped++SubMapped,Opts); - false -> - {ok,SubMapped} - end; - _Error -> - get_subconfig(SubKeys,Rest,Mapped,Opts) - end; -get_subconfig(SubKeys,[],[],_) -> - {error,{not_available,SubKeys}}; -get_subconfig(_SubKeys,[],Mapped,_) -> - {ok,Mapped}. - -do_get_config([Key|Required],Available,Mapped) -> - case lists:keysearch(Key,1,Available) of - {value,{Key,Value}} -> - NewAvailable = lists:keydelete(Key,1,Available), - NewMapped = [{Key,Value}|Mapped], - do_get_config(Required,NewAvailable,NewMapped); - false -> - {error,{not_available,Key}} - end; -do_get_config([],_Available,Mapped) -> - {ok,lists:reverse(Mapped)}. - -get_all_config() -> - ets:select(?attr_table,[{#ct_conf{name='$1',key='$2',value='$3', - default='$4',_='_'}, - [], - [{{'$1','$2','$3','$4'}}]}]). - -lookup_config(KeyOrName) -> - case lookup_name(KeyOrName) of - [] -> - lookup_key(KeyOrName); - Values -> - Values - end. - -lookup_name(Name) -> - ets:select(?attr_table,[{#ct_conf{ref='$1',value='$2',name=Name,_='_'}, - [], - [{{'$1','$2'}}]}]). -lookup_key(Key) -> - ets:select(?attr_table,[{#ct_conf{key=Key,ref='$1',value='$2',name='_UNDEF',_='_'}, - [], - [{{'$1','$2'}}]}]). - -set_config(Config) -> - set_config('_UNDEF',Config,false). - -set_config(Config,Default) -> - set_config('_UNDEF',Config,Default). - -set_config(Name,Config,Default) -> - [ets:insert(?attr_table, - #ct_conf{key=Key,value=Val,ref=ct_make_ref(), - name=Name,default=Default}) || - {Key,Val} <- Config]. - -delete_config(Default) -> - ets:match_delete(?attr_table,#ct_conf{default=Default,_='_'}), - ok. - - -%%%----------------------------------------------------------------- -%%% @spec release_allocated() -> ok -%%% -%%% @doc Release all allocated resources, but don't take down any -%%% connections. -release_allocated() -> - Allocated = ets:select(?attr_table,[{#ct_conf{name='$1',_='_'}, - [{'=/=','$1','_UNDEF'}], - ['$_']}]), - release_allocated(Allocated). -release_allocated([H|T]) -> - ets:delete_object(?attr_table,H), - ets:insert(?attr_table,H#ct_conf{name='_UNDEF'}), - release_allocated(T); -release_allocated([]) -> - ok. - -%%%----------------------------------------------------------------- -%%% @spec -%%% -%%% @doc -update_conf(Name, NewConfig) -> - Old = ets:select(?attr_table,[{#ct_conf{name=Name,_='_'},[],['$_']}]), - lists:foreach(fun(OldElem) -> - NewElem = OldElem#ct_conf{value=NewConfig}, - ets:delete_object(?attr_table, OldElem), - ets:insert(?attr_table, NewElem) - end, Old), - ok. - %%%----------------------------------------------------------------- %%% @spec close_connections() -> ok %%% @@ -928,10 +586,37 @@ listenv(Telnet) -> %%% @hidden %%% @equiv ct:parse_table/1 parse_table(Data) -> - [Heading|Lines]= - [remove_space(string:tokens(L, "|"),[]) || L <- Data, hd(L)==$|], + {Heading, Rest} = get_headings(Data), + Lines = parse_row(Rest,[],size(Heading)), {Heading,Lines}. +get_headings(["|" ++ Headings | Rest]) -> + {remove_space(string:tokens(Headings, "|"),[]), Rest}; +get_headings([_ | Rest]) -> + get_headings(Rest); +get_headings([]) -> + {{},[]}. + +parse_row(["|" ++ _ = Row | T], Rows, NumCols) when NumCols > 1 -> + case string:tokens(Row, "|") of + Values when length(Values) =:= NumCols -> + parse_row(T,[remove_space(Values,[])|Rows], NumCols); + Values when length(Values) < NumCols -> + parse_row([Row ++"\n"++ hd(T) | tl(T)], Rows, NumCols) + end; +parse_row(["|" ++ _ = Row | T], Rows, 1 = NumCols) -> + case string:rchr(Row, $|) of + 1 -> + parse_row([Row ++"\n"++hd(T) | tl(T)], Rows, NumCols); + _Else -> + parse_row(T, [remove_space(string:tokens(Row,"|"),[])|Rows], + NumCols) + end; +parse_row([_Skip | T], Rows, NumCols) -> + parse_row(T, Rows, NumCols); +parse_row([], Rows, _NumCols) -> + lists:reverse(Rows). + remove_space([Str|Rest],Acc) -> remove_space(Rest,[string:strip(string:strip(Str),both,$')|Acc]); remove_space([],Acc) -> @@ -995,167 +680,6 @@ get_testdir(Dir, _) -> %%% @spec %%% %%% @doc -encrypt_config_file(SrcFileName, EncryptFileName) -> - case get_crypt_key_from_file() of - {error,_} = E -> - E; - Key -> - encrypt_config_file(SrcFileName, EncryptFileName, {key,Key}) - end. - -%%%----------------------------------------------------------------- -%%% @spec -%%% -%%% @doc -encrypt_config_file(SrcFileName, EncryptFileName, {file,KeyFile}) -> - case get_crypt_key_from_file(KeyFile) of - {error,_} = E -> - E; - Key -> - encrypt_config_file(SrcFileName, EncryptFileName, {key,Key}) - end; - -encrypt_config_file(SrcFileName, EncryptFileName, {key,Key}) -> - crypto:start(), - {K1,K2,K3,IVec} = make_crypto_key(Key), - case file:read_file(SrcFileName) of - {ok,Bin0} -> - Bin1 = term_to_binary({SrcFileName,Bin0}), - Bin2 = case byte_size(Bin1) rem 8 of - 0 -> Bin1; - N -> list_to_binary([Bin1,random_bytes(8-N)]) - end, - EncBin = crypto:des3_cbc_encrypt(K1, K2, K3, IVec, Bin2), - case file:write_file(EncryptFileName, EncBin) of - ok -> - io:format("~s --(encrypt)--> ~s~n", - [SrcFileName,EncryptFileName]), - ok; - {error,Reason} -> - {error,{Reason,EncryptFileName}} - end; - {error,Reason} -> - {error,{Reason,SrcFileName}} - end. - -%%%----------------------------------------------------------------- -%%% @spec -%%% -%%% @doc -decrypt_config_file(EncryptFileName, TargetFileName) -> - case get_crypt_key_from_file() of - {error,_} = E -> - E; - Key -> - decrypt_config_file(EncryptFileName, TargetFileName, {key,Key}) - end. - - -%%%----------------------------------------------------------------- -%%% @spec -%%% -%%% @doc -decrypt_config_file(EncryptFileName, TargetFileName, {file,KeyFile}) -> - case get_crypt_key_from_file(KeyFile) of - {error,_} = E -> - E; - Key -> - decrypt_config_file(EncryptFileName, TargetFileName, {key,Key}) - end; - -decrypt_config_file(EncryptFileName, TargetFileName, {key,Key}) -> - crypto:start(), - {K1,K2,K3,IVec} = make_crypto_key(Key), - case file:read_file(EncryptFileName) of - {ok,Bin} -> - DecBin = crypto:des3_cbc_decrypt(K1, K2, K3, IVec, Bin), - case catch binary_to_term(DecBin) of - {'EXIT',_} -> - {error,bad_file}; - {_SrcFile,SrcBin} -> - case TargetFileName of - undefined -> - {ok,SrcBin}; - _ -> - case file:write_file(TargetFileName, SrcBin) of - ok -> - io:format("~s --(decrypt)--> ~s~n", - [EncryptFileName,TargetFileName]), - ok; - {error,Reason} -> - {error,{Reason,TargetFileName}} - end - end - end; - {error,Reason} -> - {error,{Reason,EncryptFileName}} - end. - - -get_crypt_key_from_file(File) -> - case file:read_file(File) of - {ok,Bin} -> - case catch string:tokens(binary_to_list(Bin), [$\n,$\r]) of - [Key] -> - Key; - _ -> - {error,{bad_crypt_file,File}} - end; - {error,Reason} -> - {error,{Reason,File}} - end. - -get_crypt_key_from_file() -> - CwdFile = filename:join(".",?cryptfile), - {Result,FullName} = - case file:read_file(CwdFile) of - {ok,Bin} -> - {Bin,CwdFile}; - _ -> - case init:get_argument(home) of - {ok,[[Home]]} -> - HomeFile = filename:join(Home,?cryptfile), - case file:read_file(HomeFile) of - {ok,Bin} -> - {Bin,HomeFile}; - _ -> - {{error,no_crypt_file},noent} - end; - _ -> - {{error,no_crypt_file},noent} - end - end, - case FullName of - noent -> - Result; - _ -> - case catch string:tokens(binary_to_list(Result), [$\n,$\r]) of - [Key] -> - io:format("~nCrypt key file: ~s~n", [FullName]), - Key; - _ -> - {error,{bad_crypt_file,FullName}} - end - end. - -make_crypto_key(String) -> - <<K1:8/binary,K2:8/binary>> = First = erlang:md5(String), - <<K3:8/binary,IVec:8/binary>> = erlang:md5([First|lists:reverse(String)]), - {K1,K2,K3,IVec}. - -random_bytes(N) -> - {A,B,C} = now(), - random:seed(A, B, C), - random_bytes_1(N, []). - -random_bytes_1(0, Acc) -> Acc; -random_bytes_1(N, Acc) -> random_bytes_1(N-1, [random:uniform(255)|Acc]). - - -%%%----------------------------------------------------------------- -%%% @spec -%%% -%%% @doc get_attached(TCPid) -> case dbg_iserver:safe_call({get_attpid,TCPid}) of {ok,AttPid} when is_pid(AttPid) -> @@ -1210,7 +734,7 @@ call(Msg) -> ct_util_server ! {Msg,{self(),Ref}}, receive {Ref, Result} -> - erlang:demonitor(MRef), + erlang:demonitor(MRef, [flush]), Result; {'DOWN',MRef,process,_,Reason} -> {error,{ct_util_server_down,Reason}} @@ -1219,6 +743,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). @@ -1244,37 +771,6 @@ ct_make_ref_loop(N) -> From ! {self(),N}, ct_make_ref_loop(N+1) end. - -get_ref_from_name(Name) -> - case ets:select(?attr_table,[{#ct_conf{name=Name,ref='$1',_='_'}, - [], - ['$1']}]) of - [Ref] -> - {ok,Ref}; - _ -> - {error,{no_such_name,Name}} - end. - -get_name_from_ref(Ref) -> - case ets:select(?attr_table,[{#ct_conf{name='$1',ref=Ref,_='_'}, - [], - ['$1']}]) of - [Name] -> - {ok,Name}; - _ -> - {error,{no_such_ref,Ref}} - end. - -get_key_from_name(Name) -> - case ets:select(?attr_table,[{#ct_conf{name=Name,key='$1',_='_'}, - [], - ['$1']}]) of - [Key|_] -> - {ok,Key}; - _ -> - {error,{no_such_name,Name}} - end. - abs_name(Dir0) -> Abs = filename:absname(Dir0), diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index c1dc14f943..556f88c84d 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2010. All Rights Reserved. +%% Copyright Ericsson AB 2003-2011. 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 @@ -29,13 +29,20 @@ -record(testspec, {spec_dir, nodes=[], + init=[], + label=[], logdir=["."], cover=[], config=[], + userconfig=[], event_handler=[], + ct_hooks=[], include=[], + multiply_timetraps=[], + scale_timetraps=[], alias=[], - tests=[]}). + tests=[], + merge_tests = true }). -record(cover, {app=none, level=details, @@ -50,3 +57,4 @@ -define(CT_MEVMGR_REF, ct_master_event). -define(missing_suites_info, "missing_suites.info"). +-define(ct_config_txt, ct_config_plain). diff --git a/lib/common_test/src/vts.erl b/lib/common_test/src/vts.erl index ad4845a7c3..2ee982d726 100644 --- a/lib/common_test/src/vts.erl +++ b/lib/common_test/src/vts.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2003-2010. 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% %% @@ -100,7 +100,7 @@ start_link() -> MRef = erlang:monitor(process,Pid), receive {Pid,started} -> - erlang:demonitor(MRef), + erlang:demonitor(MRef, [flush]), {ok,Pid}; {'DOWN',MRef,process,_,Reason} -> {error,{vts,died,Reason}} @@ -160,11 +160,13 @@ init(Parent) -> loop(State) -> receive - {{init_data,ConfigFiles,EvHandlers,LogDir,Tests},From} -> - ct_install(State), + {{init_data,Config,EvHandlers,LogDir,Tests},From} -> + %% ct:pal("State#state.current_log_dir=~p", [State#state.current_log_dir]), + NewState = State#state{config=Config,event_handler=EvHandlers, + current_log_dir=LogDir,tests=Tests}, + ct_install(NewState), return(From,ok), - loop(#state{config=ConfigFiles,event_handler=EvHandlers, - current_log_dir=LogDir,tests=Tests}); + loop(NewState); {start_page,From} -> return(From,start_page1()), loop(State); @@ -257,7 +259,7 @@ call(Msg) -> Pid ! {Msg,{self(),Ref}}, receive {Ref, Result} -> - erlang:demonitor(MRef), + erlang:demonitor(MRef, [flush]), Result; {'DOWN',MRef,process,_,Reason} -> {error,{process_down,Pid,Reason}} |