aboutsummaryrefslogtreecommitdiffstats
path: root/lib/test_server/src/ts_run.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/test_server/src/ts_run.erl')
-rw-r--r--lib/test_server/src/ts_run.erl455
1 files changed, 0 insertions, 455 deletions
diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl
deleted file mode 100644
index 188094921d..0000000000
--- a/lib/test_server/src/ts_run.erl
+++ /dev/null
@@ -1,455 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%% Purpose : Supervises running of test cases.
-
--module(ts_run).
-
--export([run/4,ct_run_test/2]).
-
--define(DEFAULT_MAKE_TIMETRAP_MINUTES, 60).
--define(DEFAULT_UNMAKE_TIMETRAP_MINUTES, 15).
-
--include("ts.hrl").
-
--import(lists, [member/2,filter/2]).
-
--record(state,
- {file, % File given.
- mod, % Module to run.
- test_server_args, % Arguments to test server.
- command, % Command to run.
- test_dir, % Directory for test suite.
- makefiles, % List of all makefiles.
- makefile, % Current makefile.
- batch, % Are we running in batch mode?
- data_wc, % Wildcard for data dirs.
- topcase, % Top case specification.
- all % Set if we have all_SUITE_data
- }).
-
--define(tracefile,"traceinfo").
-
-%% Options is a slightly modified version of the options given to
-%% ts:run. Vars0 are from the variables file.
-run(File, Args0, Options, Vars0) ->
- Vars=
- case lists:keysearch(vars, 1, Options) of
- {value, {vars, Vars1}} ->
- Vars1++Vars0;
- _ ->
- Vars0
- end,
- {Batch,Runner} =
- case {member(interactive, Options), member(batch, Options)} of
- {false, true} ->
- {true, fun run_batch/3};
- _ ->
- {false, fun run_interactive/3}
- end,
- Hooks = [fun init_state/3,
- fun run_preinits/3,
- fun make_command/3,
- Runner],
- Args = make_common_test_args(Args0,Options,Vars),
- St = #state{file=File,test_server_args=Args,batch=Batch},
- R = execute(Hooks, Vars, [], St),
- case R of
- {ok,_,_,_} -> ok;
- Error -> Error
- end.
-
-execute([Hook|Rest], Vars0, Spec0, St0) ->
- case Hook(Vars0, Spec0, St0) of
- ok ->
- execute(Rest, Vars0, Spec0, St0);
- {ok, Vars, Spec, St} ->
- execute(Rest, Vars, Spec, St);
- Error ->
- Error
- end;
-execute([], Vars, Spec, St) ->
- {ok, Vars, Spec, St}.
-
-%% Wrapper to run tests using ct:run_test/1 and handle any errors.
-
-ct_run_test(Dir, CommonTestArgs) ->
- try
- ok = file:set_cwd(Dir),
- case ct:run_test(CommonTestArgs) of
- {_,_,_} ->
- ok;
- {error,Error} ->
- io:format("ERROR: ~P\n", [Error,20]);
- Other ->
- io:format("~P\n", [Other,20])
- end
- catch
- _:Crash ->
- io:format("CRASH: ~P\n", [Crash,20])
- end.
-
-%%
-%% Deletes File from Files when File is on the form .../<SUITE>_data/<file>
-%% when all of <SUITE> has been skipped in Spec, i.e. there
-%% exists a {skip, {<SUITE>, _}} tuple in Spec.
-%%
-del_skipped_suite_data_dir(Files, Spec) ->
- SkipDirNames = lists:foldl(fun ({skip, {SS, _C}}, SSs) ->
- [atom_to_list(SS) ++ "_data" | SSs];
- (_, SSs) ->
- SSs
- end,
- [],
- Spec),
- filter(fun (File) ->
- not member(filename:basename(filename:dirname(File)),
- SkipDirNames)
- end,
- Files).
-
-%% Initialize our internal state.
-
-init_state(Vars, [], St0) ->
- {FileBase,Wc0,Mod} =
- case St0#state.file of
- {Fil,Mod0} -> {Fil, atom_to_list(Mod0) ++ "*_data",Mod0};
- Fil -> {Fil,"*_SUITE_data",[]}
- end,
- {ok,Cwd} = file:get_cwd(),
- TestDir = filename:join(filename:dirname(Cwd), FileBase++"_test"),
- case filelib:is_dir(TestDir) of
- true ->
- Wc = filename:join(TestDir, Wc0),
- {ok,Vars,[],St0#state{file=FileBase,mod=Mod,
- test_dir=TestDir,data_wc=Wc}};
- false ->
- {error,{no_test_directory,TestDir}}
- end.
-
-%% Run any "Makefile.first" files first.
-%% XXX We should fake a failing test case if the make fails.
-
-run_preinits(Vars, Spec, St) ->
- Wc = filename:join(St#state.data_wc, "Makefile.first"),
- run_pre_makefiles(del_skipped_suite_data_dir(filelib:wildcard(Wc), Spec),
- Vars, Spec, St),
- {ok,Vars,Spec,St}.
-
-run_pre_makefiles([Makefile|Ms], Vars0, Spec0, St0) ->
- Hooks = [fun run_pre_makefile/3],
- case execute(Hooks, Vars0, Spec0, St0#state{makefile=Makefile}) of
- {error,_Reason}=Error -> Error;
- {ok,Vars,Spec,St} -> run_pre_makefiles(Ms, Vars, Spec, St)
- end;
-run_pre_makefiles([], Vars, Spec, St) -> {ok,Vars,Spec,St}.
-
-run_pre_makefile(Vars, Spec, St) ->
- Makefile = St#state.makefile,
- Shortname = filename:basename(Makefile),
- DataDir = filename:dirname(Makefile),
- Make = ts_lib:var(make_command, Vars),
- case ts_make:make(Make,DataDir, Shortname) of
- ok -> {ok,Vars,Spec,St};
- {error,_Reason}=Error -> Error
- end.
-
-get_config_files() ->
- TSConfig = "ts.config",
- [TSConfig | case os:type() of
- {unix,_} -> ["ts.unix.config"];
- {win32,_} -> ["ts.win32.config"];
- _ -> []
- end].
-
-%% Makes the command to start up the Erlang node to run the tests.
-
-backslashify([$\\, $" | T]) ->
- [$\\, $" | backslashify(T)];
-backslashify([$" | T]) ->
- [$\\, $" | backslashify(T)];
-backslashify([H | T]) ->
- [H | backslashify(T)];
-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
- false ->
- atom_to_list(lib:progname());
- _ ->
- case State#state.file of
- Dir when is_list(Dir) ->
- os:putenv("VALGRIND_LOGFILE_PREFIX", Dir++"-");
- _ ->
- ok
- end,
- "cerl -valgrind" ++
- case erlang:system_info(smp_support) of
- true -> " -smp";
- false -> ""
- end
- end,
- Naming =
- case ts_lib:var(longnames, Vars) of
- true ->
- " -name ";
- false ->
- " -sname "
- end,
- ExtraArgs =
- case lists:keysearch(erl_start_args,1,Vars) of
- {value,{erl_start_args,Args}} -> Args;
- false -> ""
- end,
- CrashFile = filename:join(Cwd,State#state.file ++ "_erl_crash.dump"),
- case filelib:is_file(CrashFile) of
- true ->
- io:format("ts_run: Deleting dump: ~ts\n",[CrashFile]),
- file:delete(CrashFile);
- false ->
- ok
- end,
-
- %% If Common Test specific variables are needed, add them here
- %% on form: "{key1,value1}" "{key2,value2}" ...
- NetDir = ts_lib:var(ts_net_dir, Vars),
- TestVars = [ "\"{net_dir,\\\"",NetDir,"\\\"}\"" ],
-
- %% 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(),
- remove_path_spaces()])),
- "\"",
- " -env ERL_CRASH_DUMP ", CrashFile,
- %% uncomment the line below to disable exception formatting
- %% " -test_server_format_exception false",
- " -boot start_sasl -sasl errlog_type error",
- " -pz \"",Cwd,"\"",
- " -ct_test_vars ",TestVars,
- " -eval \"ts_run:ct_run_test(\\\"",TestDir,"\\\", ",
- 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: ~ts~n", [Command]),
- io:format(user, "Command: ~ts~n",[Command]),
- Port = open_port({spawn, Command}, [stream, in, eof]),
- Timeout = 30000 * case os:getenv("TS_RUN_VALGRIND") of
- false -> 1;
- _ -> 100
- end,
- tricky_print_data(Port, Timeout).
-
-tricky_print_data(Port, Timeout) ->
- receive
- {Port, {data, Bytes}} ->
- io:put_chars(Bytes),
- tricky_print_data(Port, Timeout);
- {Port, eof} ->
- Port ! {self(), close},
- receive
- {Port, closed} ->
- true
- end,
- receive
- {'EXIT', Port, _} ->
- ok
- after 1 -> % force context switch
- ok
- end
- after Timeout ->
- case erl_epmd:names() of
- {ok,Names} ->
- case is_testnode_dead(Names) of
- true ->
- io:put_chars("WARNING: No EOF, but "
- "test_server node is down!\n");
- false ->
- tricky_print_data(Port, Timeout)
- end;
- _ ->
- tricky_print_data(Port, Timeout)
- end
- end.
-
-is_testnode_dead([]) -> true;
-is_testnode_dead([{"test_server",_}|_]) -> false;
-is_testnode_dead([_|T]) -> is_testnode_dead(T).
-
-run_interactive(Vars, _Spec, State) ->
- Command = State#state.command,
- ts_lib:progress(Vars, 1, "Command: ~s~n", [Command]),
- case ts_lib:var(os, Vars) of
- "Windows 95" ->
- %% Windows 95 strikes again! We must redirect standard
- %% input and output for the `start' command, to force
- %% standard input and output to the Erlang shell to be
- %% connected to the newly started console.
- %% Without these redirections, the Erlang shell would be
- %% connected to the pipes provided by the port program
- %% and there would be an inactive console window.
- os:cmd("start < nul > nul w" ++ Command),
- ok;
- "Windows 98" ->
- os:cmd("start < nul > nul w" ++ Command),
- ok;
- "Windows"++_ ->
- os:cmd("start w" ++ Command),
- ok;
- _Other ->
- %% Assuming ts and controller always run on solaris
- start_xterm(Command)
- end.
-
-start_xterm(Command) ->
- case os:find_executable("xterm") of
- false ->
- io:format("The `xterm' program was not found.\n"),
- {error, no_xterm};
- _Xterm ->
- case os:getenv("DISPLAY") of
- false ->
- io:format("DISPLAY is not set.\n"),
- {error, display_not_set};
- Display ->
- io:format("Starting xterm (DISPLAY=~s)...\n",
- [Display]),
- os:cmd("xterm -sl 10000 -e " ++ Command ++ "&"),
- ok
- end
- end.
-
-path_separator() ->
- case os:type() of
- {win32, _} -> ";";
- {unix, _} -> ":"
- end.
-
-
-make_common_test_args(Args0, Options0, _Vars) ->
- Trace =
- case lists:keysearch(trace,1,Options0) of
- {value,{trace,TI}} when is_tuple(TI); is_tuple(hd(TI)) ->
- ok = file:write_file(?tracefile,io_lib:format("~p.~n",[TI])),
- [{ct_trace,?tracefile}];
- {value,{trace,TIFile}} when is_atom(TIFile) ->
- [{ct_trace,atom_to_list(TIFile)}];
- {value,{trace,TIFile}} ->
- [{ct_trace,TIFile}];
- false ->
- []
- end,
- Cover =
- case lists:keysearch(cover,1,Options0) of
- {value,{cover, App, none, _Analyse}} ->
- io:format("No cover file found for ~p~n",[App]),
- [];
- {value,{cover,_App,File,_Analyse}} ->
- [{cover,to_list(File)},{cover_stop,false}];
- false ->
- []
- end,
-
- Logdir = case lists:keysearch(logdir, 1, Options0) of
- {value,{logdir, _}} ->
- [];
- false ->
- [{logdir,"../test_server"}]
- end,
-
- TimeTrap = [{scale_timetraps, true}],
-
- {ConfigPath,
- Options} = case {os:getenv("TEST_CONFIG_PATH"),
- lists:keysearch(config, 1, Options0)} of
- {_,{value, {config, Path}}} ->
- {Path,lists:keydelete(config, 1, Options0)};
- {false,false} ->
- {"../test_server",Options0};
- {Path,_} ->
- {Path,Options0}
- end,
- ConfigFiles = [{config,[filename:join(ConfigPath,File)
- || File <- get_config_files()]}],
- io_lib:format("~100000p",[[{abort_if_missing_suites,true} |
- Args0++Trace++Cover++Logdir++
- ConfigFiles++Options++TimeTrap]]).
-
-to_list(X) when is_atom(X) ->
- atom_to_list(X);
-to_list(X) when is_list(X) ->
- X.
-
-%%
-%% Paths and spaces handling for w2k and XP
-%%
-remove_path_spaces() ->
- Path = os:getenv("PATH"),
- case os:type() of
- {win32,nt} ->
- remove_path_spaces(Path);
- _ ->
- Path
- end.
-
-remove_path_spaces(Path) ->
- SPath = split_path(Path),
- [NSHead|NSTail] = lists:map(fun(X) -> filename:nativename(
- filename:join(
- translate_path(split_one(X))))
- end,
- SPath),
- NSHead ++ lists:flatten([[$;|X] || X <- NSTail]).
-
-translate_path(PList) ->
- %io:format("translate_path([~p|~p]~n",[Base,PList]),
- translate_path(PList,[]).
-
-
-translate_path([],_) ->
- [];
-translate_path([PC | T],BaseList) ->
- FullPath = filename:nativename(filename:join(BaseList ++ [PC])),
- NewPC = case catch file:altname(FullPath) of
- {ok,X} ->
- X;
- _ ->
- PC
- end,
- %io:format("NewPC:~s, DirList:~p~n",[NewPC,DirList]),
- NewBase = BaseList ++ [NewPC],
- [NewPC | translate_path(T,NewBase)].
-
-split_one(Path) ->
- filename:split(Path).
-
-split_path(Path) ->
- string:tokens(Path,";").
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-08 16:27:06 +0000