diff options
Diffstat (limited to 'lib/test_server/src')
| -rw-r--r-- | lib/test_server/src/Makefile | 9 | ||||
| -rw-r--r-- | lib/test_server/src/test_server.erl | 151 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_ctrl.erl | 18 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_node.erl | 4 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_sup.erl | 5 | ||||
| -rw-r--r-- | lib/test_server/src/ts.config | 83 | ||||
| -rw-r--r-- | lib/test_server/src/ts.erl | 36 | ||||
| -rw-r--r-- | lib/test_server/src/ts.unix.config | 2 | ||||
| -rw-r--r-- | lib/test_server/src/ts.vxworks.config | 19 | ||||
| -rw-r--r-- | lib/test_server/src/ts.win32.config | 15 | ||||
| -rw-r--r-- | lib/test_server/src/ts_install_cth.erl | 286 | ||||
| -rw-r--r-- | lib/test_server/src/ts_run.erl | 459 |
12 files changed, 527 insertions, 560 deletions
diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile index 3dca55178d..63a585d526 100644 --- a/lib/test_server/src/Makefile +++ b/lib/test_server/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2010. All Rights Reserved. +# Copyright Ericsson AB 1996-2011. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -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..7f0011bd68 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -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..30d7314058 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% Copyright Ericsson AB 2002-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -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..1fd40d1dd9 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/test_server/src/test_server_node.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% Copyright Ericsson AB 2002-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -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..1a614d74d5 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% Copyright Ericsson AB 1998-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -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..729a2b11fc 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/test_server/src/ts.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -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..c5444a342f --- /dev/null +++ b/lib/test_server/src/ts_install_cth.erl @@ -0,0 +1,286 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%% @doc 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..067961a216 100644 --- a/lib/test_server/src/ts_run.erl +++ b/lib/test_server/src/ts_run.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -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. |