diff options
Diffstat (limited to 'lib/test_server')
27 files changed, 1459 insertions, 1105 deletions
diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile index 3dca55178d..0858d24fce 100644 --- a/lib/test_server/src/Makefile +++ b/lib/test_server/src/Makefile @@ -57,7 +57,8 @@ TS_MODULES= \ ts_erl_config \ ts_autoconf_win32 \ ts_autoconf_vxworks \ - ts_install + ts_install \ + ts_install_cth TARGET_MODULES= $(MODULES:%=$(EBIN)/%) TS_TARGET_MODULES= $(TS_MODULES:%=$(EBIN)/%) @@ -71,7 +72,7 @@ C_FILES = AUTOCONF_FILES = configure.in conf_vars.in COVER_FILES = cross.cover PROGRAMS = configure config.sub config.guess install-sh -CONFIG = ts.config ts.unix.config ts.win32.config ts.vxworks.config +CONFIG = ts.config ts.unix.config ts.win32.config TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) \ $(APP_TARGET) $(APPUP_TARGET) @@ -136,7 +137,7 @@ release_tests_spec: opt $(INSTALL_DIR) $(RELEASE_PATH)/test_server $(INSTALL_DATA) $(ERL_FILES) $(TS_ERL_FILES) \ $(HRL_FILES) $(INTERNAL_HRL_FILES) $(TS_HRL_FILES) \ - $(TARGET_FILES) $(TS_TARGET_FILES) \ + $(TS_TARGET_FILES) \ $(AUTOCONF_FILES) $(C_FILES) $(COVER_FILES) $(CONFIG) \ $(RELEASE_PATH)/test_server $(INSTALL_SCRIPT) $(PROGRAMS) $(RELEASE_PATH)/test_server diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index ee121e5bb6..2ab4e9c28a 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -470,7 +470,7 @@ cover_analyse(Analyse,Modules) -> overview -> fun(_) -> undefined end end, - R = lists:map( + R = pmap( fun(M) -> case cover:analyse(M,module) of {ok,{M,{Cov,NotCov}}} -> @@ -486,6 +486,19 @@ cover_analyse(Analyse,Modules) -> stick_all_sticky(node(),Sticky), R. +pmap(Fun,List) -> + Collector = self(), + Pids = lists:map(fun(E) -> + spawn(fun() -> + Collector ! {res,self(),Fun(E)} + end) + end, List), + lists:map(fun(Pid) -> + receive + {res,Pid,Res} -> + Res + end + end, Pids). unstick_all_sticky(Node) -> lists:filter( @@ -856,7 +869,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> %% a framework function failed CB = os:getenv("TEST_SERVER_FRAMEWORK"), Loc = case CB of - false -> + FW when FW =:= false; FW =:= "undefined" -> {test_server,Func}; _ -> {list_to_atom(CB),Func} @@ -935,8 +948,7 @@ spawn_fw_call(Mod,{init_per_testcase,Func},Pid,{timetrap_timeout,TVal}=Why, Skip = {skip,{failed,{Mod,init_per_testcase,Why}}}, %% if init_per_testcase fails, the test case %% should be skipped - case catch test_server_sup:framework_call( - end_tc,[?pl2a(Mod),Func,{Pid,Skip,[[]]}]) of + case catch do_end_tc_call(Mod,Func,{Pid,Skip,[[]]},Why) of {'EXIT',FwEndTCErr} -> exit({fw_notify_done,end_tc,FwEndTCErr}); _ -> @@ -955,11 +967,9 @@ spawn_fw_call(Mod,{end_per_testcase,Func},Pid,{timetrap_timeout,TVal}=Why, Conf = [{tc_status,ok}], %% if end_per_testcase fails, the test case should be %% reported successful with a warning printed as comment - case catch test_server_sup:framework_call(end_tc, - [?pl2a(Mod),Func, - {Pid, - {failed,{Mod,end_per_testcase,Why}}, - [Conf]}]) of + case catch do_end_tc_call(Mod,Func,{Pid, + {failed,{Mod,end_per_testcase,Why}}, + [Conf]}, Why) of {'EXIT',FwEndTCErr} -> exit({fw_notify_done,end_tc,FwEndTCErr}); _ -> @@ -1001,9 +1011,7 @@ spawn_fw_call(Mod,Func,Pid,Error,Loc,SendTo,Comment) -> ok end, Conf = [{tc_status,{failed,timetrap_timeout}}], - case catch test_server_sup:framework_call(end_tc, - [?pl2a(Mod),Func, - {Pid,Error,[Conf]}]) of + case catch do_end_tc_call(Mod,Func,{Pid,Error,[Conf]},Error) of {'EXIT',FwEndTCErr} -> exit({fw_notify_done,end_tc,FwEndTCErr}); _ -> @@ -1069,27 +1077,27 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, {{Time,Value},Loc,Opts} = case test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0], - {ok,Args0}) of + {ok, Args0}) of {ok,Args} -> run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback); Error = {error,_Reason} -> - test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func,{Error,Args0}]), - {{0,{skip,{failed,Error}}},{Mod,Func},[]}; + NewResult = do_end_tc_call(Mod,Func,{Error,Args0}, + {skip,{failed,Error}}), + {{0,NewResult},{Mod,Func},[]}; {fail,Reason} -> [Conf] = Args0, Conf1 = [{tc_status,{failed,Reason}} | Conf], fw_error_notify(Mod, Func, Conf, Reason), - test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func, - {{error,Reason},[Conf1]}]), - {{0,{failed,Reason}},{Mod,Func},[]}; + NewResult = do_end_tc_call(Mod,Func, {{error,Reason},[Conf1]}, + {fail, Reason}), + {{0,NewResult},{Mod,Func},[]}; Skip = {skip,_Reason} -> - test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func,{Skip,Args0}]), - {{0,Skip},{Mod,Func},[]}; + NewResult = do_end_tc_call(Mod,Func,{Skip,Args0},Skip), + {{0,NewResult},{Mod,Func},[]}; {auto_skip,Reason} -> - test_server_sup:framework_call(end_tc,[?pl2a(Mod), - Func, - {{skip,Reason},Args0}]), - {{0,{skip,{fw_auto_skip,Reason}}},{Mod,Func},[]} + NewResult = do_end_tc_call(Mod, Func, {{skip,Reason},Args0}, + {skip, {fw_auto_skip,Reason}}), + {{0,NewResult},{Mod,Func},[]} end, exit({Ref,Time,Value,Loc,Opts}). @@ -1103,14 +1111,14 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> Skip = {skip,Reason} -> Line = get_loc(), Conf = [{tc_status,{skipped,Reason}}], - test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func,{Skip,[Conf]}]), - {{0,{skip,Reason}},Line,[]}; + NewRes = do_end_tc_call(Mod,Func,{Skip,[Conf]}, Skip), + {{0,NewRes},Line,[]}; {skip_and_save,Reason,SaveCfg} -> Line = get_loc(), Conf = [{tc_status,{skipped,Reason}},{save_config,SaveCfg}], - test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func, - {{skip,Reason},[Conf]}]), - {{0,{skip,Reason}},Line,[]}; + NewRes = do_end_tc_call(Mod, Func, {{skip, Reason}, [Conf]}, + {skip, Reason}), + {{0,NewRes},Line,[]}; {ok,NewConf} -> put(test_server_init_or_end_conf,undefined), %% call user callback function if defined @@ -1155,13 +1163,12 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> {FWReturn,TSReturn,EndConf1} end, put(test_server_init_or_end_conf,undefined), - case test_server_sup:framework_call(end_tc, [?pl2a(Mod), Func, - {FWReturn1,[EndConf2]}]) of - {fail,Reason} -> - fw_error_notify(Mod, Func, EndConf2, Reason), - {{T,{failed,Reason}},{Mod,Func},[]}; - _ -> - {{T,TSReturn1},Loc,[]} + case do_end_tc_call(Mod, Func, {FWReturn1,[EndConf2]}, TSReturn1) of + {failed,Reason} = NewReturn -> + fw_error_notify(Mod,Func,EndConf2, Reason), + {{T,NewReturn},{Mod,Func},[]}; + NewReturn -> + {{T,NewReturn},Loc,[]} end end; skip_init -> @@ -1179,10 +1186,36 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> {{T,Return},Loc} = {ts_tc(Mod, Func, Args2),get_loc()}, %% call user callback function if defined Return1 = user_callback(TCCallback, Mod, Func, 'end', Return), - {Return2,Opts} = process_return_val([Return1], Mod,Func,Args1, Loc, Return1), + {Return2,Opts} = process_return_val([Return1], Mod, Func, + Args1, Loc, Return1), {{T,Return2},Loc,Opts} end. +do_end_tc_call(M,F,Res,Return) -> + Ref = make_ref(), + case test_server_sup:framework_call( + end_tc, [?pl2a(M),F,Res], Ref) of + {fail,FWReason} -> + {failed,FWReason}; + Ref -> + case test_server_sup:framework_call( + end_tc, [?pl2a(M),F,Res, Return], ok) of + {fail,FWReason} -> + {failed,FWReason}; + ok -> + case Return of + {fail,Reason} -> + {failed,Reason}; + Return -> + Return + end; + NewReturn -> + NewReturn + end; + _ -> + Return + end. + %% the return value is a list and we have to check if it contains %% the result of an end conf case or if it's a Config list process_return_val([Return], M,F,A, Loc, Final) when is_list(Return) -> @@ -1197,13 +1230,13 @@ process_return_val([Return], M,F,A, Loc, Final) when is_list(Return) -> end, Return) of true -> % must be return value from end conf case process_return_val1(Return, M,F,A, Loc, Final, []); - false -> % must be Config value from init conf case - case test_server_sup:framework_call(end_tc, [?pl2a(M),F,{ok,A}]) of - {fail,FWReason} -> + false -> % must be Config value from init conf case + case do_end_tc_call(M,F,{ok,A}, Return) of + {failed, FWReason} = Failed -> fw_error_notify(M,F,A, FWReason), - {{failed,FWReason},[]}; - _ -> - {Return,[]} + {Failed, []}; + NewReturn -> + {NewReturn, []} end end; %% the return value is not a list, so it's the return value from an @@ -1211,16 +1244,16 @@ process_return_val([Return], M,F,A, Loc, Final) when is_list(Return) -> process_return_val(Return, M,F,A, Loc, Final) -> process_return_val1(Return, M,F,A, Loc, Final, []). -process_return_val1([Failed={E,TCError}|_], M,F,A=[Args], Loc, _, SaveOpts) when E=='EXIT'; - E==failed -> +process_return_val1([Failed={E,TCError}|_], M,F,A=[Args], Loc, _, SaveOpts) + when E=='EXIT'; + E==failed -> fw_error_notify(M,F,A, TCError, mod_loc(Loc)), - case test_server_sup:framework_call(end_tc, - [?pl2a(M),F,{{error,TCError}, - [[{tc_status,{failed,TCError}}|Args]]}]) of - {fail,FWReason} -> + case do_end_tc_call(M,F,{{error,TCError}, + [[{tc_status,{failed,TCError}}|Args]]}, Failed) of + {failed,FWReason} -> {{failed,FWReason},SaveOpts}; - _ -> - {Failed,SaveOpts} + NewReturn -> + {NewReturn,SaveOpts} end; process_return_val1([SaveCfg={save_config,_}|Opts], M,F,[Args], Loc, Final, SaveOpts) -> process_return_val1(Opts, M,F,[[SaveCfg|Args]], Loc, Final, SaveOpts); @@ -1234,11 +1267,11 @@ process_return_val1([RetVal={Tag,_}|Opts], M,F,A, Loc, _, SaveOpts) when Tag==sk process_return_val1([_|Opts], M,F,A, Loc, Final, SaveOpts) -> process_return_val1(Opts, M,F,A, Loc, Final, SaveOpts); process_return_val1([], M,F,A, _Loc, Final, SaveOpts) -> - case test_server_sup:framework_call(end_tc, [?pl2a(M),F,{Final,A}]) of - {fail,FWReason} -> + case do_end_tc_call(M,F,{Final,A}, Final) of + {failed,FWReason} -> {{failed,FWReason},SaveOpts}; - _ -> - {Final,lists:reverse(SaveOpts)} + NewReturn -> + {NewReturn,lists:reverse(SaveOpts)} end. user_callback(undefined, _, _, _, Args) -> @@ -1263,7 +1296,7 @@ init_per_testcase(Mod, Func, Args) -> false -> code:load_file(Mod); _ -> ok end, - %% init_per_testcase defined, returns new configuration +%% init_per_testcase defined, returns new configuration case erlang:function_exported(Mod,init_per_testcase,2) of true -> case catch my_apply(Mod, init_per_testcase, [Func|Args]) of @@ -1306,8 +1339,8 @@ init_per_testcase(Mod, Func, Args) -> {skip,{failed,{Mod,init_per_testcase,Other}}} end; false -> - %% Optional init_per_testcase not defined - %% keep quiet. +%% Optional init_per_testcase not defined +%% keep quiet. [Config] = Args, {ok, Config} end. diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index 1dc5646184..7cd58642d0 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -168,6 +168,7 @@ cross_cover_analyse/1, cross_cover_analyse/2, trc/1, stop_trace/0]). -export([testcase_callback/1]). -export([set_random_seed/1]). +-export([kill_slavenodes/0]). %%% TEST_SERVER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -export([output/2, print/2, print/3, print_timestamp/2]). @@ -525,6 +526,9 @@ testcase_callback(ModFunc) -> set_random_seed(Seed) -> controller_call({set_random_seed,Seed}). +kill_slavenodes() -> + controller_call(kill_slavenodes). + get_hosts() -> get(test_server_hosts). @@ -533,6 +537,8 @@ get_target_os_type() -> undefined -> %% This is probably called on the target node os:type(); + Pid when Pid =:= self() -> + os:type(); _pid -> %% This is called on the controller, e.g. from a %% specification clause of a test case @@ -637,7 +643,7 @@ contact_main_target(local) -> %% When used by a general framework, global registration of %% test_server should not be required. case os:getenv("TEST_SERVER_FRAMEWORK") of - false -> + FW when FW =:= false; FW =:= "undefined" -> %% Local target! The global test_server process implemented by %% test_server.erl will not be started, so we simulate it by %% globally registering this process instead. @@ -1704,7 +1710,7 @@ do_test_cases(TopCases, SkipCases, [erlang:system_info(version), code:root_dir()]), case os:getenv("TEST_SERVER_FRAMEWORK") of - false -> + FW when FW =:= false; FW =:= "undefined" -> print(html, "<p>Target:<br>\n"), print_who(TI#target_info.host, TI#target_info.username), print(html, "<br>Used Erlang ~s in <tt>~s</tt>.\n", @@ -3552,7 +3558,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, {_,{'EXIT',Reason}} -> progress(failed, Num, Mod, Func, Loc, Reason, Time, Comment, Style); - {_, {failed, Reason}} -> + {_, {Fail, Reason}} when Fail =:= fail; Fail =:= failed -> progress(failed, Num, Mod, Func, Loc, Reason, Time, Comment, Style); {_, {Skip, Reason}} when Skip==skip; Skip==skipped -> @@ -4057,7 +4063,7 @@ get_font_style1(default) -> format_exception(Reason={_Error,Stack}) when is_list(Stack) -> case os:getenv("TEST_SERVER_FRAMEWORK") of - false -> + FW when FW =:= false; FW =:= "undefined" -> case application:get_env(test_server, format_exception) of {ok,false} -> {"~p",Reason}; @@ -4630,7 +4636,7 @@ collect_case([Case | Cases], St, Acc) -> collect_case_invoke(Mod, Case, MFA, St) -> case os:getenv("TEST_SERVER_FRAMEWORK") of - false -> + FW when FW =:= false; FW =:= "undefined" -> case catch apply(Mod, Case, [suite]) of {'EXIT',_} -> {ok,[MFA],St}; diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl index 49025b1a3d..056d18da96 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/test_server/src/test_server_node.erl @@ -84,7 +84,7 @@ start_remote_main_target(Parameters) -> MasterNode,MasterCookie), Cmd = case os:getenv("TEST_SERVER_FRAMEWORK") of - false -> Cmd0; + FW when FW =:= false; FW =:= "undefined" -> Cmd0; FW -> Cmd0 ++ " -env TEST_SERVER_FRAMEWORK " ++ FW end, diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 625724fbb5..4a7804a482 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -494,7 +494,8 @@ framework_call(Func,Args) -> framework_call(Func,Args,DefaultReturn) -> CB = os:getenv("TEST_SERVER_FRAMEWORK"), framework_call(CB,Func,Args,DefaultReturn). -framework_call(false,_Func,_Args,DefaultReturn) -> +framework_call(FW,_Func,_Args,DefaultReturn) + when FW =:= false; FW =:= "undefined" -> DefaultReturn; framework_call(Callback,Func,Args,DefaultReturn) -> Mod = list_to_atom(Callback), diff --git a/lib/test_server/src/ts.config b/lib/test_server/src/ts.config index 30ef25a0b8..f021f5958b 100644 --- a/lib/test_server/src/ts.config +++ b/lib/test_server/src/ts.config @@ -1,45 +1,46 @@ %% -*- erlang -*- -{ipv6_hosts,[otptest06,otptest08,sauron,iluvatar]}. -%%% Change these to suite the environment. -%%% test_hosts are looked up using "ypmatch xx yy zz hosts" -{test_hosts, - [bingo, hurin, turin, gandalf, super, - merry, nenya, sam, elrond, isildur]}. +%%% Change these to suite the environment. See the inet_SUITE for info about +%%% what they are used for. +%%% test_hosts are looked up using "ypmatch xx yy zz hosts.byname" +%{test_hosts,[my_ip4_host]}. %% IPv4 host only - no ipv6 entry must exist! -{test_host_ipv4_only, - {"isildur", %Short hostname - "isildur.du.uab.ericsson.se", %Long hostname - "134.138.177.24", %IP string - {134,138,177,24}, %IP tuple - ["isildur"], %Any aliases - "::ffff:134.138.177.24", %IPv6 string (compatibilty addr) - {0,0,0,0,0,65535,34442,45336} %IPv6 tuple - }}. - -{test_host_ipv6_only, - {"otptest06", %Short hostname - "otptest06.du.uab.ericsson.se", %Long hostname - "fec0::a00:20ff:feb2:b4a9", %IPv6 string - {65216,0,0,0,2560,8447,65202,46249}, %IPv6 tuple - ["otptest06-ip6"] %Aliases. - }}. - - - -{test_dummy_host, {"dummy", - "dummy.du.uab.ericsson.se", - "192.138.177.1", - {192,138,177,1}, - ["dummy"], - "::ffff:192.138.177.1", - {0,0,0,0,0,65535,49290,45313} - }}. - -{test_dummy_ipv6_host, {"dummy6", - "dummy6.du.uab.ericsson.se", - "fec0::a00:20ff:feb2:6666", - {65216,0,0,0,2560,8447,65202,26214}, - ["dummy6-ip6"] - }}. +%{test_host_ipv4_only, +% {"my_ip4_host", %Short hostname +% "my_ip4_host.mydomain.com", %Long hostname +% "10.10.0.1", %IP string +% {10,10,0,1}, %IP tuple +% ["my_ip4_host"], %Any aliases +% "::ffff:10.10.0.1", %IPv6 string (compatibilty addr) +% {0,0,0,0,0,65535,2570,1} %IPv6 tuple +% }}. + +%{test_dummy_host, {"dummy", +% "dummy.mydomain.com", +% "192.168.0.1", +% {192,168,0,1}, +% ["dummy"], +% "::ffff:192.168.0.1", +% {0,0,0,0,0,65535,49320,1} +% }}. + + +%%% test_hosts are looked up using "ypmatch xx yy zz ipnodes.byname" +%{ipv6_hosts,[my_ip6_host]}. + + +%{test_host_ipv6_only, +% {"my_ip6_host", %Short hostname +% "my_ip6_host.mydomain.com", %Long hostname +% "::2eff:f2b0:1ea0", %IPv6 string +% {0,0,0,0,0,12031,62128,7840}, %IPv6 tuple +% ["my_ip6_host"] %Aliases. +% }}. + +%{test_dummy_ipv6_host, {"dummy6", +% "dummy6.mydomain.com", +% "127::1", +% {295,0,0,0,0,0,0,1}, +% ["dummy6-ip6"] +% }}. diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index fcd955345f..3d55f41b8c 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/test_server/src/ts.erl @@ -150,6 +150,14 @@ help(installed) -> " TraceSpec is the name of a file containing\n", " trace specifications or a list of trace\n", " specification elements.\n", + " {config, Path} - Specify which directory ts should get it's \n" + " config files from. The files should follow\n" + " the convention lib/test_server/src/ts*.config.\n" + " These config files can also be specified by\n" + " setting the TEST_CONFIG_PATH environment\n" + " variable to the directory where the config\n" + " files are. The default location is\n" + " tests/test_server/.\n" "\n", "Supported trace information elements\n", " {tp | tpl, Mod, [] | match_spec()}\n", @@ -249,7 +257,7 @@ run_some([Spec|Specs], Opts) -> run(Testspec) when is_atom(Testspec) -> Options=check_test_get_opts(Testspec, []), File = atom_to_list(Testspec), - run_test(File, ["SPEC current.spec NAME ",File], Options); + run_test(File, [{spec,[File++".spec"]}], Options); %% This can be used from command line, e.g. %% erl -s ts run all_tests <config> @@ -293,11 +301,11 @@ run(List, Opts) when is_list(List), is_list(Opts) -> run(Testspec, Config) when is_atom(Testspec), is_list(Config) -> Options=check_test_get_opts(Testspec, Config), File=atom_to_list(Testspec), - run_test(File, ["SPEC current.spec NAME ", File], Options); + run_test(File, [{spec,[File++".spec"]}], Options); %% Runs one module in a spec (interactive) run(Testspec, Mod) when is_atom(Testspec), is_atom(Mod) -> run_test({atom_to_list(Testspec), Mod}, - ["SPEC current.spec NAME ", atom_to_list(Mod)], + [{suite,Mod}], [interactive]). %% run/3 @@ -305,20 +313,23 @@ run(Testspec, Mod) when is_atom(Testspec), is_atom(Mod) -> run(Testspec,Mod,Config) when is_atom(Testspec), is_atom(Mod), is_list(Config) -> Options=check_test_get_opts(Testspec, Config), run_test({atom_to_list(Testspec), Mod}, - ["SPEC current.spec NAME ", atom_to_list(Mod)], + [{suite,Mod}], Options); %% Runs one testcase in a module. run(Testspec, Mod, Case) when is_atom(Testspec), is_atom(Mod), is_atom(Case) -> Options=check_test_get_opts(Testspec, []), - Args = ["CASE ",atom_to_list(Mod)," ",atom_to_list(Case)], + Args = [{suite,atom_to_list(Mod)},{testcase,atom_to_list(Case)}], run_test(atom_to_list(Testspec), Args, Options). %% run/4 %% Run one testcase in a module with Options. -run(Testspec, Mod, Case, Config) when is_atom(Testspec), is_atom(Mod), is_atom(Case), is_list(Config) -> +run(Testspec, Mod, Case, Config) when is_atom(Testspec), + is_atom(Mod), + is_atom(Case), + is_list(Config) -> Options=check_test_get_opts(Testspec, Config), - Args = ["CASE ",atom_to_list(Mod), " ",atom_to_list(Case)], + Args = [{suite,atom_to_list(Mod)}, {testcase,atom_to_list(Case)}], run_test(atom_to_list(Testspec), Args, Options). %% Check testspec to be valid and get possible Options @@ -327,10 +338,11 @@ check_test_get_opts(Testspec, Config) -> validate_test(Testspec), Mode = configmember(batch, {batch, interactive}, Config), Vars = configvars(Config), - Trace = configtrace(Config), + Trace = get_config(trace,Config), + ConfigPath = get_config(config,Config), KeepTopcase = configmember(keep_topcase, {keep_topcase,[]}, Config), Cover = configcover(Testspec,Config), - lists:flatten([Vars,Mode,Trace,KeepTopcase,Cover]). + lists:flatten([Vars,Mode,Trace,KeepTopcase,Cover,ConfigPath]). to_erlang_term(Atom) -> String = atom_to_list(Atom), @@ -398,8 +410,8 @@ special_vars(Config) -> SpecVars1 end. -configtrace(Config) -> - case lists:keysearch(trace,1,Config) of +get_config(Key,Config) -> + case lists:keysearch(Key,1,Config) of {value,Value} -> Value; false -> [] end. diff --git a/lib/test_server/src/ts.unix.config b/lib/test_server/src/ts.unix.config index b4325f065f..5a2580f464 100644 --- a/lib/test_server/src/ts.unix.config +++ b/lib/test_server/src/ts.unix.config @@ -1,4 +1,4 @@ %% -*- erlang -*- %% Always run a (VNC) X server on host -{xserver, "frumgar.du.uab.ericsson.se:66"}. +%% {xserver, "xserver.example.com:66"}. diff --git a/lib/test_server/src/ts.vxworks.config b/lib/test_server/src/ts.vxworks.config deleted file mode 100644 index b0b66e07ad..0000000000 --- a/lib/test_server/src/ts.vxworks.config +++ /dev/null @@ -1,19 +0,0 @@ -%% -*- erlang -*- - -%%% There is no equivalent command to ypmatch on Win32... :-( -{hardcoded_hosts, - [{"134.138.177.74","strider"}, - {"134.138.177.72", "elrond"}, - {"134.138.177.67", "sam"}, - {"134.138.176.215", "nenya"}, - {"134.138.176.192", "merry"}, - {"134.138.177.35", "lw4"}, - {"134.138.177.35", "lw5"}, - {"134.138.176.16", "super"}, - {"134.138.177.16", "gandalf"}, - {"134.138.177.92", "turin"}, - {"134.138.177.86", "mallor"}]}. - -{hardcoded_ipv6_hosts, - [{"fe80::a00:20ff:feb2:b4a9","otptest06"}, - {"fe80::a00:20ff:feb2:a621","otptest08"}]}. diff --git a/lib/test_server/src/ts.win32.config b/lib/test_server/src/ts.win32.config index 2802c4a75a..cae587bea8 100644 --- a/lib/test_server/src/ts.win32.config +++ b/lib/test_server/src/ts.win32.config @@ -1,15 +1,8 @@ %% -*- erlang -*- %%% There is no equivalent command to ypmatch on Win32... :-( -{hardcoded_hosts, - [{"134.138.177.24","isildur"}, - {"134.138.177.72", "elrond"}, - {"134.138.176.215", "nenya"}, - {"134.138.176.192", "merry"}, - {"134.138.176.16", "super"}, - {"134.138.177.16", "gandalf"}, - {"134.138.177.92", "turin"}]}. +%{hardcoded_hosts, +% [{"127.0.0.1","localhost"}]}. -{hardcoded_ipv6_hosts, - [{"fe80::a00:20ff:feb2:b4a9","otptest06"}, - {"fe80::a00:20ff:feb2:a621","otptest08"}]}. +%{hardcoded_ipv6_hosts, +% [{"::1","localhost"}]}. diff --git a/lib/test_server/src/ts_install_cth.erl b/lib/test_server/src/ts_install_cth.erl new file mode 100644 index 0000000000..d1a24525ab --- /dev/null +++ b/lib/test_server/src/ts_install_cth.erl @@ -0,0 +1,286 @@ +%% +%% %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 TS Installed SCB +%%% +%%% This module does what the make parts of the ts:run/x command did, +%%% but not the Makefile.first parts! So they have to be done by ts or +%%% manually!! + +-module(ts_install_cth). + +%% Suite Callbacks +-export([id/1]). +-export([init/2]). + +-export([pre_init_per_suite/3]). +-export([post_init_per_suite/4]). +-export([pre_end_per_suite/3]). +-export([post_end_per_suite/4]). + +-export([pre_init_per_group/3]). +-export([post_init_per_group/4]). +-export([pre_end_per_group/3]). +-export([post_end_per_group/4]). + +-export([pre_init_per_testcase/3]). +-export([post_end_per_testcase/4]). + +-export([on_tc_fail/3]). +-export([on_tc_skip/3]). + +-export([terminate/1]). + +-include_lib("kernel/include/file.hrl"). + +-type proplist() :: list({atom(),term()}). +-type config() :: proplist(). +-type reason() :: term(). +-type skip_or_fail() :: {skip, reason()} | + {auto_skip, reason()} | + {fail, reason()}. + +-record(state, { ts_conf_dir, target_system, install_opts, nodenames, nodes }). + +%% @doc The id of this SCB +-spec id(Opts :: term()) -> + Id :: term(). +id(_Opts) -> + ?MODULE. + +%% @doc Always called before any other callback function. +-spec init(Id :: term(), Opts :: proplist()) -> + State :: #state{}. +init(_Id, Opts) -> + Nodenames = proplists:get_value(nodenames, Opts, 0), + Nodes = proplists:get_value(nodes, Opts, 0), + TSConfDir = proplists:get_value(ts_conf_dir, Opts), + TargetSystem = proplists:get_value(target_system, Opts, install_local), + InstallOpts = proplists:get_value(install_opts, Opts, []), + #state{ nodenames = Nodenames, + nodes = Nodes, + ts_conf_dir = TSConfDir, + target_system = TargetSystem, + install_opts = InstallOpts }. + +%% @doc Called before init_per_suite is called. +-spec pre_init_per_suite(Suite :: atom(), + Config :: config(), + State :: #state{}) -> + {config() | skip_or_fail(), NewState :: #state{}}. +pre_init_per_suite(Suite,Config,#state{ ts_conf_dir = undefined} = State) -> + DataDir = proplists:get_value(data_dir, Config), + ParentDir = filename:join( + lists:reverse( + tl(lists:reverse(filename:split(DataDir))))), + TSConfDir = filename:join([ParentDir, "..","test_server"]), + pre_init_per_suite(Suite, Config, State#state{ ts_conf_dir = TSConfDir }); +pre_init_per_suite(_Suite,Config,State) -> + DataDir = proplists:get_value(data_dir, Config), + try + {ok,Variables} = + file:consult(filename:join(State#state.ts_conf_dir,"variables")), + + %% Make the stuff in all_SUITE_data if it exists + AllDir = filename:join(DataDir,"../all_SUITE_data"), + case filelib:is_dir(AllDir) of + true -> + make_non_erlang(AllDir,Variables); + false -> + ok + end, + + make_non_erlang(DataDir, Variables), + + {add_node_name(Config, State), State} + catch Error:Reason -> + Stack = erlang:get_stacktrace(), + ct:pal("~p failed! ~p:{~p,~p}",[?MODULE,Error,Reason,Stack]), + {{fail,{?MODULE,{Error,Reason, Stack}}},State} + end. + +%% @doc Called after init_per_suite. +-spec post_init_per_suite(Suite :: atom(), + Config :: config(), + Return :: config() | skip_or_fail(), + State :: #state{}) -> + {config() | skip_or_fail(), NewState :: #state{}}. +post_init_per_suite(_Suite,_Config,Return,State) -> + test_server_ctrl:kill_slavenodes(), + {Return, State}. + +%% @doc Called before end_per_suite. +-spec pre_end_per_suite(Suite :: atom(), + Config :: config() | skip_or_fail(), + State :: #state{}) -> + {ok | skip_or_fail(), NewState :: #state{}}. +pre_end_per_suite(_Suite,Config,State) -> + {Config, State}. + +%% @doc Called after end_per_suite. +-spec post_end_per_suite(Suite :: atom(), + Config :: config(), + Return :: term(), + State :: #state{}) -> + {ok | skip_or_fail(), NewState :: #state{}}. +post_end_per_suite(_Suite,_Config,Return,State) -> + {Return, State}. + +%% @doc Called before each init_per_group. +-spec pre_init_per_group(Group :: atom(), + Config :: config(), + State :: #state{}) -> + {config() | skip_or_fail(), NewState :: #state{}}. +pre_init_per_group(_Group,Config,State) -> + {add_node_name(Config, State), State}. + +%% @doc Called after each init_per_group. +-spec post_init_per_group(Group :: atom(), + Config :: config(), + Return :: config() | skip_or_fail(), + State :: #state{}) -> + {config() | skip_or_fail(), NewState :: #state{}}. +post_init_per_group(_Group,_Config,Return,State) -> + {Return, State}. + +%% @doc Called after each end_per_group. +-spec pre_end_per_group(Group :: atom(), + Config :: config() | skip_or_fail(), + State :: #state{}) -> + {ok | skip_or_fail(), NewState :: #state{}}. +pre_end_per_group(_Group,Config,State) -> + {Config, State}. + +%% @doc Called after each end_per_group. +-spec post_end_per_group(Group :: atom(), + Config :: config(), + Return :: term(), + State :: #state{}) -> + {ok | skip_or_fail(), NewState :: #state{}}. +post_end_per_group(_Group,_Config,Return,State) -> + {Return, State}. + +%% @doc Called before each test case. +-spec pre_init_per_testcase(TC :: atom(), + Config :: config(), + State :: #state{}) -> + {config() | skip_or_fail(), NewState :: #state{}}. +pre_init_per_testcase(_TC,Config,State) -> + {add_node_name(Config, State), State}. + +%% @doc Called after each test case. +-spec post_end_per_testcase(TC :: atom(), + Config :: config(), + Return :: term(), + State :: #state{}) -> + {ok | skip_or_fail(), NewState :: #state{}}. +post_end_per_testcase(_TC,_Config,Return,State) -> + {Return, State}. + +%% @doc Called after a test case failed. +-spec on_tc_fail(TC :: init_per_suite | end_per_suite | + init_per_group | end_per_group | atom(), + Reason :: term(), State :: #state{}) -> + NewState :: #state{}. +on_tc_fail(_TC, _Reason, State) -> + State. + +%% @doc Called when a test case is skipped. +-spec on_tc_skip(TC :: end_per_suite | init_per_group | end_per_group | atom(), + {tc_auto_skip, {failed, {Mod :: atom(), Function :: atom(), + Reason :: term()}}} | + {tc_user_skip, {skipped, Reason :: term()}}, + State :: #state{}) -> + NewState :: #state{}. +on_tc_skip(_TC, _Reason, State) -> + State. + +%% @doc Called when the scope of the SCB is done. +-spec terminate(State :: #state{}) -> + term(). +terminate(_State) -> + ok. + +%%% ============================================================================ +%%% Local functions +%%% ============================================================================ +%% Configure and run all the Makefiles in the data dirs of the suite +%% in question +make_non_erlang(DataDir, Variables) -> + {ok,CurrWD} = file:get_cwd(), + try + file:set_cwd(DataDir), + MakeCommand = proplists:get_value(make_command,Variables), + + FirstMakefile = filename:join(DataDir,"Makefile.first"), + case filelib:is_regular(FirstMakefile) of + true -> + ct:log("Making ~p",[FirstMakefile]), + ok = ts_make:make( + MakeCommand, DataDir, filename:basename(FirstMakefile)); + false -> + ok + end, + + MakefileSrc = filename:join(DataDir,"Makefile.src"), + MakefileDest = filename:join(DataDir,"Makefile"), + case filelib:is_regular(MakefileSrc) of + true -> + ok = ts_lib:subst_file(MakefileSrc,MakefileDest,Variables), + ct:log("Making ~p",[MakefileDest]), + ok = ts_make:make([{makefile,"Makefile"},{data_dir,DataDir} + | Variables]); + false -> + ok + end + after + file:set_cwd(CurrWD), + timer:sleep(100) + end. + +%% Add a nodename to config if it does not exist +add_node_name(Config, State) -> + case proplists:get_value(nodenames, Config) of + undefined -> + lists:keystore( + nodenames, 1, Config, + {nodenames,generate_nodenames(State#state.nodenames)}); + _Else -> + Config + end. + + +%% Copied from test_server_ctrl.erl +generate_nodenames(Num) -> + {ok,Name} = inet:gethostname(), + generate_nodenames2(Num, [Name], []). + +generate_nodenames2(0, _Hosts, Acc) -> + Acc; +generate_nodenames2(N, Hosts, Acc) -> + Host=lists:nth((N rem (length(Hosts)))+1, Hosts), + Name=list_to_atom(temp_nodename("nod", []) ++ "@" ++ Host), + generate_nodenames2(N-1, Hosts, [Name|Acc]). + +temp_nodename([], Acc) -> + lists:flatten(Acc); +temp_nodename([Chr|Base], Acc) -> + {A,B,C} = erlang:now(), + New = [Chr | integer_to_list(Chr bxor A bxor B+A bxor C+B)], + temp_nodename(Base, [New|Acc]). diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl index 888ac98973..d572b1454c 100644 --- a/lib/test_server/src/ts_run.erl +++ b/lib/test_server/src/ts_run.erl @@ -28,7 +28,7 @@ -include("ts.hrl"). --import(lists, [map/2,member/2,filter/2,reverse/1]). +-import(lists, [member/2,filter/2]). -record(state, {file, % File given. @@ -63,50 +63,18 @@ run(File, Args0, Options, Vars0) -> _ -> {false, fun run_interactive/3} end, - HandleTopcase = case member(keep_topcase, Options) of - true -> [fun copy_topcase/3]; - false -> [fun remove_original_topcase/3, - fun init_topcase/3] - end, - MakefileHooks = [fun make_make/3, - fun add_make_testcase/3], - MakeLoop = fun(V, Sp, St) -> make_loop(MakefileHooks, V, Sp, St) end, Hooks = [fun init_state/3, - fun read_spec_file/3] ++ - HandleTopcase ++ - [fun run_preinits/3, - fun find_makefiles/3, - MakeLoop, - fun make_test_suite/3, - fun add_topcase_to_spec/3, - fun write_spec_file/3, + fun run_preinits/3, fun make_command/3, Runner], - Args = make_test_server_args(Args0,Options,Vars), + Args = make_common_test_args(Args0,Options,Vars), St = #state{file=File,test_server_args=Args,batch=Batch}, R = execute(Hooks, Vars, [], St), - case Batch of - true -> ts_reports:make_index(); - false -> ok % ts_reports:make_index() is run on the test_server node - end, case R of {ok,_,_,_} -> ok; Error -> Error end. -make_loop(Hooks, Vars0, Spec0, St0) -> - case St0#state.makefiles of - [Makefile|Rest] -> - case execute(Hooks, Vars0, Spec0, St0#state{makefile=Makefile}) of - {error, Reason} -> - {error, Reason}; - {ok, Vars, Spec, St} -> - make_loop(Hooks, Vars, Spec, St#state{makefiles=Rest}) - end; - [] -> - {ok, Vars0, Spec0, St0} - end. - execute([Hook|Rest], Vars0, Spec0, St0) -> case Hook(Vars0, Spec0, St0) of ok -> @@ -156,101 +124,6 @@ init_state(Vars, [], St0) -> false -> {error,{no_test_directory,TestDir}} end. - -%% Read the spec file for the test suite. - -read_spec_file(Vars, _, St) -> - TestDir = St#state.test_dir, - File = St#state.file, - {SpecFile,Res} = get_spec_filename(Vars, TestDir, File), - case Res of - {ok,Spec} -> - {ok,Vars,Spec,St}; - {error,Atom} when is_atom(Atom) -> - {error,{no_spec,SpecFile}}; - {error,Reason} -> - {error,{bad_spec,lists:flatten(file:format_error(Reason))}} - end. - -get_spec_filename(Vars, TestDir, File) -> - DynSpec = filename:join(TestDir, File ++ ".dynspec"), - case filelib:is_file(DynSpec) of - true -> - Bs0 = erl_eval:new_bindings(), - Bs1 = erl_eval:add_binding('Target', ts_lib:var(target, Vars), Bs0), - Bs2 = erl_eval:add_binding('Os', ts_lib:var(os, Vars), Bs1), - TCCStr = ts_lib:var(test_c_compiler, Vars), - TCC = try - {ok, Toks, _} = erl_scan:string(TCCStr ++ "."), - {ok, Tcc} = erl_parse:parse_term(Toks), - Tcc - catch - _:_ -> undefined - end, - Bs = erl_eval:add_binding('TestCCompiler', TCC, Bs2), - {DynSpec,file:script(DynSpec, Bs)}; - false -> - SpecFile = get_spec_filename_1(Vars, TestDir, File), - {SpecFile,file:consult(SpecFile)} - end. - -get_spec_filename_1(Vars, TestDir, File) -> - case ts_lib:var(os, Vars) of - "VxWorks" -> - check_spec_filename(TestDir, File, ".spec.vxworks"); - "Windows"++_ -> - check_spec_filename(TestDir, File, ".spec.win"); - _Other -> - filename:join(TestDir, File ++ ".spec") - end. - -check_spec_filename(TestDir, File, Ext) -> - Spec = filename:join(TestDir, File ++ Ext), - case filelib:is_file(Spec) of - true -> Spec; - false -> filename:join(TestDir, File ++ ".spec") - end. - -%% Remove the top case from the spec file. We will add our own -%% top case later. - -remove_original_topcase(Vars, Spec, St) -> - {ok,Vars,filter(fun ({topcase,_}) -> false; - (_Other) -> true end, Spec),St}. - -%% Initialize our new top case. We'll keep in it the state to be -%% able to add more to it. - -init_topcase(Vars, Spec, St) -> - TestDir = St#state.test_dir, - TopCase = - case St#state.mod of - Mod when is_atom(Mod) -> - ModStr = atom_to_list(Mod), - case filelib:is_file(filename:join(TestDir,ModStr++".erl")) of - true -> [{Mod,all}]; - false -> - Wc = filename:join(TestDir, ModStr ++ "*_SUITE.erl"), - [{list_to_atom(filename:basename(M, ".erl")),all} || - M <- filelib:wildcard(Wc)] - end; - _Other -> - %% Here we used to return {dir,TestDir}. Now we instead - %% list all suites in TestDir, so we can add make testcases - %% around it later (see add_make_testcase) without getting - %% duplicates of the suite. (test_server_ctrl does no longer - %% check for duplicates of testcases) - Wc = filename:join(TestDir, "*_SUITE.erl"), - [{list_to_atom(filename:basename(M, ".erl")),all} || - M <- filelib:wildcard(Wc)] - end, - {ok,Vars,Spec,St#state{topcase=TopCase}}. - -%% Or if option keep_topcase was given, eh... keep the topcase -copy_topcase(Vars, Spec, St) -> - {value,{topcase,Tc}} = lists:keysearch(topcase,1,Spec), - {ok, Vars, lists:keydelete(topcase,1,Spec),St#state{topcase=Tc}}. - %% Run any "Makefile.first" files first. %% XXX We should fake a failing test case if the make fails. @@ -279,171 +152,14 @@ run_pre_makefile(Vars, Spec, St) -> {error,_Reason}=Error -> Error end. -%% Search for `Makefile.src' in each *_SUITE_data directory. - -find_makefiles(Vars, Spec, St) -> - Wc = filename:join(St#state.data_wc, "Makefile.src"), - Makefiles = reverse(del_skipped_suite_data_dir(filelib:wildcard(Wc), Spec)), - {ok,Vars,Spec,St#state{makefiles=Makefiles}}. - -%% Create "Makefile" from "Makefile.src". - -make_make(Vars, Spec, State) -> - Src = State#state.makefile, - Dest = filename:rootname(Src), - ts_lib:progress(Vars, 1, "Making ~s...\n", [Dest]), - case ts_lib:subst_file(Src, Dest, Vars) of - ok -> - {ok, Vars, Spec, State#state{makefile=Dest}}; - {error, Reason} -> - {error, {Src, Reason}} - end. - -%% Add a testcase which will do the making of the stuff in the data directory. - -add_make_testcase(Vars, Spec, St) -> - Makefile = St#state.makefile, - Dir = filename:dirname(Makefile), - Shortname = filename:basename(Makefile), - Suite = filename:basename(Dir, "_data"), - Config = [{data_dir,Dir},{makefile,Shortname}], - MakeModule = Suite ++ "_make", - MakeModuleSrc = filename:join(filename:dirname(Dir), - MakeModule ++ ".erl"), - MakeMod = list_to_atom(MakeModule), - case filelib:is_file(MakeModuleSrc) of - true -> ok; - false -> generate_make_module(ts_lib:var(make_command, Vars), - MakeModuleSrc, - MakeModule) - end, - case Suite of - "all_SUITE" -> - {ok,Vars,Spec,St#state{all={MakeMod,Config}}}; - _ -> - %% Avoid duplicates of testcases. There is no longer - %% a check for this in test_server_ctrl. - TestCase = {list_to_atom(Suite),all}, - TopCase0 = case St#state.topcase of - List when is_list(List) -> - List -- [TestCase]; - Top -> - [Top] -- [TestCase] - end, - TopCase = [{make,{MakeMod,make,[Config]}, - TestCase, - {MakeMod,unmake,[Config]}}|TopCase0], - {ok,Vars,Spec,St#state{topcase=TopCase}} - end. - -generate_make_module(MakeCmd, Name, ModuleString) -> - {ok,Host} = inet:gethostname(), - file:write_file(Name, - ["-module(",ModuleString,").\n", - "\n", - "-export([make/1,unmake/1]).\n", - "\n", - "make(Config) when is_list(Config) ->\n", - " Mins = " ++ integer_to_list(?DEFAULT_MAKE_TIMETRAP_MINUTES) ++ ",\n" - " test_server:format(\"=== Setting timetrap to ~p minutes ===~n\", [Mins]),\n" - " TimeTrap = test_server:timetrap(test_server:minutes(Mins)),\n" - " Res = ts_make:make([{make_command, \""++MakeCmd++"\"},{cross_node,\'ts@" ++ Host ++ "\'}|Config]),\n", - " test_server:timetrap_cancel(TimeTrap),\n" - " Res.\n" - "\n", - "unmake(Config) when is_list(Config) ->\n", - " Mins = " ++ integer_to_list(?DEFAULT_UNMAKE_TIMETRAP_MINUTES) ++ ",\n" - " test_server:format(\"=== Setting timetrap to ~p minutes ===~n\", [Mins]),\n" - " TimeTrap = test_server:timetrap(test_server:minutes(Mins)),\n" - " Res = ts_make:unmake([{make_command, \""++MakeCmd++"\"}|Config]),\n" - " test_server:timetrap_cancel(TimeTrap),\n" - " Res.\n" - "\n"]). - - -make_test_suite(Vars, _Spec, State) -> - TestDir = State#state.test_dir, - - Erl_flags=[{i, "../test_server"}|ts_lib:var(erl_flags,Vars)], - - case code:is_loaded(test_server_line) of - false -> code:load_file(test_server_line); - _ -> ok - end, - - {ok, Cwd} = file:get_cwd(), - ok = file:set_cwd(TestDir), - Result = (catch make_all(Erl_flags)), - ok = file:set_cwd(Cwd), - case Result of - up_to_date -> - ok; - {'EXIT', Reason} -> - %% If I return an error here, the test will be stopped - %% and it will not show up in the top index page. Instead - %% I return ok - the test will run for all existing suites. - %% It might be that there are old suites that are run, but - %% at least one suite is missing, and that is reported on the - %% top index page. - io:format("~s: {error,{make_crashed,~p}\n", - [State#state.file,Reason]), - ok; - error -> - %% See comment above - io:format("~s: {error,make_of_test_suite_failed}\n", - [State#state.file]), - ok - end. - -%% Add topcase to spec. - -add_topcase_to_spec(Vars, Spec, St) -> - Tc = case St#state.all of - {MakeMod,Config} -> - [{make,{MakeMod,make,[Config]}, - St#state.topcase, - {MakeMod,unmake,[Config]}}]; - undefined -> St#state.topcase - end, - {ok,Vars,Spec++[{topcase,Tc}],St}. - -%% Writes the (possibly transformed) spec file. - -write_spec_file(Vars, Spec, _State) -> - F = fun(Term) -> io_lib:format("~p.~n", [Term]) end, - SpecFile = map(F, Spec), - Hosts = - case lists:keysearch(hosts, 1, Vars) of - false -> - []; - {value, {hosts, HostList}} -> - io_lib:format("{hosts,~p}.~n",[HostList]) - end, - DiskLess = - case lists:keysearch(diskless, 1, Vars) of - false -> - []; - {value, {diskless, How}} -> - io_lib:format("{diskless, ~p}.~n",[How]) - end, - Conf = consult_config(), - MoreConfig = io_lib:format("~p.\n", [{config,Conf}]), - file:write_file("current.spec", [DiskLess,Hosts,MoreConfig,SpecFile]). - -consult_config() -> - {ok,Conf} = file:consult("ts.config"), - case os:type() of - {unix,_} -> consult_config("ts.unix.config", Conf); - {win32,_} -> consult_config("ts.win32.config", Conf); - vxworks -> consult_config("ts.vxworks.config", Conf); - _ -> Conf - end. - -consult_config(File, Conf0) -> - case file:consult(File) of - {ok,Conf} -> Conf++Conf0; - {error,enoent} -> Conf0 - end. +get_config_files() -> + TSConfig = "ts.config", + [TSConfig | case os:type() of + {unix,_} -> ["ts.unix.config"]; + {win32,_} -> ["ts.win32.config"]; + vxworks -> ["ts.vxworks.config"]; + _ -> [] + end]. %% Makes the command to start up the Erlang node to run the tests. @@ -457,6 +173,7 @@ backslashify([]) -> []. make_command(Vars, Spec, State) -> + {ok,Cwd} = file:get_cwd(), TestDir = State#state.test_dir, TestPath = filename:nativename(TestDir), Erl = case os:getenv("TS_RUN_VALGRIND") of @@ -487,7 +204,7 @@ make_command(Vars, Spec, State) -> {value,{erl_start_args,Args}} -> Args; false -> "" end, - CrashFile = State#state.file ++ "_erl_crash.dump", + CrashFile = filename:join(Cwd,State#state.file ++ "_erl_crash.dump"), case filelib:is_file(CrashFile) of true -> io:format("ts_run: Deleting dump: ~s\n",[CrashFile]), @@ -495,7 +212,8 @@ make_command(Vars, Spec, State) -> false -> ok end, - Cmd = [Erl, Naming, "test_server -pa ", $", TestPath, $", + %% NOTE: Do not use ' in these commands as it wont work on windows + Cmd = [Erl, Naming, "test_server" " -rsh ", ts_lib:var(rsh_name, Vars), " -env PATH \"", backslashify(lists:flatten([TestPath, path_separator(), @@ -505,15 +223,20 @@ make_command(Vars, Spec, State) -> %% uncomment the line below to disable exception formatting %% " -test_server_format_exception false", " -boot start_sasl -sasl errlog_type error", - " -s test_server_ctrl run_test ", State#state.test_server_args, + " -pz ",Cwd, + " -eval \"file:set_cwd(\\\"",TestDir,"\\\")\" " + " -eval \"ct:run_test(", + backslashify(lists:flatten(State#state.test_server_args)),")\"" " ", ExtraArgs], {ok, Vars, Spec, State#state{command=lists:flatten(Cmd)}}. + run_batch(Vars, _Spec, State) -> process_flag(trap_exit, true), Command = State#state.command ++ " -noinput -s erlang halt", ts_lib:progress(Vars, 1, "Command: ~s~n", [Command]), + io:format(user, "Command: ~s~n",[Command]), Port = open_port({spawn, Command}, [stream, in, eof]), tricky_print_data(Port). @@ -554,7 +277,7 @@ is_testnode_dead([{"test_server",_}|_]) -> false; is_testnode_dead([_|T]) -> is_testnode_dead(T). run_interactive(Vars, _Spec, State) -> - Command = State#state.command ++ " -s ts_reports make_index", + Command = State#state.command, ts_lib:progress(Vars, 1, "Command: ~s~n", [Command]), case ts_lib:var(os, Vars) of "Windows 95" -> @@ -604,77 +327,57 @@ path_separator() -> end. -make_test_server_args(Args0,Options,Vars) -> - Parameters = - case ts_lib:var(os, Vars) of - "VxWorks" -> - F = write_parameterfile(vxworks,Vars), - " PARAMETERS " ++ F; - _ -> - "" - end, +make_common_test_args(Args0, Options, _Vars) -> Trace = case lists:keysearch(trace,1,Options) of {value,{trace,TI}} when is_tuple(TI); is_tuple(hd(TI)) -> ok = file:write_file(?tracefile,io_lib:format("~p.~n",[TI])), - " TRACE " ++ ?tracefile; + [{ct_trace,?tracefile}]; {value,{trace,TIFile}} when is_atom(TIFile) -> - " TRACE " ++ atom_to_list(TIFile); + [{ct_trace,atom_to_list(TIFile)}]; {value,{trace,TIFile}} -> - " TRACE " ++ TIFile; + [{ct_trace,TIFile}]; false -> - "" + [] end, Cover = case lists:keysearch(cover,1,Options) of - {value,{cover,App,File,Analyse}} -> - " COVER " ++ to_list(App) ++ " " ++ to_list(File) ++ " " ++ - to_list(Analyse); + {value,{cover, App, none, _Analyse}} -> + io:format("No cover file found for ~p~n",[App]), + []; + {value,{cover,_App,File,_Analyse}} -> + [{cover,to_list(File)}]; false -> - "" - end, - TCCallback = - case ts_lib:var(ts_testcase_callback, Vars) of - "" -> - ""; - {Mod,Func} -> - io:format("Function ~w:~w/4 will be called before and " - "after each test case.\n", [Mod,Func]), - " TESTCASE_CALLBACK " ++ to_list(Mod) ++ " " ++ to_list(Func); - ModFunc when is_list(ModFunc) -> - [Mod,Func]=string:tokens(ModFunc," "), - io:format("Function ~s:~s/4 will be called before and " - "after each test case.\n", [Mod,Func]), - " TESTCASE_CALLBACK " ++ ModFunc; - _ -> - "" + [] end, - Args0 ++ Parameters ++ Trace ++ Cover ++ TCCallback. + + Logdir = case lists:keysearch(logdir, 1, Options) of + {value,{logdir, _}} -> + []; + false -> + [{logdir,"../test_server"}] + end, + + ConfigPath = case {os:getenv("TEST_CONFIG_PATH"), + lists:keysearch(config, 1, Options)} of + {false,{value, {config, Path}}} -> + Path; + {false,false} -> + "../test_server"; + {Path,_} -> + Path + end, + ConfigFiles = [{config,[filename:join(ConfigPath,File) + || File <- get_config_files()]}], + + io_lib:format("~100000p",[Args0++Trace++Cover++Logdir++ + ConfigFiles++Options]). to_list(X) when is_atom(X) -> atom_to_list(X); to_list(X) when is_list(X) -> X. -write_parameterfile(Type,Vars) -> - Cross_host = ts_lib:var(target_host, Vars), - SlaveTargets = case lists:keysearch(slavetargets,1,Vars) of - {value, ST} -> - [ST]; - _ -> - [] - end, - Master = case lists:keysearch(master,1,Vars) of - {value,M} -> [M]; - false -> [] - end, - ToWrite = [{type,Type}, - {target, list_to_atom(Cross_host)}] ++ SlaveTargets ++ Master, - - Crossfile = atom_to_list(Type) ++ "parameters" ++ os:getpid(), - ok = file:write_file(Crossfile,io_lib:format("~p.~n", [ToWrite])), - Crossfile. - %% %% Paths and spaces handling for w2k and XP %% @@ -720,53 +423,3 @@ split_one(Path) -> split_path(Path) -> string:tokens(Path,";"). - -%% -%% Run make:all/1 if the test suite seems to be designed -%% to be built/re-built by ts. -%% -make_all(Flags) -> - case filelib:is_regular("Emakefile") of - false -> - make_all_no_emakefile(Flags); - true -> - make:all(Flags) - end. - -make_all_no_emakefile(Flags) -> - case filelib:wildcard("*.beam") of - [] -> - %% Since there are no *.beam files, we will assume - %% that this test suite was designed to be built and - %% re-built by ts. Create an Emakefile so that - %% make:all/1 will be run the next time too - %% (in case a test suite is being interactively - %% developed). - create_emakefile(Flags, "*.erl"); - [_|_] -> - %% There is no Emakefile and there already are - %% some *.beam files here. Assume that this test - %% suite was not designed to be re-built by ts. - %% Only create a Emakefile that will compile - %% generated *_SUITE_make files (if any). - create_emakefile(Flags, "*_SUITE_make.erl") - end. - -create_emakefile(Flags, Wc) -> - case filelib:wildcard(Wc) of - [] -> - %% There are no files to be built (i.e. not even any - %% generated *_SUITE_make.erl files). We must handle - %% this case specially, because make:all/1 will crash - %% on Emakefile with an empty list of modules. - io:put_chars("No Emakefile found - not running make:all/1\n"), - up_to_date; - [_|_]=Ms0 -> - io:format("Creating an Emakefile for compiling files matching ~s\n", - [Wc]), - Ms = [list_to_atom(filename:rootname(M, ".erl")) || M <- Ms0], - Make0 = {Ms,Flags}, - Make = io_lib:format("~p. \n", [Make0]), - ok = file:write_file("Emakefile", Make), - make:all(Flags) - end. diff --git a/lib/test_server/test/Makefile b/lib/test_server/test/Makefile index fcb1282d16..0648c1f96a 100644 --- a/lib/test_server/test/Makefile +++ b/lib/test_server/test/Makefile @@ -27,11 +27,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES= \ test_server_SUITE \ test_server_line_SUITE \ - test_server_skip_SUITE \ - test_server_conf01_SUITE \ - test_server_conf02_SUITE \ - test_server_parallel01_SUITE \ - test_server_shuffle01_SUITE + test_server_test_lib ERL_FILES= $(MODULES:%=%.erl) @@ -52,6 +48,7 @@ RELSYSDIR = $(RELEASE_PATH)/test_server_test ERL_MAKE_FLAGS += -pa $(ERL_TOP)/lib/test_server/ebin ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/test EBIN = . @@ -88,7 +85,7 @@ release_spec: opt release_tests_spec: make_emakefile $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) $(COVERFILE) $(RELSYSDIR) - $(INSTALL_DATA) test_server.spec $(RELSYSDIR) + $(INSTALL_DATA) test_server.spec test_server.cover $(RELSYSDIR) chmod -f -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) diff --git a/lib/test_server/test/test_server.cover b/lib/test_server/test/test_server.cover index c2366db166..5c59bab494 100644 --- a/lib/test_server/test/test_server.cover +++ b/lib/test_server/test/test_server.cover @@ -1,20 +1,22 @@ -{exclude,[test_server, - test_server_ctrl, - ts_selftest]}. +{incl_app,test_server,details}. -%% Using include list here because the test_server might not find +{excl_mods, test_server, [test_server, + test_server_ctrl, + ts_selftest]}. + +%% Using incl_mods list here because the test_server might not find %% lib_dir for test_server - and so it will not find which modules to %% compile. -{include,[erl2html2, - test_server_node, - test_server_sup, - ts, - ts_autoconf_vxworks, - ts_autoconf_win32, - ts_erl_config, - ts_install, - ts_lib, - ts_make, - ts_run, - vxworks_client]}. +{incl_mods, test_server, [erl2html2, + test_server_node, + test_server_sup, + ts, + ts_autoconf_vxworks, + ts_autoconf_win32, + ts_erl_config, + ts_install, + ts_lib, + ts_make, + ts_run, + vxworks_client]}. diff --git a/lib/test_server/test/test_server.spec b/lib/test_server/test/test_server.spec index 23b0b71963..a3b4d01d08 100644 --- a/lib/test_server/test/test_server.spec +++ b/lib/test_server/test/test_server.spec @@ -1,2 +1 @@ -{topcase, {dir, "../test_server_test"}}. -{skip,{test_server_SUITE,skip_case7,"This case should be noted as `Skipped'"}}. +{suites, "../test_server_test", all}. diff --git a/lib/test_server/test/test_server_SUITE.erl b/lib/test_server/test/test_server_SUITE.erl index 0563e1104f..f4c19eeaf9 100644 --- a/lib/test_server/test/test_server_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% 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 @@ -16,539 +16,149 @@ %% %% %CopyrightEnd% %% - -%%%------------------------------------------------------------------ -%%% Test Server self test. -%%%------------------------------------------------------------------ +%%%------------------------------------------------------------------- +%%% @author Lukas Larsson <[email protected]> +%%% @copyright (C) 2011, Erlang Solutions Ltd. +%%% @doc +%%% +%%% @end +%%% Created : 15 Feb 2011 by Lukas Larsson <[email protected]> +%%%------------------------------------------------------------------- -module(test_server_SUITE). --include_lib("test_server/include/test_server.hrl"). --include_lib("test_server/include/test_server_line.hrl"). --include_lib("kernel/include/file.hrl"). --export([all/1]). --export([init_per_suite/1, end_per_suite/1]). --export([init_per_testcase/2, end_per_testcase/2, fin_per_testcase/2]). --export([config/1, comment/1, timetrap/1, timetrap_cancel/1, multiply_timetrap/1, - init_per_s/1, init_per_tc/1, end_per_tc/1, - timeconv/1, msgs/1, capture/1, timecall/1, - do_times/1, do_times_mfa/1, do_times_fun/1, - skip_cases/1, skip_case1/1, skip_case2/1, skip_case3/1, - skip_case4/1, skip_case5/1, skip_case6/1, skip_case7/1, - skip_case8/1, skip_case9/1, undefined_functions/1, - conf_init/1, check_new_conf/1, conf_cleanup/1, - check_old_conf/1, conf_init_fail/1, start_stop_node/1, - cleanup_nodes_init/1, check_survive_nodes/1, cleanup_nodes_fin/1, - commercial/1]). +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include("test_server_test_lib.hrl"). --export([dummy_function/0,dummy_function/1,doer/1]). +%%-------------------------------------------------------------------- +%% COMMON TEST CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- -all(doc) -> ["Test Server self test"]; -all(suite) -> - [config, comment, timetrap, timetrap_cancel, multiply_timetrap, - init_per_s, init_per_tc, end_per_tc, - timeconv, msgs, capture, timecall, do_times, skip_cases, - undefined_functions, commercial, - {conf, conf_init, [check_new_conf], conf_cleanup}, - check_old_conf, - {conf, conf_init_fail,[conf_member_skip],conf_cleanup_skip}, - start_stop_node, - {conf, cleanup_nodes_init,[check_survive_nodes],cleanup_nodes_fin}, - config - ]. +%% @spec suite() -> Info +suite() -> + [{ct_hooks,[ts_install_cth,test_server_test_lib]}]. +%% @spec init_per_suite(Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} init_per_suite(Config) -> - [{init_per_suite_var,ok}|Config]. + [{path_dirs,[proplists:get_value(data_dir,Config)]} | Config]. +%% @spec end_per_suite(Config) -> _ end_per_suite(_Config) -> - ok. - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:minutes(2)), - Config1 = [{watchdog, Dog}|Config], - case Func of - init_per_tc -> - [{strange_var, 1}|Config1]; - skip_case8 -> - {skipped, "This case should be noted as `Skipped'"}; - skip_case9 -> - {skip, "This case should be noted as `Skipped'"}; - _ -> - Config1 - end; -init_per_testcase(Func, Config) -> - io:format("Func:~p",[Func]), - io:format("Config:~p",[Config]), - ?t:fail("Arguments to init_per_testcase not correct"). - -end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - case Func of - end_per_tc -> io:format("CLEANUP => this test case is ok\n"); - _Other -> ok - end; -end_per_testcase(Func, Config) -> - io:format("Func:~p",[Func]), - io:format("Config:~p",[Config]), - ?t:fail("Arguments to end_per_testcase not correct"). - -fin_per_testcase(Func, Config) -> - io:format("Func:~p",[Func]), - io:format("Config:~p",[Config]), - ?t:fail("fin_per_testcase/2 called, should have called end_per_testcase/2"). + io:format("TEST_SERVER_FRAMEWORK: ~p",[os:getenv("TEST_SERVER_FRAMEWORK")]), + ok. + +%% @spec init_per_group(GroupName, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +init_per_group(_GroupName, Config) -> + Config. + +%% @spec end_per_group(GroupName, Config0) -> +%% void() | {save_config,Config1} +end_per_group(_GroupName, _Config) -> + ok. + +%% @spec init_per_testcase(TestCase, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +init_per_testcase(_TestCase, Config) -> + Config. + +%% @spec end_per_testcase(TestCase, Config0) -> +%% void() | {save_config,Config1} | {fail,Reason} +end_per_testcase(_TestCase, _Config) -> + ok. + +%% @spec: groups() -> [Group] +groups() -> + []. + +%% @spec all() -> GroupsAndTestCases | {skip,Reason} +all() -> + [test_server_SUITE, test_server_parallel01_SUITE, + test_server_conf02_SUITE, test_server_conf01_SUITE, + test_server_skip_SUITE, test_server_shuffle01_SUITE]. + + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- +%% @spec TestCase(Config0) -> +%% ok | exit() | {skip,Reason} | {comment,Comment} | +%% {save_config,Config1} | {skip_and_save,Reason,Config1} +test_server_SUITE(Config) -> +% rpc:call(Node,dbg, tracer,[]), +% rpc:call(Node,dbg, p,[all,c]), +% rpc:call(Node,dbg, tpl,[test_server_ctrl,x]), + run_test_server_tests("test_server_SUITE", 39, 1, 31, + 20, 9, 1, 11, 2, 26, Config). + +test_server_parallel01_SUITE(Config) -> + run_test_server_tests("test_server_parallel01_SUITE", 37, 0, 19, + 19, 0, 0, 0, 0, 37, Config). + +test_server_shuffle01_SUITE(Config) -> + run_test_server_tests("test_server_shuffle01_SUITE", 130, 0, 0, + 76, 0, 0, 0, 0, 130, Config). + +test_server_skip_SUITE(Config) -> + run_test_server_tests("test_server_skip_SUITE", 3, 0, 1, + 0, 0, 1, 3, 0, 0, Config). + +test_server_conf01_SUITE(Config) -> + run_test_server_tests("test_server_conf01_SUITE", 24, 0, 12, + 12, 0, 0, 0, 0, 24, Config). + +test_server_conf02_SUITE(Config) -> + run_test_server_tests("test_server_conf02_SUITE", 26, 0, 12, + 12, 0, 0, 0, 0, 26, Config). + + +run_test_server_tests(SuiteName, NCases, NFail, NExpected, NSucc, + NUsrSkip, NAutoSkip, + NActualSkip, NActualFail, NActualSucc, Config) -> + Node = proplists:get_value(node, Config), + {ok,_Pid} = rpc:call(Node,test_server_ctrl, start, []), + rpc:call(Node, + test_server_ctrl,add_dir_with_skip, + [SuiteName, + [proplists:get_value(data_dir,Config)],SuiteName, + [{test_server_SUITE,skip_case7,"SKIPPED!"}]]), + + until(fun() -> + rpc:call(Node,test_server_ctrl,jobs,[]) =:= [] + end), - -config(suite) -> []; -config(doc) -> ["Test that the Config variable is decent, ", - "and that the std config variables are correct ", - "(check that data/priv dir exists)." - "Also check that ?config macro works."]; -config(Config) when is_list(Config) -> - is_tuplelist(Config), - {value,{data_dir,Dd}}=lists:keysearch(data_dir,1,Config), - {value,{priv_dir,Dp}}=lists:keysearch(priv_dir,1,Config), - true=is_dir(Dd), - {ok, _Bin}=file:read_file(filename:join(Dd, "dummy_file")), - true=is_dir(Dp), - - Dd = ?config(data_dir,Config), - Dp = ?config(priv_dir,Config), - ok; -config(_Config) -> - ?t:fail("Config variable is not a list."). - -is_tuplelist([]) -> - true; -is_tuplelist([{_A,_B}|Rest]) -> - is_tuplelist(Rest); -is_tuplelist(_) -> - false. - -is_dir(Dir) -> - case file:read_file_info(Dir) of - {ok, #file_info{type=directory}} -> - true; - _ -> - false - end. - -comment(suite) -> []; -comment(doc) -> ["Print a comment in the HTML log"]; -comment(Config) when is_list(Config) -> - ?t:comment("This comment should not occur in the HTML log because a later" - " comment shall overwrite it"), - ?t:comment("This comment is printed with the comment/1 function." - " It should occur in the HTML log"). - - - -timetrap(suite) -> []; -timetrap(doc) -> ["Test that timetrap works."]; -timetrap(Config) when is_list(Config) -> - TrapAfter = 3000, - Dog=?t:timetrap(TrapAfter), - process_flag(trap_exit, true), - TimeOut = TrapAfter * test_server:timetrap_scale_factor() + 1000, - receive - {'EXIT', Dog, {timetrap_timeout, _, _}} -> - ok; - {'EXIT', _OtherPid, {timetrap_timeout, _, _}} -> - ?t:fail("EXIT signal from wrong process") - after - TimeOut -> - ?t:fail("Timetrap is not working.") - end, - ?t:timetrap_cancel(Dog), - ok. - - -timetrap_cancel(suite) -> []; -timetrap_cancel(doc) -> ["Test that timetrap_cancel works."]; -timetrap_cancel(Config) when is_list(Config) -> - Dog=?t:timetrap(1000), - receive - after - 500 -> - ok - end, - ?t:timetrap_cancel(Dog), - receive - after 1000 -> - ok - end, - ok. - -multiply_timetrap(suite) -> []; -multiply_timetrap(doc) -> ["Test multiply timetrap"]; -multiply_timetrap(Config) when is_list(Config) -> - %% This simulates the call to test_server_ctrl:multiply_timetraps/1: - put(test_server_multiply_timetraps,{2,true}), - - Dog = ?t:timetrap(500), - timer:sleep(800), - ?t:timetrap_cancel(Dog), - - %% Reset - put(test_server_multiply_timetraps,1), - ok. - - -init_per_s(suite) -> []; -init_per_s(doc) -> ["Test that a Config that is altered in ", - "init_per_suite gets through to the testcases."]; -init_per_s(Config) -> - %% Check that the config var sent from init_per_suite - %% really exists. - {value, {init_per_suite_var, ok}} = - lists:keysearch(init_per_suite_var,1,Config), - - %% Check that the other variables still exist. - {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config), - {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config), - ok. - -init_per_tc(suite) -> []; -init_per_tc(doc) -> ["Test that a Config that is altered in ", - "init_per_testcase gets through to the ", - "actual testcase."]; -init_per_tc(Config) -> - %% Check that the config var sent from init_per_testcase - %% really exists. - {value, {strange_var, 1}} = lists:keysearch(strange_var,1,Config), - - %% Check that the other variables still exist. - {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config), - {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config), - ok. - -end_per_tc(suite) -> []; -end_per_tc(doc) -> ["Test that end_per_testcase/2 is called even if" - " test case fails"]; -end_per_tc(Config) when is_list(Config) -> - ?t:fail("This case should fail! Check that \"CLEANUP\" is" - " printed in the minor log file."). - - -timeconv(suite) -> []; -timeconv(doc) -> ["Test that the time unit conversion functions ", - "works."]; -timeconv(Config) when is_list(Config) -> - Val=2, - Secs=Val*1000, - Mins=Secs*60, - Hrs=Mins*60, - Secs=?t:seconds(2), - Mins=?t:minutes(2), - Hrs=?t:hours(2), - ok. - - -msgs(suite) -> []; -msgs(doc) -> ["Tests the messages_get function."]; -msgs(Config) when is_list(Config) -> - self() ! {hej, du}, - self() ! {lite, "data"}, - self() ! en_atom, - [{hej, du}, {lite, "data"}, en_atom] = ?t:messages_get(), - ok. - -capture(suite) -> []; -capture(doc) -> ["Test that the capture functions work properly."]; -capture(Config) when is_list(Config) -> - String1="abcedfghjiklmnopqrstuvwxyz", - String2="0123456789", - ?t:capture_start(), - io:format(String1), - [String1]=?t:capture_get(), - io:format(String2), - [String2]=?t:capture_get(), - ?t:capture_stop(), - []=?t:capture_get(), - io:format(String2), - []=?t:capture_get(), - ok. - -timecall(suite) -> []; -timecall(doc) -> ["Tests that timed calls work."]; -timecall(Config) when is_list(Config) -> - {_Time1, liten_apa_e_oxo_farlig} = ?t:timecall(?MODULE, dummy_function, []), - {Time2, jag_ar_en_gorilla} = ?t:timecall(?MODULE, dummy_function, [gorilla]), - DTime=round(Time2), - if - DTime<1 -> - ?t:fail("Timecall reported a too low time."); - DTime==1 -> + rpc:call(Node,test_server_ctrl, stop, []), + {ok,#suite{ n_cases = NCases, + n_cases_failed = NFail, + n_cases_expected = NExpected, + n_cases_succ = NSucc, + n_cases_user_skip = NUsrSkip, + n_cases_auto_skip = NAutoSkip, + cases = Cases }} = Data = + test_server_test_lib:parse_suite( + hd(filelib:wildcard( + filename:join([proplists:get_value(priv_dir, Config), + SuiteName++".logs","run*","suite.log"])))), + {NActualSkip,NActualFail,NActualSucc} = + lists:foldl(fun(#tc{ result = skip },{S,F,Su}) -> + {S+1,F,Su}; + (#tc{ result = ok },{S,F,Su}) -> + {S,F,Su+1}; + (#tc{ result = failed },{S,F,Su}) -> + {S,F+1,Su} + end,{0,0,0},Cases), + Data. + +until(Fun) -> + case Fun() of + true -> ok; - DTime>1 -> - ?t:fail("Timecall reported a too high time.") - end, - ok. - -dummy_function() -> - liten_apa_e_oxo_farlig. -dummy_function(gorilla) -> - receive after 1000 -> ok end, - jag_ar_en_gorilla. - - -do_times(suite) -> [do_times_mfa, do_times_fun]; -do_times(doc) -> ["Test the do_times function."]. - -do_times_mfa(suite) -> []; -do_times_mfa(doc) -> ["Test the do_times function with M,F,A given."]; -do_times_mfa(Config) when is_list(Config) -> - ?t:do_times(100, ?MODULE, doer, [self()]), - 100=length(?t:messages_get()), - ok. - -do_times_fun(suite) -> []; -do_times_fun(doc) -> ["Test the do_times function with fun given."]; -do_times_fun(Config) when is_list(Config) -> - Self = self(), - ?t:do_times(100, fun() -> doer(Self) end), - 100=length(?t:messages_get()), - ok. - -doer(From) -> - From ! a, - ok. - -skip_cases(doc) -> ["Test all possible ways to skip a test case."]; -skip_cases(suite) -> [skip_case1, skip_case2, skip_case3, skip_case4, - skip_case5, skip_case6, skip_case7, skip_case8, - skip_case9]. - -skip_case1(suite) -> []; -skip_case1(doc) -> ["Test that you can return {skipped, Reason}," - " and that Reason is in the comment field in the HTML log"]; -skip_case1(Config) when is_list(Config) -> - %% If this comment shows, the case failed!! - ?t:comment("ERROR: This case should have been noted as `Skipped'"), - %% The Reason in {skipped, Reason} should overwrite a 'comment' - {skipped, "This case should be noted as `Skipped'"}. - -skip_case2(suite) -> []; -skip_case2(doc) -> ["Test that you can return {skipped, Reason}," - " and that Reason is in the comment field in the HTML log"]; -skip_case2(Config) when is_list(Config) -> - %% If this comment shows, the case failed!! - ?t:comment("ERROR: This case should have been noted as `Skipped'"), - %% The Reason in {skipped, Reason} should overwrite a 'comment' - exit({skipped, "This case should be noted as `Skipped'"}). - -skip_case3(suite) -> []; -skip_case3(doc) -> ["Test that you can return {skip, Reason}," - " and that Reason is in the comment field in the HTML log"]; -skip_case3(Config) when is_list(Config) -> - %% If this comment shows, the case failed!! - ?t:comment("ERROR: This case should have been noted as `Skipped'"), - %% The Reason in {skip, Reason} should overwrite a 'comment' - {skip, "This case should be noted as `Skipped'"}. - -skip_case4(suite) -> []; -skip_case4(doc) -> ["Test that you can return {skip, Reason}," - " and that Reason is in the comment field in the HTML log"]; -skip_case4(Config) when is_list(Config) -> - %% If this comment shows, the case failed!! - ?t:comment("ERROR: This case should have been noted as `Skipped'"), - %% The Reason in {skip, Reason} should overwrite a 'comment' - exit({skip, "This case should be noted as `Skipped'"}). - -skip_case5(suite) -> {skipped, "This case should be noted as `Skipped'"}; -skip_case5(doc) -> ["Test that you can return {skipped, Reason}" - " from the specification clause"]. - -skip_case6(suite) -> {skip, "This case should be noted as `Skipped'"}; -skip_case6(doc) -> ["Test that you can return {skip, Reason}" - " from the specification clause"]. - -skip_case7(suite) -> []; -skip_case7(doc) -> ["Test that skip works from a test specification file"]; -skip_case7(Config) when is_list(Config) -> - %% This case shall be skipped by adding - %% {skip, {test_server_SUITE, skip_case7, Reason}}. - %% to the test specification file. - ?t:fail("This case should have been Skipped by the .spec file"). - -skip_case8(suite) -> []; -skip_case8(doc) -> ["Test that {skipped, Reason} works from" - " init_per_testcase/2"]; -skip_case8(Config) when is_list(Config) -> - %% This case shall be skipped by adding a specific clause to - %% returning {skipped, Reason} from init_per_testcase/2 for this case. - ?t:fail("This case should have been Skipped by init_per_testcase/2"). - -skip_case9(suite) -> []; -skip_case9(doc) -> ["Test that {skip, Reason} works from a init_per_testcase/2"]; -skip_case9(Config) when is_list(Config) -> - %% This case shall be skipped by adding a specific clause to - %% returning {skip, Reason} from init_per_testcase/2 for this case. - ?t:fail("This case should have been Skipped by init_per_testcase/2"). - -undefined_functions(suite) -> []; -undefined_functions(doc) -> ["Check for calls to undefined functions in" - " test_server." - "Skip if cover is running"]; -undefined_functions(Config) when is_list(Config) -> - case whereis(cover_server) of - Pid when is_pid(Pid) -> - {skip,"Cover is running"}; - undefined -> - undefined_functions() - end. - -undefined_functions() -> - TestServerDir = filename:dirname(code:which(test_server)), - Res = xref:d(TestServerDir), - - {value,{unused,Unused}} = lists:keysearch(unused, 1, Res), - case Unused of - [] -> ok; - _ -> - lists:foreach(fun (MFA) -> - io:format("~s unused", [format_mfa(MFA)]) - end, Unused) - end, - - {value,{undefined,Undef0}} = lists:keysearch(undefined, 1, Res), - Undef = [U || U <- Undef0, not unresolved(U)], - case Undef of - [] -> ok; - _ -> - lists:foreach(fun ({MFA1,MFA2}) -> - io:format("~s calls undefined ~s", - [format_mfa(MFA1),format_mfa(MFA2)]) - end, Undef), - ?t:fail({length(Undef),undefined_functions_in_otp}) - end, - ok. - -unresolved({_,{_,'$F_EXPR',_}}) -> true; -unresolved(_) -> false. - -format_mfa({M,F,A}) -> - lists:flatten(io_lib:format("~s:~s/~p", [M,F,A])). - -conf_init(doc) -> ["Test successful conf case: Change Config parameter"]; -conf_init(Config) when is_list(Config) -> - [{conf_init_var,1389}|Config]. - -check_new_conf(suite) -> []; -check_new_conf(doc) -> ["Check that Config parameter changed by" - " conf_init is used"]; -check_new_conf(Config) when is_list(Config) -> - 1389 = ?config(conf_init_var,Config), - ok. - -conf_cleanup(doc) -> ["Test successful conf case: Restore Config parameter"]; -conf_cleanup(Config) when is_list(Config) -> - lists:keydelete(conf_init_var,1,Config). - -check_old_conf(suite) -> []; -check_old_conf(doc) -> ["Test that the restored Config is used after a" - " conf cleanup"]; -check_old_conf(Config) when is_list(Config) -> - undefined = ?config(conf_init_var,Config), - ok. - -conf_init_fail(doc) -> ["Test that config members are skipped if" - " conf init function fails."]; -conf_init_fail(Config) when is_list(Config) -> - ?t:fail("This case should fail! Check that conf_member_skip and" - " conf_cleanup_skip are skipped."). - - - -start_stop_node(suite) -> []; -start_stop_node(doc) -> ["Test start and stop of slave and peer nodes"]; -start_stop_node(Config) when is_list(Config) -> - {ok,Node2} = ?t:start_node(node2,peer,[]), - {error, _} = ?t:start_node(node2,peer,[{fail_on_error,false}]), - true = lists:member(Node2,nodes()), - - {ok,Node3} = ?t:start_node(node3,slave,[]), - {error, _} = ?t:start_node(node3,slave,[]), - true = lists:member(Node3,nodes()), - - {ok,Node4} = ?t:start_node(node4,peer,[{wait,false}]), - case lists:member(Node4,nodes()) of - true -> - ?t:comment("WARNING: Node started with {wait,false}" - " is up faster than expected..."); false -> - wait_for_node(Node4,0), - true = lists:member(Node4,nodes()) - end, - - true = ?t:stop_node(Node2), - false = lists:member(Node2,nodes()), - - true = ?t:stop_node(Node3), - false = lists:member(Node3,nodes()), - - true = ?t:stop_node(Node4), - false = lists:member(Node4,nodes()), - timer:sleep(2000), - false = ?t:stop_node(Node4), - - ok. - - -wait_for_node(Node,Acc) -> - case net_adm:ping(Node) of - pang -> timer:sleep(100), - wait_for_node(Node,Acc+100); - pong -> - Acc + until(Fun) end. - -cleanup_nodes_init(doc) -> ["Test that nodes are terminated when test case" - " is finished unless {cleanup,false} is given."]; -cleanup_nodes_init(Config) when is_list(Config) -> - {ok,DieSlave} = ?t:start_node(die_slave, slave, []), - {ok,SurviveSlave} = ?t:start_node(survive_slave, slave, [{cleanup,false}]), - {ok,DiePeer} = ?t:start_node(die_peer, peer, []), - {ok,SurvivePeer} = ?t:start_node(survive_peer, peer, [{cleanup,false}]), - [{die_slave,DieSlave}, - {survive_slave,SurviveSlave}, - {die_peer,DiePeer}, - {survive_peer,SurvivePeer} | Config]. - - - -check_survive_nodes(suite) -> []; -check_survive_nodes(doc) -> ["Test that nodes with {cleanup,false} survived"]; -check_survive_nodes(Config) when is_list(Config) -> - timer:sleep(1000), - false = lists:member(?config(die_slave,Config),nodes()), - true = lists:member(?config(survive_slave,Config),nodes()), - false = lists:member(?config(die_peer,Config),nodes()), - true = lists:member(?config(survive_peer,Config),nodes()), - ok. - - -cleanup_nodes_fin(doc) -> ["Test that nodes started with {cleanup,false}" - " can be stopped"]; -cleanup_nodes_fin(Config) when is_list(Config) -> - Slave = ?config(survive_slave,Config), - Peer = ?config(survive_peer,Config), - - true = ?t:stop_node(Slave), - false = lists:member(Slave,nodes()), - true = ?t:stop_node(Peer), - false = lists:member(Peer,nodes()), - - C1 = lists:keydelete(die_slave,1,Config), - C2 = lists:keydelete(survive_slave,1,C1), - C3 = lists:keydelete(die_peer,1,C2), - lists:keydelete(survive_peer,1,C3). - -commercial(Config) when is_list(Config) -> - case ?t:is_commercial() of - false -> {comment,"Open-source build"}; - true -> {comment,"Commercial build"} - end. - - + diff --git a/lib/test_server/test/test_server_SUITE_data/Makefile.src b/lib/test_server/test/test_server_SUITE_data/Makefile.src new file mode 100644 index 0000000000..d5af919eec --- /dev/null +++ b/lib/test_server/test/test_server_SUITE_data/Makefile.src @@ -0,0 +1,2 @@ +all: + erlc *.erl
\ No newline at end of file diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl new file mode 100644 index 0000000000..0563e1104f --- /dev/null +++ b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl @@ -0,0 +1,554 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%% + +%%%------------------------------------------------------------------ +%%% Test Server self test. +%%%------------------------------------------------------------------ +-module(test_server_SUITE). +-include_lib("test_server/include/test_server.hrl"). +-include_lib("test_server/include/test_server_line.hrl"). +-include_lib("kernel/include/file.hrl"). +-export([all/1]). + +-export([init_per_suite/1, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2, fin_per_testcase/2]). +-export([config/1, comment/1, timetrap/1, timetrap_cancel/1, multiply_timetrap/1, + init_per_s/1, init_per_tc/1, end_per_tc/1, + timeconv/1, msgs/1, capture/1, timecall/1, + do_times/1, do_times_mfa/1, do_times_fun/1, + skip_cases/1, skip_case1/1, skip_case2/1, skip_case3/1, + skip_case4/1, skip_case5/1, skip_case6/1, skip_case7/1, + skip_case8/1, skip_case9/1, undefined_functions/1, + conf_init/1, check_new_conf/1, conf_cleanup/1, + check_old_conf/1, conf_init_fail/1, start_stop_node/1, + cleanup_nodes_init/1, check_survive_nodes/1, cleanup_nodes_fin/1, + commercial/1]). + +-export([dummy_function/0,dummy_function/1,doer/1]). + +all(doc) -> ["Test Server self test"]; +all(suite) -> + [config, comment, timetrap, timetrap_cancel, multiply_timetrap, + init_per_s, init_per_tc, end_per_tc, + timeconv, msgs, capture, timecall, do_times, skip_cases, + undefined_functions, commercial, + {conf, conf_init, [check_new_conf], conf_cleanup}, + check_old_conf, + {conf, conf_init_fail,[conf_member_skip],conf_cleanup_skip}, + start_stop_node, + {conf, cleanup_nodes_init,[check_survive_nodes],cleanup_nodes_fin}, + config + ]. + + +init_per_suite(Config) -> + [{init_per_suite_var,ok}|Config]. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog = ?t:timetrap(?t:minutes(2)), + Config1 = [{watchdog, Dog}|Config], + case Func of + init_per_tc -> + [{strange_var, 1}|Config1]; + skip_case8 -> + {skipped, "This case should be noted as `Skipped'"}; + skip_case9 -> + {skip, "This case should be noted as `Skipped'"}; + _ -> + Config1 + end; +init_per_testcase(Func, Config) -> + io:format("Func:~p",[Func]), + io:format("Config:~p",[Config]), + ?t:fail("Arguments to init_per_testcase not correct"). + +end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + case Func of + end_per_tc -> io:format("CLEANUP => this test case is ok\n"); + _Other -> ok + end; +end_per_testcase(Func, Config) -> + io:format("Func:~p",[Func]), + io:format("Config:~p",[Config]), + ?t:fail("Arguments to end_per_testcase not correct"). + +fin_per_testcase(Func, Config) -> + io:format("Func:~p",[Func]), + io:format("Config:~p",[Config]), + ?t:fail("fin_per_testcase/2 called, should have called end_per_testcase/2"). + + +config(suite) -> []; +config(doc) -> ["Test that the Config variable is decent, ", + "and that the std config variables are correct ", + "(check that data/priv dir exists)." + "Also check that ?config macro works."]; +config(Config) when is_list(Config) -> + is_tuplelist(Config), + {value,{data_dir,Dd}}=lists:keysearch(data_dir,1,Config), + {value,{priv_dir,Dp}}=lists:keysearch(priv_dir,1,Config), + true=is_dir(Dd), + {ok, _Bin}=file:read_file(filename:join(Dd, "dummy_file")), + true=is_dir(Dp), + + Dd = ?config(data_dir,Config), + Dp = ?config(priv_dir,Config), + ok; +config(_Config) -> + ?t:fail("Config variable is not a list."). + +is_tuplelist([]) -> + true; +is_tuplelist([{_A,_B}|Rest]) -> + is_tuplelist(Rest); +is_tuplelist(_) -> + false. + +is_dir(Dir) -> + case file:read_file_info(Dir) of + {ok, #file_info{type=directory}} -> + true; + _ -> + false + end. + +comment(suite) -> []; +comment(doc) -> ["Print a comment in the HTML log"]; +comment(Config) when is_list(Config) -> + ?t:comment("This comment should not occur in the HTML log because a later" + " comment shall overwrite it"), + ?t:comment("This comment is printed with the comment/1 function." + " It should occur in the HTML log"). + + + +timetrap(suite) -> []; +timetrap(doc) -> ["Test that timetrap works."]; +timetrap(Config) when is_list(Config) -> + TrapAfter = 3000, + Dog=?t:timetrap(TrapAfter), + process_flag(trap_exit, true), + TimeOut = TrapAfter * test_server:timetrap_scale_factor() + 1000, + receive + {'EXIT', Dog, {timetrap_timeout, _, _}} -> + ok; + {'EXIT', _OtherPid, {timetrap_timeout, _, _}} -> + ?t:fail("EXIT signal from wrong process") + after + TimeOut -> + ?t:fail("Timetrap is not working.") + end, + ?t:timetrap_cancel(Dog), + ok. + + +timetrap_cancel(suite) -> []; +timetrap_cancel(doc) -> ["Test that timetrap_cancel works."]; +timetrap_cancel(Config) when is_list(Config) -> + Dog=?t:timetrap(1000), + receive + after + 500 -> + ok + end, + ?t:timetrap_cancel(Dog), + receive + after 1000 -> + ok + end, + ok. + +multiply_timetrap(suite) -> []; +multiply_timetrap(doc) -> ["Test multiply timetrap"]; +multiply_timetrap(Config) when is_list(Config) -> + %% This simulates the call to test_server_ctrl:multiply_timetraps/1: + put(test_server_multiply_timetraps,{2,true}), + + Dog = ?t:timetrap(500), + timer:sleep(800), + ?t:timetrap_cancel(Dog), + + %% Reset + put(test_server_multiply_timetraps,1), + ok. + + +init_per_s(suite) -> []; +init_per_s(doc) -> ["Test that a Config that is altered in ", + "init_per_suite gets through to the testcases."]; +init_per_s(Config) -> + %% Check that the config var sent from init_per_suite + %% really exists. + {value, {init_per_suite_var, ok}} = + lists:keysearch(init_per_suite_var,1,Config), + + %% Check that the other variables still exist. + {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config), + {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config), + ok. + +init_per_tc(suite) -> []; +init_per_tc(doc) -> ["Test that a Config that is altered in ", + "init_per_testcase gets through to the ", + "actual testcase."]; +init_per_tc(Config) -> + %% Check that the config var sent from init_per_testcase + %% really exists. + {value, {strange_var, 1}} = lists:keysearch(strange_var,1,Config), + + %% Check that the other variables still exist. + {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config), + {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config), + ok. + +end_per_tc(suite) -> []; +end_per_tc(doc) -> ["Test that end_per_testcase/2 is called even if" + " test case fails"]; +end_per_tc(Config) when is_list(Config) -> + ?t:fail("This case should fail! Check that \"CLEANUP\" is" + " printed in the minor log file."). + + +timeconv(suite) -> []; +timeconv(doc) -> ["Test that the time unit conversion functions ", + "works."]; +timeconv(Config) when is_list(Config) -> + Val=2, + Secs=Val*1000, + Mins=Secs*60, + Hrs=Mins*60, + Secs=?t:seconds(2), + Mins=?t:minutes(2), + Hrs=?t:hours(2), + ok. + + +msgs(suite) -> []; +msgs(doc) -> ["Tests the messages_get function."]; +msgs(Config) when is_list(Config) -> + self() ! {hej, du}, + self() ! {lite, "data"}, + self() ! en_atom, + [{hej, du}, {lite, "data"}, en_atom] = ?t:messages_get(), + ok. + +capture(suite) -> []; +capture(doc) -> ["Test that the capture functions work properly."]; +capture(Config) when is_list(Config) -> + String1="abcedfghjiklmnopqrstuvwxyz", + String2="0123456789", + ?t:capture_start(), + io:format(String1), + [String1]=?t:capture_get(), + io:format(String2), + [String2]=?t:capture_get(), + ?t:capture_stop(), + []=?t:capture_get(), + io:format(String2), + []=?t:capture_get(), + ok. + +timecall(suite) -> []; +timecall(doc) -> ["Tests that timed calls work."]; +timecall(Config) when is_list(Config) -> + {_Time1, liten_apa_e_oxo_farlig} = ?t:timecall(?MODULE, dummy_function, []), + {Time2, jag_ar_en_gorilla} = ?t:timecall(?MODULE, dummy_function, [gorilla]), + DTime=round(Time2), + if + DTime<1 -> + ?t:fail("Timecall reported a too low time."); + DTime==1 -> + ok; + DTime>1 -> + ?t:fail("Timecall reported a too high time.") + end, + ok. + +dummy_function() -> + liten_apa_e_oxo_farlig. +dummy_function(gorilla) -> + receive after 1000 -> ok end, + jag_ar_en_gorilla. + + +do_times(suite) -> [do_times_mfa, do_times_fun]; +do_times(doc) -> ["Test the do_times function."]. + +do_times_mfa(suite) -> []; +do_times_mfa(doc) -> ["Test the do_times function with M,F,A given."]; +do_times_mfa(Config) when is_list(Config) -> + ?t:do_times(100, ?MODULE, doer, [self()]), + 100=length(?t:messages_get()), + ok. + +do_times_fun(suite) -> []; +do_times_fun(doc) -> ["Test the do_times function with fun given."]; +do_times_fun(Config) when is_list(Config) -> + Self = self(), + ?t:do_times(100, fun() -> doer(Self) end), + 100=length(?t:messages_get()), + ok. + +doer(From) -> + From ! a, + ok. + +skip_cases(doc) -> ["Test all possible ways to skip a test case."]; +skip_cases(suite) -> [skip_case1, skip_case2, skip_case3, skip_case4, + skip_case5, skip_case6, skip_case7, skip_case8, + skip_case9]. + +skip_case1(suite) -> []; +skip_case1(doc) -> ["Test that you can return {skipped, Reason}," + " and that Reason is in the comment field in the HTML log"]; +skip_case1(Config) when is_list(Config) -> + %% If this comment shows, the case failed!! + ?t:comment("ERROR: This case should have been noted as `Skipped'"), + %% The Reason in {skipped, Reason} should overwrite a 'comment' + {skipped, "This case should be noted as `Skipped'"}. + +skip_case2(suite) -> []; +skip_case2(doc) -> ["Test that you can return {skipped, Reason}," + " and that Reason is in the comment field in the HTML log"]; +skip_case2(Config) when is_list(Config) -> + %% If this comment shows, the case failed!! + ?t:comment("ERROR: This case should have been noted as `Skipped'"), + %% The Reason in {skipped, Reason} should overwrite a 'comment' + exit({skipped, "This case should be noted as `Skipped'"}). + +skip_case3(suite) -> []; +skip_case3(doc) -> ["Test that you can return {skip, Reason}," + " and that Reason is in the comment field in the HTML log"]; +skip_case3(Config) when is_list(Config) -> + %% If this comment shows, the case failed!! + ?t:comment("ERROR: This case should have been noted as `Skipped'"), + %% The Reason in {skip, Reason} should overwrite a 'comment' + {skip, "This case should be noted as `Skipped'"}. + +skip_case4(suite) -> []; +skip_case4(doc) -> ["Test that you can return {skip, Reason}," + " and that Reason is in the comment field in the HTML log"]; +skip_case4(Config) when is_list(Config) -> + %% If this comment shows, the case failed!! + ?t:comment("ERROR: This case should have been noted as `Skipped'"), + %% The Reason in {skip, Reason} should overwrite a 'comment' + exit({skip, "This case should be noted as `Skipped'"}). + +skip_case5(suite) -> {skipped, "This case should be noted as `Skipped'"}; +skip_case5(doc) -> ["Test that you can return {skipped, Reason}" + " from the specification clause"]. + +skip_case6(suite) -> {skip, "This case should be noted as `Skipped'"}; +skip_case6(doc) -> ["Test that you can return {skip, Reason}" + " from the specification clause"]. + +skip_case7(suite) -> []; +skip_case7(doc) -> ["Test that skip works from a test specification file"]; +skip_case7(Config) when is_list(Config) -> + %% This case shall be skipped by adding + %% {skip, {test_server_SUITE, skip_case7, Reason}}. + %% to the test specification file. + ?t:fail("This case should have been Skipped by the .spec file"). + +skip_case8(suite) -> []; +skip_case8(doc) -> ["Test that {skipped, Reason} works from" + " init_per_testcase/2"]; +skip_case8(Config) when is_list(Config) -> + %% This case shall be skipped by adding a specific clause to + %% returning {skipped, Reason} from init_per_testcase/2 for this case. + ?t:fail("This case should have been Skipped by init_per_testcase/2"). + +skip_case9(suite) -> []; +skip_case9(doc) -> ["Test that {skip, Reason} works from a init_per_testcase/2"]; +skip_case9(Config) when is_list(Config) -> + %% This case shall be skipped by adding a specific clause to + %% returning {skip, Reason} from init_per_testcase/2 for this case. + ?t:fail("This case should have been Skipped by init_per_testcase/2"). + +undefined_functions(suite) -> []; +undefined_functions(doc) -> ["Check for calls to undefined functions in" + " test_server." + "Skip if cover is running"]; +undefined_functions(Config) when is_list(Config) -> + case whereis(cover_server) of + Pid when is_pid(Pid) -> + {skip,"Cover is running"}; + undefined -> + undefined_functions() + end. + +undefined_functions() -> + TestServerDir = filename:dirname(code:which(test_server)), + Res = xref:d(TestServerDir), + + {value,{unused,Unused}} = lists:keysearch(unused, 1, Res), + case Unused of + [] -> ok; + _ -> + lists:foreach(fun (MFA) -> + io:format("~s unused", [format_mfa(MFA)]) + end, Unused) + end, + + {value,{undefined,Undef0}} = lists:keysearch(undefined, 1, Res), + Undef = [U || U <- Undef0, not unresolved(U)], + case Undef of + [] -> ok; + _ -> + lists:foreach(fun ({MFA1,MFA2}) -> + io:format("~s calls undefined ~s", + [format_mfa(MFA1),format_mfa(MFA2)]) + end, Undef), + ?t:fail({length(Undef),undefined_functions_in_otp}) + end, + ok. + +unresolved({_,{_,'$F_EXPR',_}}) -> true; +unresolved(_) -> false. + +format_mfa({M,F,A}) -> + lists:flatten(io_lib:format("~s:~s/~p", [M,F,A])). + +conf_init(doc) -> ["Test successful conf case: Change Config parameter"]; +conf_init(Config) when is_list(Config) -> + [{conf_init_var,1389}|Config]. + +check_new_conf(suite) -> []; +check_new_conf(doc) -> ["Check that Config parameter changed by" + " conf_init is used"]; +check_new_conf(Config) when is_list(Config) -> + 1389 = ?config(conf_init_var,Config), + ok. + +conf_cleanup(doc) -> ["Test successful conf case: Restore Config parameter"]; +conf_cleanup(Config) when is_list(Config) -> + lists:keydelete(conf_init_var,1,Config). + +check_old_conf(suite) -> []; +check_old_conf(doc) -> ["Test that the restored Config is used after a" + " conf cleanup"]; +check_old_conf(Config) when is_list(Config) -> + undefined = ?config(conf_init_var,Config), + ok. + +conf_init_fail(doc) -> ["Test that config members are skipped if" + " conf init function fails."]; +conf_init_fail(Config) when is_list(Config) -> + ?t:fail("This case should fail! Check that conf_member_skip and" + " conf_cleanup_skip are skipped."). + + + +start_stop_node(suite) -> []; +start_stop_node(doc) -> ["Test start and stop of slave and peer nodes"]; +start_stop_node(Config) when is_list(Config) -> + {ok,Node2} = ?t:start_node(node2,peer,[]), + {error, _} = ?t:start_node(node2,peer,[{fail_on_error,false}]), + true = lists:member(Node2,nodes()), + + {ok,Node3} = ?t:start_node(node3,slave,[]), + {error, _} = ?t:start_node(node3,slave,[]), + true = lists:member(Node3,nodes()), + + {ok,Node4} = ?t:start_node(node4,peer,[{wait,false}]), + case lists:member(Node4,nodes()) of + true -> + ?t:comment("WARNING: Node started with {wait,false}" + " is up faster than expected..."); + false -> + wait_for_node(Node4,0), + true = lists:member(Node4,nodes()) + end, + + true = ?t:stop_node(Node2), + false = lists:member(Node2,nodes()), + + true = ?t:stop_node(Node3), + false = lists:member(Node3,nodes()), + + true = ?t:stop_node(Node4), + false = lists:member(Node4,nodes()), + timer:sleep(2000), + false = ?t:stop_node(Node4), + + ok. + + +wait_for_node(Node,Acc) -> + case net_adm:ping(Node) of + pang -> + timer:sleep(100), + wait_for_node(Node,Acc+100); + pong -> + Acc + end. + +cleanup_nodes_init(doc) -> ["Test that nodes are terminated when test case" + " is finished unless {cleanup,false} is given."]; +cleanup_nodes_init(Config) when is_list(Config) -> + {ok,DieSlave} = ?t:start_node(die_slave, slave, []), + {ok,SurviveSlave} = ?t:start_node(survive_slave, slave, [{cleanup,false}]), + {ok,DiePeer} = ?t:start_node(die_peer, peer, []), + {ok,SurvivePeer} = ?t:start_node(survive_peer, peer, [{cleanup,false}]), + [{die_slave,DieSlave}, + {survive_slave,SurviveSlave}, + {die_peer,DiePeer}, + {survive_peer,SurvivePeer} | Config]. + + + +check_survive_nodes(suite) -> []; +check_survive_nodes(doc) -> ["Test that nodes with {cleanup,false} survived"]; +check_survive_nodes(Config) when is_list(Config) -> + timer:sleep(1000), + false = lists:member(?config(die_slave,Config),nodes()), + true = lists:member(?config(survive_slave,Config),nodes()), + false = lists:member(?config(die_peer,Config),nodes()), + true = lists:member(?config(survive_peer,Config),nodes()), + ok. + + +cleanup_nodes_fin(doc) -> ["Test that nodes started with {cleanup,false}" + " can be stopped"]; +cleanup_nodes_fin(Config) when is_list(Config) -> + Slave = ?config(survive_slave,Config), + Peer = ?config(survive_peer,Config), + + true = ?t:stop_node(Slave), + false = lists:member(Slave,nodes()), + true = ?t:stop_node(Peer), + false = lists:member(Peer,nodes()), + + C1 = lists:keydelete(die_slave,1,Config), + C2 = lists:keydelete(survive_slave,1,C1), + C3 = lists:keydelete(die_peer,1,C2), + lists:keydelete(survive_peer,1,C3). + +commercial(Config) when is_list(Config) -> + case ?t:is_commercial() of + false -> {comment,"Open-source build"}; + true -> {comment,"Commercial build"} + end. + + diff --git a/lib/test_server/test/test_server_SUITE_data/dummy_file b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file index 65c88fbd75..65c88fbd75 100644 --- a/lib/test_server/test/test_server_SUITE_data/dummy_file +++ b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file diff --git a/lib/test_server/test/test_server_conf01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl index a6d7dfe851..a6d7dfe851 100644 --- a/lib/test_server/test/test_server_conf01_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl diff --git a/lib/test_server/test/test_server_conf02_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl index deba4660c6..deba4660c6 100644 --- a/lib/test_server/test/test_server_conf02_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl diff --git a/lib/test_server/test/test_server_parallel01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl index 0e7f329f89..0e7f329f89 100644 --- a/lib/test_server/test/test_server_parallel01_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl diff --git a/lib/test_server/test/test_server_shuffle01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl index 7ad269501d..7ad269501d 100644 --- a/lib/test_server/test/test_server_shuffle01_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl diff --git a/lib/test_server/test/test_server_skip_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl index 4037e1cc0e..4037e1cc0e 100644 --- a/lib/test_server/test/test_server_skip_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl diff --git a/lib/test_server/test/test_server_line_SUITE.erl b/lib/test_server/test/test_server_line_SUITE.erl index 02897f164f..aa14862e5a 100644 --- a/lib/test_server/test/test_server_line_SUITE.erl +++ b/lib/test_server/test/test_server_line_SUITE.erl @@ -23,20 +23,29 @@ -module(test_server_line_SUITE). -include_lib("test_server/include/test_server.hrl"). --export([all/1]). --export([init_per_testcase/2, fin_per_testcase/2]). +-export([all/0,suite/0]). +-export([init_per_suite/1,end_per_suite/1, + init_per_testcase/2, end_per_testcase/2]). -export([parse_transform/1, lines/1]). -all(doc) -> ["Test of parse transform for collection line numbers"]; -all(suite) -> [parse_transform,lines]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {doc,["Test of parse transform for collection line numbers"]}]. +all() -> [parse_transform,lines]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. init_per_testcase(_Case, Config) -> ?line test_server_line:clear(), Dog = ?t:timetrap(?t:minutes(2)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> ?line test_server_line:clear(), Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog), diff --git a/lib/test_server/test/test_server_test_lib.erl b/lib/test_server/test/test_server_test_lib.erl new file mode 100644 index 0000000000..66ff06e0ce --- /dev/null +++ b/lib/test_server/test/test_server_test_lib.erl @@ -0,0 +1,191 @@ +%% +%% %CopyrightBegin% +%% +%% 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% +%% +-module(test_server_test_lib). +-export([parse_suite/1]). +-export([init/2, pre_init_per_testcase/3, post_end_per_testcase/4]). + +-include("test_server_test_lib.hrl"). + +%% The CTH hooks all tests +init(_Id, _Opts) -> + []. + +pre_init_per_testcase(_TC,Config,State) -> + case os:type() of + {win32, _} -> + %% Extend timeout for windows as starting node + %% can take a long time there + test_server:timetrap( 120000 * test_server:timetrap_scale_factor()); + _ -> + ok + end, + {start_slave(Config, 50),State}. + +start_slave(Config,_Level) -> + [_,Host] = string:tokens(atom_to_list(node()), "@"), + + ct:log("Trying to start ~s~n", + ["test_server_tester@"++Host]), + case slave:start(Host, test_server_tester, []) of + {error,Reason} -> + test_server:fail(Reason); + {ok,Node} -> + ct:log("Node ~p started~n", [Node]), + IsCover = test_server:is_cover(), + if IsCover -> + cover:start(Node); + true-> + ok + end, + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + + %% PrivDir as well as directory of Test Server suites + %% have to be in code path on Test Server node. + [_ | Parts] = lists:reverse(filename:split(DataDir)), + TSDir = filename:join(lists:reverse(Parts)), + AddPathDirs = case proplists:get_value(path_dirs, Config) of + undefined -> []; + Ds -> Ds + end, + PathDirs = [PrivDir,TSDir | AddPathDirs], + [true = rpc:call(Node, code, add_patha, [D]) || D <- PathDirs], + io:format("Dirs added to code path (on ~w):~n", + [Node]), + [io:format("~s~n", [D]) || D <- PathDirs], + + true = rpc:call(Node, os, putenv, + ["TEST_SERVER_FRAMEWORK", "undefined"]), + + ok = rpc:call(Node, file, set_cwd, [PrivDir]), + [{node,Node} | Config] + end. + +post_end_per_testcase(_TC, Config, Return, State) -> + Node = proplists:get_value(node, Config), + cover:stop(Node), + slave:stop(Node), + + {Return, State}. + +%% Parse an .suite log file +parse_suite(FileName) -> + + case file:open(FileName, [read, raw, read_ahead]) of + {ok, Fd} -> + Data = parse_suite(Fd, #suite{ }), + file:close(Fd), + {ok, Data}; + _ -> + error + end. + +fline(Fd) -> + case prim_file:read_line(Fd) of + eof -> eof; + {ok, Line} -> Line + end. + +parse_suite(Fd, S) -> + _Started = fline(Fd), + _Starting = fline(Fd), + "=cases" ++ NCases = fline(Fd), + "=user" ++ _User = fline(Fd), + "=host" ++ Host = fline(Fd), + "=hosts" ++ _Hosts = fline(Fd), + "=emulator_vsn" ++ Evsn = fline(Fd), + "=emulator" ++ Emu = fline(Fd), + "=otp_release" ++ OtpRel = fline(Fd), + "=started" ++ Start = fline(Fd), + NewS = parse_cases(Fd, S#suite{ + n_cases_expected = list_to_int(clean(NCases)), + host = list_to_binary(clean(Host)), + emulator_vsn = list_to_binary(clean(Evsn)), + emulator = list_to_binary(clean(Emu)), + otp_release = list_to_binary(clean(OtpRel)), + started = list_to_binary(clean(Start)) + }), + "=failed" ++ Failed = fline(Fd), + "=successful" ++ Succ = fline(Fd), + "=user_skipped" ++ UsrSkip = fline(Fd), + "=auto_skipped" ++ AutSkip = fline(Fd), + NewS#suite{ n_cases_failed = list_to_int(clean(Failed)), + n_cases_succ = list_to_int(clean(Succ)), + n_cases_user_skip = list_to_int(clean(UsrSkip)), + n_cases_auto_skip = list_to_int(clean(AutSkip)) }. + + +parse_cases(Fd, #suite{ n_cases = N, + cases = Cases } = S) -> + case parse_case(Fd) of + finished -> S#suite{ log_ok = true }; + {eof, Tc} -> + S#suite{ n_cases = N + 1, + cases = [Tc#tc{ result = crashed }|Cases]}; + {ok, Case} -> + parse_cases(Fd, S#suite{ n_cases = N + 1, + cases = [Case|Cases]}) + end. + +parse_case(Fd) -> parse_case(Fd, #tc{}). +parse_case(Fd, Tc) -> parse_case(fline(Fd), Fd, Tc). + +parse_case(eof, _, Tc) -> {eof, Tc}; +parse_case("=case" ++ Case, Fd, Tc) -> + Name = list_to_binary(clean(Case)), + parse_case(fline(Fd), Fd, Tc#tc{ name = Name }); +parse_case("=logfile" ++ File, Fd, Tc) -> + Log = list_to_binary(clean(File)), + parse_case(fline(Fd), Fd, Tc#tc{ logfile = Log }); +parse_case("=elapsed" ++ Elapsed, Fd, Tc) -> + {ok, [Time], _} = io_lib:fread("~f", clean(Elapsed)), + parse_case(fline(Fd), Fd, Tc#tc{ elapsed = Time }); +parse_case("=result" ++ Result, _, Tc) -> + case clean(Result) of + "ok" ++ _ -> + {ok, Tc#tc{ result = ok } }; + "failed" ++ _ -> + {ok, Tc#tc{ result = failed } }; + "skipped" ++ _ -> + {ok, Tc#tc{ result = skip } } + end; +parse_case("=finished" ++ _ , _Fd, #tc{ name = undefined }) -> + finished; +parse_case(_, Fd, Tc) -> + parse_case(fline(Fd), Fd, Tc). + +skip([]) -> []; +skip([$ |Ts]) -> skip(Ts); +skip(Ts) -> Ts. + +%rmnl(L) -> L. +rmnl([]) -> []; +rmnl([$\n | Ts]) -> rmnl(Ts); +rmnl([T|Ts]) -> [T | rmnl(Ts)]. + +clean(L) -> + rmnl(skip(L)). + +list_to_int(L) -> + try + list_to_integer(L) + catch + _:_ -> + 0 + end. diff --git a/lib/test_server/test/test_server_test_lib.hrl b/lib/test_server/test/test_server_test_lib.hrl new file mode 100644 index 0000000000..27b7be9618 --- /dev/null +++ b/lib/test_server/test/test_server_test_lib.hrl @@ -0,0 +1,23 @@ +-record(tc, { + name, + result, + elapsed, + logfile + }). + +-record(suite, { + application, + n_cases = 0, + n_cases_failed = 0, + n_cases_expected = 0, + n_cases_succ, + n_cases_user_skip, + n_cases_auto_skip, + cases = [], + host, + emulator_vsn, + emulator, + otp_release, + started, + log_ok = false + }). |