1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1997-2018. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21%%% Purpose : Supervises running of test cases.
22
23-module(ts_run).
24
25-export([run/4,ct_run_test/2]).
26
27-define(DEFAULT_MAKE_TIMETRAP_MINUTES, 60).
28-define(DEFAULT_UNMAKE_TIMETRAP_MINUTES, 15).
29
30-include("ts.hrl").
31
32-import(lists, [member/2,filter/2]).
33
34-record(state,
35	{file,					% File given.
36	 mod,					% Module to run.
37	 test_server_args,			% Arguments to test server.
38	 command,				% Command to run.
39	 test_dir,				% Directory for test suite.
40	 makefiles,				% List of all makefiles.
41	 makefile,				% Current makefile.
42	 batch,					% Are we running in batch mode?
43	 data_wc,				% Wildcard for data dirs.
44	 topcase,				% Top case specification.
45	 all					% Set if we have all_SUITE_data
46	}).
47
48-define(tracefile,"traceinfo").
49
50%% Options is a slightly modified version of the options given to
51%% ts:run. Vars0 are from the variables file.
52run(File, Args0, Options, Vars0) ->
53    Vars=
54	case lists:keysearch(vars, 1, Options) of
55	    {value, {vars, Vars1}} ->
56		Vars1++Vars0;
57	    _ ->
58		Vars0
59	end,
60    {Batch,Runner}  =
61	case {member(interactive, Options), member(batch, Options)} of
62	    {false, true} ->
63		{true, fun run_batch/3};
64	    _ ->
65		{false, fun run_interactive/3}
66	end,
67    Hooks = [fun init_state/3,
68             fun run_preinits/3,
69	     fun make_command/3,
70	     Runner],
71    Args = make_common_test_args(Args0,Options,Vars),
72    St = #state{file=File,test_server_args=Args,batch=Batch},
73    R = execute(Hooks, Vars, [], St),
74    case R of
75	{ok,_,_,_} -> ok;
76	Error -> Error
77    end.
78
79execute([Hook|Rest], Vars0, Spec0, St0) ->
80    case Hook(Vars0, Spec0, St0) of
81	ok ->
82	    execute(Rest, Vars0, Spec0, St0);
83	{ok, Vars, Spec, St} ->
84	    execute(Rest, Vars, Spec, St);
85	Error ->
86	    Error
87    end;
88execute([], Vars, Spec, St) ->
89    {ok, Vars, Spec, St}.
90
91%% Wrapper to run tests using ct:run_test/1 and handle any errors.
92
93ct_run_test(Dir, CommonTestArgs) ->
94    try
95	ok = file:set_cwd(Dir),
96	case ct:run_test(CommonTestArgs) of
97	    {_,_,_} ->
98		ok;
99            {error,{make_failed, _Modules} = Error} ->
100		io:format("ERROR: ~P\n", [Error,20]),
101                erlang:halt(123, [{flush,false}]);
102	    {error,Error} ->
103		io:format("ERROR: ~P\n", [Error,20]);
104	    Other ->
105		io:format("~P\n", [Other,20])
106	end
107    catch
108	_:Crash ->
109	    io:format("CRASH: ~P\n", [Crash,20])
110    end.
111
112%%
113%% Deletes File from Files when File is on the form .../<SUITE>_data/<file>
114%% when all of <SUITE> has been skipped in Spec, i.e. there
115%% exists a {skip, {<SUITE>, _}} tuple in Spec.
116%%
117del_skipped_suite_data_dir(Files, Spec) ->
118    SkipDirNames = lists:foldl(fun ({skip, {SS, _C}}, SSs) ->
119				       [atom_to_list(SS) ++ "_data" | SSs];
120				   (_, SSs) ->
121				       SSs
122			       end,
123			       [],
124			       Spec),
125    filter(fun (File) ->
126		   not member(filename:basename(filename:dirname(File)),
127			      SkipDirNames)
128	   end,
129	   Files).
130
131%% Initialize our internal state.
132
133init_state(Vars, [], St0) ->
134    {FileBase,Wc0,Mod} =
135	case St0#state.file of
136	    {Fil,Mod0} -> {Fil, atom_to_list(Mod0) ++ "*_data",Mod0};
137	    Fil -> {Fil,"*_SUITE_data",[]}
138	end,
139    {ok,Cwd} = file:get_cwd(),
140    TestDir = filename:join(filename:dirname(Cwd), FileBase++"_test"),
141    case filelib:is_dir(TestDir) of
142	true ->
143	    Wc = filename:join(TestDir, Wc0),
144	    {ok,Vars,[],St0#state{file=FileBase,mod=Mod,
145				  test_dir=TestDir,data_wc=Wc}};
146	false ->
147	    {error,{no_test_directory,TestDir}}
148    end.
149
150%% Run any "Makefile.first" files first.
151%%  XXX We should fake a failing test case if the make fails.
152
153run_preinits(Vars, Spec, St) ->
154    Wc = filename:join(St#state.data_wc, "Makefile.first"),
155    run_pre_makefiles(del_skipped_suite_data_dir(filelib:wildcard(Wc), Spec),
156		      Vars, Spec, St),
157    {ok,Vars,Spec,St}.
158
159run_pre_makefiles([Makefile|Ms], Vars0, Spec0, St0) ->
160    Hooks = [fun run_pre_makefile/3],
161    case execute(Hooks, Vars0, Spec0, St0#state{makefile=Makefile}) of
162	{error,_Reason}=Error -> Error;
163	{ok,Vars,Spec,St} -> run_pre_makefiles(Ms, Vars, Spec, St)
164    end;
165run_pre_makefiles([], Vars, Spec, St) -> {ok,Vars,Spec,St}.
166
167run_pre_makefile(Vars, Spec, St) ->
168    Makefile = St#state.makefile,
169    Shortname = filename:basename(Makefile),
170    DataDir = filename:dirname(Makefile),
171    Make = ts_lib:var(make_command, Vars),
172    case ts_make:make(Make,DataDir, Shortname) of
173	ok -> {ok,Vars,Spec,St};
174	{error,_Reason}=Error -> Error
175    end.
176
177get_config_files() ->
178    TSConfig = "ts.config",
179    [TSConfig | case os:type() of
180		    {unix,_} -> ["ts.unix.config"];
181		    {win32,_} -> ["ts.win32.config"];
182		    _ -> []
183		end].
184
185%% Makes the command to start up the Erlang node to run the tests.
186
187backslashify([$\\, $" | T]) ->
188    [$\\, $" | backslashify(T)];
189backslashify([$" | T]) ->
190    [$\\, $" | backslashify(T)];
191backslashify([H | T]) ->
192    [H | backslashify(T)];
193backslashify([]) ->
194    [].
195
196make_command(Vars, Spec, State) ->
197    {ok,Cwd} = file:get_cwd(),
198    TestDir = State#state.test_dir,
199    TestPath = filename:nativename(TestDir),
200    Erl = case os:getenv("TS_RUN_EMU") of
201	      false ->
202		  ct:get_progname();
203	      "valgrind" ->
204		  case State#state.file of
205		      Dir when is_list(Dir) ->
206			  os:putenv("VALGRIND_LOGFILE_PREFIX", Dir++"-");
207		      _ ->
208			  ok
209		  end,
210		  "cerl -valgrind";
211              "asan" ->
212		  case State#state.file of
213		      App when is_list(App) ->
214			  os:putenv("ASAN_LOGFILE_PREFIX", App);
215		      _ ->
216			  ok
217		  end,
218                  "cerl -asan"
219	  end,
220    Naming =
221	case ts_lib:var(longnames, Vars) of
222	    true ->
223		" -name ";
224	    false ->
225		" -sname "
226	end,
227    ExtraArgs =
228	case lists:keysearch(erl_start_args,1,Vars) of
229	    {value,{erl_start_args,Args}} -> Args;
230	    false -> ""
231	end,
232    CrashFile = filename:join(Cwd,State#state.file ++ "_erl_crash.dump"),
233    case filelib:is_file(CrashFile) of
234	true ->
235	    io:format("ts_run: Deleting dump: ~ts\n",[CrashFile]),
236	    file:delete(CrashFile);
237	false ->
238	    ok
239    end,
240
241    %% If Common Test specific variables are needed, add them here
242    %% on form: "{key1,value1}" "{key2,value2}" ...
243    NetDir = ts_lib:var(ts_net_dir, Vars),
244    TestVars = [ "\"{net_dir,\\\"",NetDir,"\\\"}\"" ],
245
246    %% NOTE: Do not use ' in these commands as it wont work on windows
247    Cmd = [Erl, Naming, "test_server"
248	   " -rsh ", ts_lib:var(rsh_name, Vars),
249	   " -env PATH \"",
250	   backslashify(lists:flatten([TestPath, path_separator(),
251			  remove_path_spaces()])),
252	   "\"",
253	   " -env ERL_CRASH_DUMP ", CrashFile,
254	   %% uncomment the line below to disable exception formatting
255	   %%	   " -test_server_format_exception false",
256	   " -boot start_sasl -sasl errlog_type error",
257	   " -pz \"",Cwd,"\"",
258	   " -ct_test_vars ",TestVars,
259	   " -eval \"ts_run:ct_run_test(\\\"",TestDir,"\\\", ",
260	   backslashify(lists:flatten(State#state.test_server_args)),")\""
261	   " ",
262	   ExtraArgs],
263    {ok, Vars, Spec, State#state{command=lists:flatten(Cmd)}}.
264
265
266run_batch(Vars, _Spec, State) ->
267    process_flag(trap_exit, true),
268    Command = State#state.command ++ " -noinput -eval \"erlang:halt(0,[{flush,false}]).\"",
269    ts_lib:progress(Vars, 1, "Command: ~ts~n", [Command]),
270    io:format(user, "Command: ~ts~n",[Command]),
271    Port = open_port({spawn, Command}, [stream, in, eof, exit_status]),
272    Timeout = 30000 * case os:getenv("TS_RUN_EMU") of
273			  false -> 1;
274			  "valgrind" -> 100;
275                          "asan" -> 2
276		      end,
277    tricky_print_data(Port, Timeout).
278
279tricky_print_data(Port, Timeout) ->
280    receive
281	{Port, {data, Bytes}} ->
282	    io:put_chars(Bytes),
283	    tricky_print_data(Port, Timeout);
284	{Port, eof} ->
285	    Port ! {self(), close},
286	    receive
287		{Port, closed} ->
288		    true
289	    end,
290	    receive
291		{'EXIT',  Port,  _} ->
292		    ok
293	    after 1 ->				% force context switch
294		    ok
295	    end,
296            receive
297                {Port, {exit_status, 0}} ->
298                    ok;
299                {Port, {exit_status, 123 = N}} ->
300                    io:format(user, "Test run exited with status ~p,"
301                              "aborting rest of test~n", [N]),
302                    erlang:halt(123, [{flush,false}]);
303                {Port, {exit_status, N}} ->
304                    io:format(user, "Test run exited with status ~p~n", [N])
305            after 1 ->
306                    %% This shouldn't happen, but better safe then hanging
307                    ok
308            end
309    after Timeout ->
310	    case erl_epmd:names() of
311		{ok,Names} ->
312		    case is_testnode_dead(Names) of
313			true ->
314			    io:put_chars("WARNING: No EOF, but "
315					 "test_server node is down!\n");
316			false ->
317			    tricky_print_data(Port, Timeout)
318		    end;
319		_ ->
320		    tricky_print_data(Port, Timeout)
321	    end
322    end.
323
324is_testnode_dead([]) -> true;
325is_testnode_dead([{"test_server",_}|_]) -> false;
326is_testnode_dead([_|T]) -> is_testnode_dead(T).
327
328run_interactive(Vars, _Spec, State) ->
329    Command = State#state.command,
330    ts_lib:progress(Vars, 1, "Command: ~s~n", [Command]),
331    case ts_lib:var(os, Vars) of
332	"Windows 95" ->
333	    %% Windows 95 strikes again!  We must redirect standard
334	    %% input and output for the `start' command, to force
335	    %% standard input and output to the Erlang shell to be
336	    %% connected to the newly started console.
337	    %% Without these redirections, the Erlang shell would be
338	    %% connected to the pipes provided by the port program
339	    %% and there would be an inactive console window.
340	    os:cmd("start < nul > nul w" ++ Command),
341	    ok;
342	"Windows 98" ->
343	    os:cmd("start < nul > nul w" ++ Command),
344	    ok;
345	"Windows"++_ ->
346	    os:cmd("start w" ++ Command),
347	    ok;
348	_Other ->
349	    %% Assuming ts and controller always run on solaris
350	    start_xterm(Command)
351    end.
352
353start_xterm(Command) ->
354    case os:find_executable("xterm") of
355	false ->
356	    io:format("The `xterm' program was not found.\n"),
357	    {error, no_xterm};
358	_Xterm ->
359	    case os:getenv("DISPLAY") of
360		false ->
361		    io:format("DISPLAY is not set.\n"),
362		    {error, display_not_set};
363		Display ->
364		    io:format("Starting xterm (DISPLAY=~s)...\n",
365			      [Display]),
366		    os:cmd("xterm -sl 10000 -e " ++ Command ++ "&"),
367		    ok
368	    end
369    end.
370
371path_separator() ->
372    case os:type() of
373	{win32, _} -> ";";
374	{unix, _}  -> ":"
375    end.
376
377
378make_common_test_args(Args0, Options0, _Vars) ->
379    Trace =
380	case lists:keysearch(trace,1,Options0) of
381	    {value,{trace,TI}} when is_tuple(TI); is_tuple(hd(TI)) ->
382		ok = file:write_file(?tracefile,io_lib:format("~p.~n",[TI])),
383		[{ct_trace,?tracefile}];
384	    {value,{trace,TIFile}} when is_atom(TIFile) ->
385		[{ct_trace,atom_to_list(TIFile)}];
386	    {value,{trace,TIFile}} ->
387		[{ct_trace,TIFile}];
388	    false ->
389		[]
390	end,
391    Cover =
392	case lists:keysearch(cover,1,Options0) of
393	    {value,{cover, App, none, _Analyse}} ->
394		io:format("No cover file found for ~p~n",[App]),
395		[];
396	    {value,{cover,_App,File,_Analyse}} ->
397		[{cover,to_list(File)},{cover_stop,false}];
398	    false ->
399		[]
400	end,
401
402    Logdir = case lists:keysearch(logdir, 1, Options0) of
403		  {value,{logdir, _}} ->
404		      [];
405		  false ->
406		      [{logdir,"../test_server"}]
407	     end,
408
409    TimeTrap = [{scale_timetraps, true}],
410
411    {ConfigPath,
412     Options} = case {os:getenv("TEST_CONFIG_PATH"),
413		      lists:keysearch(config, 1, Options0)} of
414		    {_,{value, {config, Path}}} ->
415			{Path,lists:keydelete(config, 1, Options0)};
416		    {false,false} ->
417			{"../test_server",Options0};
418		    {Path,_} ->
419			{Path,Options0}
420		end,
421    ConfigFiles = [{config,[filename:join(ConfigPath,File)
422			    || File <- get_config_files()]}],
423    io_lib:format("~0p",[[{abort_if_missing_suites,true} |
424                          Args0++Trace++Cover++Logdir++
425                              ConfigFiles++Options++TimeTrap]]).
426
427to_list(X) when is_atom(X) ->
428    atom_to_list(X);
429to_list(X) when is_list(X) ->
430    X.
431
432%%
433%% Paths and spaces handling for w2k and XP
434%%
435remove_path_spaces() ->
436    Path = os:getenv("PATH"),
437    case os:type() of
438	{win32,nt} ->
439	    remove_path_spaces(Path);
440	_ ->
441	    Path
442    end.
443
444remove_path_spaces(Path) ->
445    SPath = split_path(Path),
446    [NSHead|NSTail] = lists:map(fun(X) -> filename:nativename(
447					    filename:join(
448					      translate_path(split_one(X))))
449				end,
450				SPath),
451    NSHead ++ lists:flatten([[$;|X] || X <- NSTail]).
452
453translate_path(PList) ->
454    %io:format("translate_path([~p|~p]~n",[Base,PList]),
455    translate_path(PList,[]).
456
457
458translate_path([],_) ->
459    [];
460translate_path([PC | T],BaseList) ->
461    FullPath = filename:nativename(filename:join(BaseList ++ [PC])),
462    NewPC = case catch file:altname(FullPath) of
463		{ok,X} ->
464		    X;
465		_ ->
466		    PC
467	    end,
468    %io:format("NewPC:~s, DirList:~p~n",[NewPC,DirList]),
469    NewBase = BaseList ++ [NewPC],
470    [NewPC | translate_path(T,NewBase)].
471
472split_one(Path) ->
473    filename:split(Path).
474
475split_path(Path) ->
476    string:lexemes(Path,";").
477