1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2002-2020. 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-module(test_server_ctrl).
21%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
22%%                                                                  %%
23%%                      The Erlang Test Server                      %%
24%%                                                                  %%
25%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26
27%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
28%%
29%% MODULE DEPENDENCIES:
30%% HARD TO REMOVE: erlang, lists, io_lib, gen_server, file, io, string,
31%%                 code, ets, rpc, gen_tcp, inet, erl_tar, sets,
32%%                 test_server, test_server_sup, test_server_node
33%% EASIER TO REMOVE: filename, filelib, lib, re
34%%
35%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
36
37%%% SUPERVISOR INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
38-export([start/0, start/1, start_link/1, stop/0]).
39
40%%% OPERATOR INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
41-export([add_spec/1, add_dir/2, add_dir/3]).
42-export([add_module/1, add_module/2,
43	 add_conf/3,
44	 add_case/2, add_case/3, add_cases/2, add_cases/3]).
45-export([add_dir_with_skip/3, add_dir_with_skip/4, add_tests_with_skip/3]).
46-export([add_module_with_skip/2, add_module_with_skip/3,
47	 add_conf_with_skip/4,
48	 add_case_with_skip/3, add_case_with_skip/4,
49	 add_cases_with_skip/3, add_cases_with_skip/4]).
50-export([jobs/0, run_test/1, wait_finish/0, idle_notify/1,
51	 abort_current_testcase/1, abort/0]).
52-export([start_get_totals/1, stop_get_totals/0]).
53-export([reject_io_reqs/1, get_levels/0, set_levels/3]).
54-export([multiply_timetraps/1, scale_timetraps/1, get_timetrap_parameters/0]).
55-export([create_priv_dir/1]).
56-export([cover/1, cover/2, cover/3,
57	 cover_compile/7, cover_analyse/2, cross_cover_analyse/2,
58	 trc/1, stop_trace/0]).
59-export([testcase_callback/1]).
60-export([set_random_seed/1]).
61-export([kill_slavenodes/0]).
62
63%%% TEST_SERVER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
64-export([print/2, print/3, print/4, print_timestamp/2]).
65-export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]).
66-export([format/1, format/2, format/3, to_string/1]).
67-export([get_target_info/0]).
68-export([get_hosts/0]).
69-export([node_started/1]).
70-export([uri_encode/1,uri_encode/2]).
71
72%%% DEBUGGER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
73-export([i/0, p/1, p/3, pi/2, pi/4, t/0, t/1]).
74
75%%% PRIVATE EXPORTED %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
76-export([init/1, terminate/2]).
77-export([handle_call/3, handle_cast/2, handle_info/2]).
78-export([do_test_cases/4]).
79-export([do_spec/2, do_spec_list/2]).
80-export([xhtml/2, escape_chars/1]).
81
82%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
83
84-include("test_server_internal.hrl").
85-include_lib("kernel/include/file.hrl").
86-define(suite_ext, "_SUITE").
87-define(log_ext, ".log.html").
88-define(src_listing_ext,  ".src.html").
89-define(logdir_ext, ".logs").
90-define(data_dir_suffix, "_data/").
91-define(suitelog_name, "suite.log").
92-define(suitelog_latest_name, "suite.log.latest").
93-define(coverlog_name, "cover.html").
94-define(raw_coverlog_name, "cover.log").
95-define(cross_coverlog_name, "cross_cover.html").
96-define(raw_cross_coverlog_name, "cross_cover.log").
97-define(cross_cover_info, "cross_cover.info").
98-define(cover_total, "total_cover.log").
99-define(unexpected_io_log, "unexpected_io.log.html").
100-define(last_file, "last_name").
101-define(last_link, "last_link").
102-define(last_test, "last_test").
103-define(html_ext, ".html").
104-define(now, os:timestamp()).
105
106-define(void_fun, fun() -> ok end).
107-define(mod_result(X), if X == skip -> skipped;
108			  X == auto_skip -> skipped;
109			  true -> X end).
110
111-define(auto_skip_color, "#FFA64D").
112-define(user_skip_color, "#FF8000").
113-define(sortable_table_name, "SortableTable").
114
115-record(state,{jobs=[], levels={1,19,10}, reject_io_reqs=false,
116	       multiply_timetraps=1, scale_timetraps=true,
117	       create_priv_dir=auto_per_run, finish=false,
118	       target_info, trc=false, cover=false, wait_for_node=[],
119	       testcase_callback=undefined, idle_notify=[],
120	       get_totals=false, random_seed=undefined}).
121
122%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
123%% OPERATOR INTERFACE
124
125add_dir(Name, Job=[Dir|_Dirs]) when is_list(Dir) ->
126    add_job(cast_to_list(Name),
127	    lists:map(fun(D)-> {dir,cast_to_list(D)} end, Job));
128add_dir(Name, Dir) ->
129    add_job(cast_to_list(Name), {dir,cast_to_list(Dir)}).
130
131add_dir(Name, Job=[Dir|_Dirs], Pattern) when is_list(Dir) ->
132    add_job(cast_to_list(Name),
133	    lists:map(fun(D)-> {dir,cast_to_list(D),
134				cast_to_list(Pattern)} end, Job));
135add_dir(Name, Dir, Pattern) ->
136    add_job(cast_to_list(Name), {dir,cast_to_list(Dir),cast_to_list(Pattern)}).
137
138add_module(Mod) when is_atom(Mod) ->
139    add_job(atom_to_list(Mod), {Mod,all}).
140
141add_module(Name, Mods) when is_list(Mods) ->
142    add_job(cast_to_list(Name), lists:map(fun(Mod) -> {Mod,all} end, Mods)).
143
144add_conf(Name, Mod, Conf) when is_tuple(Conf) ->
145    add_job(cast_to_list(Name), {Mod,[Conf]});
146
147add_conf(Name, Mod, Confs) when is_list(Confs) ->
148    add_job(cast_to_list(Name), {Mod,Confs}).
149
150add_case(Mod, Case) when is_atom(Mod), is_atom(Case) ->
151    add_job(atom_to_list(Mod), {Mod,Case}).
152
153add_case(Name, Mod, Case) when is_atom(Mod), is_atom(Case) ->
154    add_job(Name, {Mod,Case}).
155
156add_cases(Mod, Cases) when is_atom(Mod), is_list(Cases) ->
157    add_job(atom_to_list(Mod), {Mod,Cases}).
158
159add_cases(Name, Mod, Cases) when is_atom(Mod), is_list(Cases) ->
160    add_job(Name, {Mod,Cases}).
161
162add_spec(Spec) ->
163    Name = filename:rootname(Spec, ".spec"),
164    case filelib:is_file(Spec) of
165	true -> add_job(Name, {spec,Spec});
166	false -> {error,nofile}
167    end.
168
169%% This version of the interface is to be used if there are
170%% suites or cases that should be skipped.
171
172add_dir_with_skip(Name, Job=[Dir|_Dirs], Skip) when is_list(Dir) ->
173    add_job(cast_to_list(Name),
174	    lists:map(fun(D)-> {dir,cast_to_list(D)} end, Job),
175	    Skip);
176add_dir_with_skip(Name, Dir, Skip) ->
177    add_job(cast_to_list(Name), {dir,cast_to_list(Dir)}, Skip).
178
179add_dir_with_skip(Name, Job=[Dir|_Dirs], Pattern, Skip) when is_list(Dir) ->
180    add_job(cast_to_list(Name),
181	    lists:map(fun(D)-> {dir,cast_to_list(D),
182				cast_to_list(Pattern)} end, Job),
183	    Skip);
184add_dir_with_skip(Name, Dir, Pattern, Skip) ->
185    add_job(cast_to_list(Name),
186	    {dir,cast_to_list(Dir),cast_to_list(Pattern)}, Skip).
187
188add_module_with_skip(Mod, Skip) when is_atom(Mod) ->
189    add_job(atom_to_list(Mod), {Mod,all}, Skip).
190
191add_module_with_skip(Name, Mods, Skip) when is_list(Mods) ->
192    add_job(cast_to_list(Name), lists:map(fun(Mod) -> {Mod,all} end, Mods), Skip).
193
194add_conf_with_skip(Name, Mod, Conf, Skip) when is_tuple(Conf) ->
195    add_job(cast_to_list(Name), {Mod,[Conf]}, Skip);
196
197add_conf_with_skip(Name, Mod, Confs, Skip) when is_list(Confs) ->
198    add_job(cast_to_list(Name), {Mod,Confs}, Skip).
199
200add_case_with_skip(Mod, Case, Skip) when is_atom(Mod), is_atom(Case) ->
201    add_job(atom_to_list(Mod), {Mod,Case}, Skip).
202
203add_case_with_skip(Name, Mod, Case, Skip) when is_atom(Mod), is_atom(Case) ->
204    add_job(Name, {Mod,Case}, Skip).
205
206add_cases_with_skip(Mod, Cases, Skip) when is_atom(Mod), is_list(Cases) ->
207    add_job(atom_to_list(Mod), {Mod,Cases}, Skip).
208
209add_cases_with_skip(Name, Mod, Cases, Skip) when is_atom(Mod), is_list(Cases) ->
210    add_job(Name, {Mod,Cases}, Skip).
211
212add_tests_with_skip(LogDir, Tests, Skip) ->
213    add_job(LogDir,
214	    lists:map(fun({Dir,all,all}) ->
215			      {Dir,{dir,Dir}};
216			 ({Dir,Mods,all}) ->
217			      {Dir,lists:map(fun(M) -> {M,all} end, Mods)};
218			 ({Dir,Mod,Cases}) ->
219			      {Dir,{Mod,Cases}}
220		      end, Tests),
221	    Skip).
222
223%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
224%% COMMAND LINE INTERFACE
225
226parse_cmd_line(Cmds) ->
227    parse_cmd_line(Cmds, [], [], local, false, false, undefined).
228
229parse_cmd_line(['SPEC',Spec|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
230    case file:consult(Spec) of
231	{ok, TermList} ->
232	    Name = filename:rootname(Spec),
233	    parse_cmd_line(Cmds, TermList++SpecList, [Name|Names], Param,
234			   Trc, Cov, TCCB);
235	{error,Reason} ->
236	    io:format("Can't open ~tw: ~tp\n",[Spec, file:format_error(Reason)]),
237	    parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, TCCB)
238    end;
239parse_cmd_line(['NAME',Name|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
240    parse_cmd_line(Cmds, SpecList, [{name,atom_to_list(Name)}|Names],
241		   Param, Trc, Cov, TCCB);
242parse_cmd_line(['SKIPMOD',Mod|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
243    parse_cmd_line(Cmds, [{skip,{Mod,"by command line"}}|SpecList], Names,
244		   Param, Trc, Cov, TCCB);
245parse_cmd_line(['SKIPCASE',Mod,Case|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
246    parse_cmd_line(Cmds, [{skip,{Mod,Case,"by command line"}}|SpecList], Names,
247		   Param, Trc, Cov, TCCB);
248parse_cmd_line(['DIR',Dir|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
249    Name = filename:basename(Dir),
250    parse_cmd_line(Cmds, [{topcase,{dir,Name}}|SpecList], [Name|Names],
251		   Param, Trc, Cov, TCCB);
252parse_cmd_line(['MODULE',Mod|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
253    parse_cmd_line(Cmds,[{topcase,{Mod,all}}|SpecList],[atom_to_list(Mod)|Names],
254		   Param, Trc, Cov, TCCB);
255parse_cmd_line(['CASE',Mod,Case|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
256    parse_cmd_line(Cmds,[{topcase,{Mod,Case}}|SpecList],[atom_to_list(Mod)|Names],
257		   Param, Trc, Cov, TCCB);
258parse_cmd_line(['TRACE',Trc|Cmds], SpecList, Names, Param, _Trc, Cov, TCCB) ->
259    parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, TCCB);
260parse_cmd_line(['COVER',App,CF,Analyse|Cmds], SpecList, Names, Param, Trc, _Cov, TCCB) ->
261    parse_cmd_line(Cmds, SpecList, Names, Param, Trc, {{App,CF}, Analyse}, TCCB);
262parse_cmd_line(['TESTCASE_CALLBACK',Mod,Func|Cmds], SpecList, Names, Param, Trc, Cov, _) ->
263    parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, {Mod,Func});
264parse_cmd_line([Obj|_Cmds], _SpecList, _Names, _Param, _Trc, _Cov, _TCCB) ->
265    io:format("~w: Bad argument: ~tw\n", [?MODULE,Obj]),
266    io:format(" Use the `ts' module to start tests.\n", []),
267    io:format(" (If you ARE using `ts', there is a bug in `ts'.)\n", []),
268    halt(1);
269parse_cmd_line([], SpecList, Names, Param, Trc, Cov, TCCB) ->
270    NameList = lists:reverse(Names, ["suite"]),
271    Name = case lists:keysearch(name, 1, NameList) of
272	       {value,{name,N}} -> N;
273	       false -> hd(NameList)
274	   end,
275    {lists:reverse(SpecList), Name, Param, Trc, Cov, TCCB}.
276
277%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
278%% cast_to_list(X) -> string()
279%% X = list() | atom() | void()
280%% Returns a string representation of whatever was input
281
282cast_to_list(X) when is_list(X) -> X;
283cast_to_list(X) when is_atom(X) -> atom_to_list(X);
284cast_to_list(X) -> lists:flatten(io_lib:format("~tw", [X])).
285
286%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
287%% START INTERFACE
288
289%% Kept for backwards compatibility
290start(_) ->
291    start().
292start_link(_) ->
293    start_link().
294
295
296start() ->
297    case gen_server:start({local,?MODULE}, ?MODULE, [], []) of
298	{error, {already_started, Pid}} ->
299	    {ok, Pid};
300	Other ->
301	    Other
302    end.
303
304start_link() ->
305    case gen_server:start_link({local,?MODULE}, ?MODULE, [], []) of
306	{error, {already_started, Pid}} ->
307	    {ok, Pid};
308	Other ->
309	    Other
310    end.
311
312run_test(CommandLine) ->
313    process_flag(trap_exit,true),
314    {SpecList,Name,Param,Trc,Cov,TCCB} = parse_cmd_line(CommandLine),
315    {ok,_TSPid} = start_link(Param),
316    case Trc of
317	false -> ok;
318	File -> trc(File)
319    end,
320    case Cov of
321	false -> ok;
322	{{App,CoverFile},Analyse} -> cover(App, maybe_file(CoverFile), Analyse)
323    end,
324    testcase_callback(TCCB),
325    add_job(Name, {command_line,SpecList}),
326
327    wait_finish().
328
329%% Converted CoverFile to a string unless it is 'none'
330maybe_file(none) ->
331    none;
332maybe_file(CoverFile) ->
333    atom_to_list(CoverFile).
334
335idle_notify(Fun) ->
336    {ok, Pid} = controller_call({idle_notify,Fun}),
337    Pid.
338
339start_get_totals(Fun) ->
340    {ok, Pid} = controller_call({start_get_totals,Fun}),
341    Pid.
342
343stop_get_totals() ->
344    ok = controller_call(stop_get_totals),
345    ok.
346
347wait_finish() ->
348    OldTrap = process_flag(trap_exit, true),
349    {ok, Pid} = finish(true),
350    link(Pid),
351    receive
352	{'EXIT',Pid,_} ->
353	    ok
354    end,
355    process_flag(trap_exit, OldTrap),
356    ok.
357
358abort_current_testcase(Reason) ->
359    controller_call({abort_current_testcase,Reason}).
360
361abort() ->
362    OldTrap = process_flag(trap_exit, true),
363    {ok, Pid} = finish(abort),
364    link(Pid),
365    receive
366	{'EXIT',Pid,_} ->
367	    ok
368    end,
369    process_flag(trap_exit, OldTrap),
370    ok.
371
372finish(Abort) ->
373    controller_call({finish,Abort}).
374
375stop() ->
376    controller_call(stop).
377
378jobs() ->
379    controller_call(jobs).
380
381get_levels() ->
382    controller_call(get_levels).
383
384set_levels(Show, Major, Minor) ->
385    controller_call({set_levels,Show,Major,Minor}).
386
387reject_io_reqs(Bool) ->
388    controller_call({reject_io_reqs,Bool}).
389
390multiply_timetraps(N) ->
391    controller_call({multiply_timetraps,N}).
392
393scale_timetraps(Bool) ->
394    controller_call({scale_timetraps,Bool}).
395
396get_timetrap_parameters() ->
397    controller_call(get_timetrap_parameters).
398
399create_priv_dir(Value) ->
400    controller_call({create_priv_dir,Value}).
401
402trc(TraceFile) ->
403    controller_call({trace,TraceFile}, 2*?ACCEPT_TIMEOUT).
404
405stop_trace() ->
406    controller_call(stop_trace).
407
408node_started(Node) ->
409    gen_server:cast(?MODULE, {node_started,Node}).
410
411cover(App, Analyse) when is_atom(App) ->
412    cover(App, none, Analyse);
413cover(CoverFile, Analyse) ->
414    cover(none, CoverFile, Analyse).
415cover(App, CoverFile, Analyse) ->
416    {Excl,Incl,Cross} = read_cover_file(CoverFile),
417    CoverInfo = #cover{app=App,
418		       file=CoverFile,
419		       excl=Excl,
420		       incl=Incl,
421		       cross=Cross,
422		       level=Analyse},
423    controller_call({cover,CoverInfo}).
424
425cover(CoverInfo) ->
426    controller_call({cover,CoverInfo}).
427
428cover_compile(App,File,Excl,Incl,Cross,Analyse,Stop) ->
429    cover_compile(#cover{app=App,
430			 file=File,
431			 excl=Excl,
432			 incl=Incl,
433			 cross=Cross,
434			 level=Analyse,
435			 stop=Stop}).
436
437testcase_callback(ModFunc) ->
438    controller_call({testcase_callback,ModFunc}).
439
440set_random_seed(Seed) ->
441    controller_call({set_random_seed,Seed}).
442
443kill_slavenodes() ->
444    controller_call(kill_slavenodes).
445
446get_hosts() ->
447    get(test_server_hosts).
448
449%%--------------------------------------------------------------------
450
451add_job(Name, TopCase) ->
452    add_job(Name, TopCase, []).
453
454add_job(Name, TopCase, Skip) ->
455    SuiteName =
456	case Name of
457	    "." -> "current_dir";
458	    ".." -> "parent_dir";
459	    Other -> Other
460	end,
461    Dir = filename:absname(SuiteName),
462    controller_call({add_job,Dir,SuiteName,TopCase,Skip}).
463
464controller_call(Arg) ->
465    case catch gen_server:call(?MODULE, Arg, infinity) of
466	{'EXIT',{{badarg,_},{gen_server,call,_}}} ->
467	    exit(test_server_ctrl_not_running);
468	{'EXIT',Reason} ->
469	    exit(Reason);
470	Other ->
471	    Other
472    end.
473controller_call(Arg, Timeout) ->
474    case catch gen_server:call(?MODULE, Arg, Timeout) of
475	{'EXIT',{{badarg,_},{gen_server,call,_}}} ->
476	    exit(test_server_ctrl_not_running);
477	{'EXIT',Reason} ->
478	    exit(Reason);
479	Other ->
480	    Other
481    end.
482
483
484%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
485
486%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
487%% init([])
488%%
489%% init() is the init function of the test_server's gen_server.
490%%
491init([]) ->
492    case os:getenv("TEST_SERVER_CALL_TRACE") of
493	false ->
494	    ok;
495	"" ->
496	    ok;
497	TraceSpec ->
498	    test_server_sup:call_trace(TraceSpec)
499    end,
500    process_flag(trap_exit, true),
501    %% copy format_exception setting from init arg to application environment
502    case init:get_argument(test_server_format_exception) of
503	{ok,[[TSFE]]} ->
504	    application:set_env(test_server, format_exception, list_to_atom(TSFE));
505	_ ->
506	    ok
507    end,
508    test_server_sup:cleanup_crash_dumps(),
509    test_server_sup:util_start(),
510    State = #state{jobs=[],finish=false},
511    TI0 = test_server:init_target_info(),
512    TargetHost = test_server_sup:hoststr(),
513    TI = TI0#target_info{host=TargetHost,
514			 naming=naming(),
515			 master=TargetHost},
516    _ = ets:new(slave_tab, [named_table,set,public,{keypos,2}]),
517    set_hosts([TI#target_info.host]),
518    {ok,State#state{target_info=TI}}.
519
520naming() ->
521    case lists:member($., test_server_sup:hoststr()) of
522	true -> "-name";
523	false -> "-sname"
524    end.
525
526
527%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
528%% handle_call(kill_slavenodes, From, State) -> ok
529%%
530%% Kill all slave nodes that remain after a test case
531%% is completed.
532%%
533handle_call(kill_slavenodes, _From, State) ->
534    Nodes = test_server_node:kill_nodes(),
535    {reply, Nodes, State};
536
537%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
538%% handle_call({set_hosts, HostList}, From, State) -> ok
539%%
540%% Set the global hostlist.
541%%
542handle_call({set_hosts, Hosts}, _From, State) ->
543    set_hosts(Hosts),
544    {reply, ok, State};
545
546%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
547%% handle_call(get_hosts, From, State) -> [Hosts]
548%%
549%% Returns the lists of hosts that the test server
550%% can use for slave nodes. This is primarily used
551%% for nodename generation.
552%%
553handle_call(get_hosts, _From, State) ->
554    Hosts = get_hosts(),
555    {reply, Hosts, State};
556
557%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
558%% handle_call({add_job,Dir,Name,TopCase,Skip}, _, State) ->
559%%     ok | {error,Reason}
560%%
561%% Dir = string()
562%% Name = string()
563%% TopCase = term()
564%% Skip = [SkipItem]
565%% SkipItem = {Mod,Comment} | {Mod,Case,Comment} | {Mod,Cases,Comment}
566%% Mod = Case = atom()
567%% Comment = string()
568%% Cases = [Case]
569%%
570%% Adds a job to the job queue. The name of the job is Name. A log directory
571%% will be created in Dir/Name.logs. TopCase may be anything that
572%% collect_cases/3 accepts, plus the following:
573%%
574%% {spec,SpecName} executes the named test suite specification file. Commands
575%% in the file should be in the format accepted by do_spec_list/1.
576%%
577%% {command_line,SpecList} executes the list of specification instructions
578%% supplied, which should be in the format accepted by do_spec_list/1.
579
580handle_call({add_job,Dir,Name,TopCase,Skip}, _From, State) ->
581    LogDir = Dir ++ ?logdir_ext,
582    ExtraTools =
583	case State#state.cover of
584	    false -> [];
585	    CoverInfo -> [{cover,CoverInfo}]
586	end,
587    ExtraTools1 =
588	case State#state.random_seed of
589	    undefined -> ExtraTools;
590	    Seed -> [{random_seed,Seed}|ExtraTools]
591	end,
592    case lists:keysearch(Name, 1, State#state.jobs) of
593	false ->
594	    case TopCase of
595		{spec,SpecName} ->
596		    Pid = spawn_tester(
597			    ?MODULE, do_spec,
598			    [SpecName,{State#state.multiply_timetraps,
599				       State#state.scale_timetraps}],
600			    LogDir, Name, State#state.levels,
601			    State#state.reject_io_reqs,
602			    State#state.create_priv_dir,
603			    State#state.testcase_callback, ExtraTools1),
604		    NewJobs = [{Name,Pid}|State#state.jobs],
605		    {reply, ok, State#state{jobs=NewJobs}};
606		{command_line,SpecList} ->
607		    Pid = spawn_tester(
608			    ?MODULE, do_spec_list,
609			    [SpecList,{State#state.multiply_timetraps,
610				       State#state.scale_timetraps}],
611			    LogDir, Name, State#state.levels,
612			    State#state.reject_io_reqs,
613			    State#state.create_priv_dir,
614			    State#state.testcase_callback, ExtraTools1),
615		    NewJobs = [{Name,Pid}|State#state.jobs],
616		    {reply, ok, State#state{jobs=NewJobs}};
617		TopCase ->
618		    case State#state.get_totals of
619			{CliPid,Fun} ->
620			    Result = count_test_cases(TopCase, Skip),
621			    Fun(CliPid, Result),
622			    {reply, ok, State};
623			_ ->
624			    Cfg = make_config([]),
625			    Pid = spawn_tester(
626				    ?MODULE, do_test_cases,
627				    [TopCase,Skip,Cfg,
628				     {State#state.multiply_timetraps,
629				      State#state.scale_timetraps}],
630				    LogDir, Name, State#state.levels,
631				    State#state.reject_io_reqs,
632				    State#state.create_priv_dir,
633				    State#state.testcase_callback, ExtraTools1),
634			    NewJobs = [{Name,Pid}|State#state.jobs],
635			    {reply, ok, State#state{jobs=NewJobs}}
636		    end
637	    end;
638	_ ->
639	    {reply,{error,name_already_in_use},State}
640    end;
641
642%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
643%% handle_call(jobs, _, State) -> JobList
644%% JobList = [{Name,Pid}, ...]
645%% Name = string()
646%% Pid = pid()
647%%
648%% Return the list of current jobs.
649
650handle_call(jobs, _From, State) ->
651    {reply,State#state.jobs,State};
652
653
654%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
655%% handle_call({abort_current_testcase,Reason}, _, State) -> Result
656%% Reason = term()
657%% Result = ok | {error,no_testcase_running}
658%%
659%% Attempts to abort the test case that's currently running.
660
661handle_call({abort_current_testcase,Reason}, _From, State) ->
662    case State#state.jobs of
663	[{_,Pid}|_] ->
664	    Pid ! {abort_current_testcase,Reason,self()},
665	    receive
666		{Pid,abort_current_testcase,Result} ->
667		    {reply, Result, State}
668	    after 10000 ->
669		    {reply, {error,no_testcase_running}, State}
670	    end;
671	_ ->
672	    {reply, {error,no_testcase_running}, State}
673    end;
674
675%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
676%% handle_call({finish,Fini}, _, State) -> {ok,Pid}
677%% Fini = true | abort
678%%
679%% Tells the test_server to stop as soon as there are no test suites
680%% running. Immediately if none are running. Abort is handled as soon
681%% as current test finishes.
682
683handle_call({finish,Fini}, _From, State) ->
684    case State#state.jobs of
685	[] ->
686	    lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Fini) end,
687			  State#state.idle_notify),
688	    State2 = State#state{finish=false},
689	    {stop,shutdown,{ok,self()}, State2};
690	_SomeJobs ->
691	    State2 = State#state{finish=Fini},
692	    {reply, {ok,self()}, State2}
693    end;
694
695%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
696%% handle_call({idle_notify,Fun}, From, State) -> {ok,Pid}
697%%
698%% Lets a test client subscribe to receive a notification when the
699%% test server becomes idle (can be used to syncronize jobs).
700%% test_server calls Fun(From) when idle.
701
702handle_call({idle_notify,Fun}, {Cli,_Ref}, State) ->
703    case State#state.jobs of
704	[] -> self() ! report_idle;
705	_  -> ok
706    end,
707    Subscribed = State#state.idle_notify,
708    {reply, {ok,self()}, State#state{idle_notify=[{Cli,Fun}|Subscribed]}};
709
710%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
711%% handle_call(start_get_totals, From, State) -> {ok,Pid}
712%%
713%% Switch on the mode where the test server will only
714%% report back the number of tests it would execute
715%% given some subsequent jobs.
716
717handle_call({start_get_totals,Fun}, {Cli,_Ref}, State) ->
718    {reply, {ok,self()}, State#state{get_totals={Cli,Fun}}};
719
720%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
721%% handle_call(stop_get_totals, From, State) -> ok
722%%
723%% Lets a test client subscribe to receive a notification when the
724%% test server becomes idle (can be used to syncronize jobs).
725%% test_server calls Fun(From) when idle.
726
727handle_call(stop_get_totals, {_Cli,_Ref}, State) ->
728    {reply, ok, State#state{get_totals=false}};
729
730%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
731%% handle_call(get_levels, _, State) -> {Show,Major,Minor}
732%% Show = integer()
733%% Major = integer()
734%% Minor = integer()
735%%
736%% Returns a 3-tuple with the logging thresholds.
737%% All output and information from a test suite is tagged with a detail
738%% level. Lower values are more "important". Text that is output using
739%% io:format or similar is automatically tagged with detail level 50.
740%%
741%% All output with detail level:
742%% less or equal to Show is displayed on the screen (default 1)
743%% less or equal to Major is logged in the major log file (default 19)
744%% greater or equal to Minor is logged in the minor log files (default 10)
745
746handle_call(get_levels, _From, State) ->
747    {reply,State#state.levels,State};
748
749%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
750%% handle_call({set_levels,Show,Major,Minor}, _, State) -> ok
751%% Show = integer()
752%% Major = integer()
753%% Minor = integer()
754%%
755%% Sets the logging thresholds, see handle_call(get_levels,...) above.
756
757handle_call({set_levels,Show,Major,Minor}, _From, State) ->
758    {reply,ok,State#state{levels={Show,Major,Minor}}};
759
760%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
761%% handle_call({reject_io_reqs,Bool}, _, State) -> ok
762%% Bool = bool()
763%%
764%% May be used to switch off stdout printouts to the minor log file
765
766handle_call({reject_io_reqs,Bool}, _From, State) ->
767    {reply,ok,State#state{reject_io_reqs=Bool}};
768
769%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
770%% handle_call({multiply_timetraps,N}, _, State) -> ok
771%% N = number() | infinity
772%%
773%% Multiplies all timetraps set by test cases with N
774
775handle_call({multiply_timetraps,N}, _From, State) ->
776    {reply,ok,State#state{multiply_timetraps=N}};
777
778%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
779%% handle_call({scale_timetraps,Bool}, _, State) -> ok
780%% Bool = true | false
781%%
782%% Specifies if test_server should scale the timetrap value
783%% automatically if e.g. cover is running.
784
785handle_call({scale_timetraps,Bool}, _From, State) ->
786    {reply,ok,State#state{scale_timetraps=Bool}};
787
788%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
789%% handle_call(get_timetrap_parameters, _, State) -> {Multiplier,Scale}
790%% Multiplier = integer() | infinity
791%% Scale = true | false
792%%
793%% Returns the parameter values that affect timetraps.
794
795handle_call(get_timetrap_parameters, _From, State) ->
796    {reply,{State#state.multiply_timetraps,State#state.scale_timetraps},State};
797
798%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
799%% handle_call({trace,TraceFile}, _, State) -> ok | {error,Reason}
800%%
801%% Starts a separate node (trace control node) which
802%% starts tracing on target and all slave nodes
803%%
804%% TraceFile is a text file with elements of type
805%% {Trace,Mod,TracePattern}.
806%% {Trace,Mod,Func,TracePattern}.
807%% {Trace,Mod,Func,Arity,TracePattern}.
808%%
809%% Trace = tp | tpl;  local or global call trace
810%% Mod,Func = atom(), Arity=integer(); defines what to trace
811%% TracePattern = [] | match_spec()
812%%
813%% The 'call' trace flag is set on all processes, and then
814%% the given trace patterns are set.
815
816handle_call({trace,TraceFile}, _From, State=#state{trc=false}) ->
817    TI = State#state.target_info,
818    case test_server_node:start_tracer_node(TraceFile, TI) of
819	{ok,Tracer} -> {reply,ok,State#state{trc=Tracer}};
820	Error -> {reply,Error,State}
821    end;
822handle_call({trace,_TraceFile}, _From, State) ->
823    {reply,{error,already_tracing},State};
824
825%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
826%% handle_call(stop_trace, _, State) -> ok | {error,Reason}
827%%
828%% Stops tracing on target and all slave nodes and
829%% terminates trace control node
830
831handle_call(stop_trace, _From, State=#state{trc=false}) ->
832    {reply,{error,not_tracing},State};
833handle_call(stop_trace, _From, State) ->
834    R = test_server_node:stop_tracer_node(State#state.trc),
835    {reply,R,State#state{trc=false}};
836
837%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
838%% handle_call({cover,CoverInfo}, _, State) -> ok | {error,Reason}
839%%
840%% Set specification of cover analysis to be used when running tests
841%% (see start_extra_tools/1 and stop_extra_tools/1)
842
843handle_call({cover,CoverInfo}, _From, State) ->
844    {reply,ok,State#state{cover=CoverInfo}};
845
846%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
847%% handle_call({create_priv_dir,Value}, _, State) -> ok | {error,Reason}
848%%
849%% Set create_priv_dir to either auto_per_run (create common priv dir once
850%% per test run), manual_per_tc (the priv dir name will be unique for each
851%% test case, but the user has to call test_server:make_priv_dir/0 to create
852%% it), or auto_per_tc (unique priv dir created automatically for each test
853%% case).
854
855handle_call({create_priv_dir,Value}, _From, State) ->
856    {reply,ok,State#state{create_priv_dir=Value}};
857
858%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
859%% handle_call({testcase_callback,{Mod,Func}}, _, State) -> ok | {error,Reason}
860%%
861%% Add a callback function that will be called before and after every
862%% test case (on the test case process):
863%%
864%% Mod:Func(Suite,TestCase,InitOrEnd,Config)
865%%
866%% InitOrEnd = init | 'end'.
867
868handle_call({testcase_callback,ModFunc}, _From, State) ->
869    case ModFunc of
870	{Mod,Func} ->
871	    _ = case code:is_loaded(Mod) of
872		{file,_} ->
873		    ok;
874		false ->
875		    code:load_file(Mod)
876	    end,
877	    case erlang:function_exported(Mod,Func,4) of
878		true ->
879		    ok;
880		false ->
881		    io:format(user,
882			      "WARNING! Callback function ~w:~tw/4 undefined.~n~n",
883			      [Mod,Func])
884	    end;
885	_ ->
886	    ok
887    end,
888    {reply,ok,State#state{testcase_callback=ModFunc}};
889
890%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
891%% handle_call({set_random_seed,Seed}, _, State) -> ok | {error,Reason}
892%%
893%% Let operator set a random seed value to be used e.g. for shuffling
894%% test cases.
895
896handle_call({set_random_seed,Seed}, _From, State) ->
897    {reply,ok,State#state{random_seed=Seed}};
898
899%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
900%% handle_call(stop, _, State) -> ok
901%%
902%% Stops the test server immediately.
903%% Some cleanup is done by terminate/2
904
905handle_call(stop, _From, State) ->
906    {stop, shutdown, ok, State};
907
908%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
909%% handle_call(get_target_info, _, State) -> TI
910%%
911%% TI = #target_info{}
912%%
913%% Returns information about target
914
915handle_call(get_target_info, _From, State) ->
916    {reply, State#state.target_info, State};
917
918%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
919%% handle_call({start_node,Name,Type,Options}, _, State) ->
920%%     ok | {error,Reason}
921%%
922%% Starts a new node (slave or peer)
923
924handle_call({start_node, Name, Type, Options}, From, State) ->
925    %% test_server_ctrl does gen_server:reply/2 explicitly
926    test_server_node:start_node(Name, Type, Options, From,
927				State#state.target_info),
928    {noreply,State};
929
930
931%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
932%% handle_call({wait_for_node,Node}, _, State) -> ok
933%%
934%% Waits for a new node to take contact. Used if
935%% node is started with option {wait,false}
936
937handle_call({wait_for_node, Node}, From, State) ->
938    NewWaitList =
939	case ets:lookup(slave_tab,Node) of
940	    [] ->
941		[{Node,From}|State#state.wait_for_node];
942	    _ ->
943		gen_server:reply(From,ok),
944		State#state.wait_for_node
945	end,
946    {noreply,State#state{wait_for_node=NewWaitList}};
947
948%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
949%% handle_call({stop_node,Name}, _, State) -> ok | {error,Reason}
950%%
951%% Stops a slave or peer node. This is actually only some cleanup
952%% - the node is really stopped by test_server when this returns.
953
954handle_call({stop_node, Name}, _From, State) ->
955    R = test_server_node:stop_node(Name),
956    {reply, R, State};
957
958%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
959%% handle_call({is_release_available,Name}, _, State) -> ok | {error,Reason}
960%%
961%% Tests if the release is available.
962
963handle_call({is_release_available, Release}, _From, State) ->
964    R = test_server_node:is_release_available(Release),
965    {reply, R, State}.
966
967%%--------------------------------------------------------------------
968set_hosts(Hosts) ->
969    put(test_server_hosts, Hosts).
970
971%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
972%% handle_cast({node_started,Name}, _, State)
973%%
974%% Called by test_server_node when a slave/peer node is fully started.
975
976handle_cast({node_started,Node}, State) ->
977    case State#state.trc of
978	false -> ok;
979	Trc -> test_server_node:trace_nodes(Trc, [Node])
980    end,
981    NewWaitList =
982	case lists:keysearch(Node,1,State#state.wait_for_node) of
983	    {value,{Node,From}} ->
984		gen_server:reply(From, ok),
985		lists:keydelete(Node, 1, State#state.wait_for_node);
986	    false ->
987		State#state.wait_for_node
988	end,
989    {noreply, State#state{wait_for_node=NewWaitList}}.
990
991%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
992%% handle_info({'EXIT',Pid,Reason}, State)
993%% Pid = pid()
994%% Reason = term()
995%%
996%% Handles exit messages from linked processes. Only test suites are
997%% expected to be linked.  When a test suite terminates, it is removed
998%% from the job queue.
999
1000handle_info(report_idle, State) ->
1001    Finish = State#state.finish,
1002    lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end,
1003		  State#state.idle_notify),
1004    {noreply,State#state{idle_notify=[]}};
1005
1006
1007handle_info({'EXIT',Pid,Reason}, State) ->
1008    case lists:keysearch(Pid,2,State#state.jobs) of
1009	false ->
1010	    %% not our problem
1011	    {noreply,State};
1012	{value,{Name,_}} ->
1013	    NewJobs = lists:keydelete(Pid, 2, State#state.jobs),
1014	    case Reason of
1015		normal ->
1016		    fine;
1017		killed ->
1018		    io:format("Suite ~ts was killed\n", [Name]);
1019		_Other ->
1020		    io:format("Suite ~ts was killed with reason ~tp\n",
1021			      [Name,Reason])
1022	    end,
1023	    State2 = State#state{jobs=NewJobs},
1024	    Finish = State2#state.finish,
1025	    case NewJobs of
1026		[] ->
1027		    lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end,
1028				  State2#state.idle_notify),
1029		    case Finish of
1030			false ->
1031			    {noreply,State2#state{idle_notify=[]}};
1032			_ ->			% true | abort
1033			    %% test_server:finish() has been called and
1034			    %% there are no jobs in the job queue =>
1035			    %% stop the test_server_ctrl
1036			    {stop,shutdown,State2#state{finish=false}}
1037		    end;
1038		_ ->				% pending jobs
1039		    case Finish of
1040			abort ->		% abort test now!
1041			    lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end,
1042					  State2#state.idle_notify),
1043			    {stop,shutdown,State2#state{finish=false}};
1044			_ ->			% true | false
1045			    {noreply, State2}
1046		    end
1047	    end
1048    end;
1049
1050
1051%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1052%% handle_info({tcp_closed,Sock}, State)
1053%%
1054%% A Socket was closed. This indicates that a node died.
1055%% This can be
1056%% *Slave or peer node started by a test suite
1057%% *Trace controll node
1058
1059handle_info({tcp_closed,Sock}, State=#state{trc=Sock}) ->
1060    %% Tracer node died - can't really do anything
1061    %%! Maybe print something???
1062    {noreply,State#state{trc=false}};
1063handle_info({tcp_closed,Sock}, State) ->
1064    test_server_node:nodedown(Sock),
1065    {noreply,State};
1066handle_info(_, State) ->
1067    %% dummy; accept all, do nothing.
1068    {noreply, State}.
1069
1070%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1071%% terminate(Reason, State) -> ok
1072%% Reason = term()
1073%%
1074%% Cleans up when the test_server is terminating. Kills the running
1075%% test suites (if any) and any possible remainting slave node
1076
1077terminate(_Reason, State) ->
1078    test_server_sup:util_stop(),
1079    case State#state.trc of
1080	false -> ok;
1081	Sock -> test_server_node:stop_tracer_node(Sock)
1082    end,
1083    ok = kill_all_jobs(State#state.jobs),
1084    _ = test_server_node:kill_nodes(),
1085    ok.
1086
1087kill_all_jobs([{_Name,JobPid}|Jobs]) ->
1088    exit(JobPid, kill),
1089    kill_all_jobs(Jobs);
1090kill_all_jobs([]) ->
1091    ok.
1092
1093
1094%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1095%%----------------------- INTERNAL FUNCTIONS -----------------------%%
1096%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1097
1098%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1099%% spawn_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs,
1100%%              CreatePrivDir, TestCaseCallback, ExtraTools) -> Pid
1101%% Mod = atom()
1102%% Func = atom()
1103%% Args = [term(),...]
1104%% Dir = string()
1105%% Name = string()
1106%% Levels = {integer(),integer(),integer()}
1107%% RejectIoReqs = bool()
1108%% CreatePrivDir = auto_per_run | manual_per_tc | auto_per_tc
1109%% TestCaseCallback = {CBMod,CBFunc} | undefined
1110%% ExtraTools = [ExtraTool,...]
1111%% ExtraTool = CoverInfo | TraceInfo | RandomSeed
1112%%
1113%% Spawns a test suite execute-process, just an ordinary spawn, except
1114%% that it will set a lot of dictionary information before starting the
1115%% named function. Also, the execution is timed and protected by a catch.
1116%% When the named function is done executing, a summary of the results
1117%% is printed to the log files.
1118
1119spawn_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs,
1120	     CreatePrivDir, TCCallback, ExtraTools) ->
1121    spawn_link(fun() ->
1122	      init_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs,
1123			   CreatePrivDir, TCCallback, ExtraTools)
1124      end).
1125
1126init_tester(Mod, Func, Args, Dir, Name, {_,_,MinLev}=Levels,
1127	    RejectIoReqs, CreatePrivDir, TCCallback, ExtraTools) ->
1128    process_flag(trap_exit, true),
1129    _ = test_server_io:start_link(),
1130    put(app, common_test),
1131    put(test_server_name, Name),
1132    put(test_server_dir, Dir),
1133    put(test_server_total_time, 0),
1134    put(test_server_ok, 0),
1135    put(test_server_failed, 0),
1136    put(test_server_skipped, {0,0}),
1137    put(test_server_minor_level, MinLev),
1138    put(test_server_create_priv_dir, CreatePrivDir),
1139    put(test_server_random_seed, proplists:get_value(random_seed, ExtraTools)),
1140    put(test_server_testcase_callback, TCCallback),
1141    case os:getenv("TEST_SERVER_FRAMEWORK") of
1142	FW when FW =:= false; FW =:= "undefined" ->
1143	    put(test_server_framework, '$none');
1144	FW ->
1145	    put(test_server_framework_name, list_to_atom(FW)),
1146	    case os:getenv("TEST_SERVER_FRAMEWORK_NAME") of
1147		FWName when FWName =:= false; FWName =:= "undefined" ->
1148		    put(test_server_framework_name, '$none');
1149		FWName ->
1150		    put(test_server_framework_name, list_to_atom(FWName))
1151	    end
1152    end,
1153
1154    %% before first print, read and set logging options
1155    FWLogDir =
1156        case test_server_sup:framework_call(get_log_dir, [], []) of
1157            {ok,FwDir} -> FwDir;
1158            _          -> filename:dirname(Dir)
1159        end,
1160    put(test_server_framework_logdir, FWLogDir),
1161    LogOpts = test_server_sup:framework_call(get_logopts, [], []),
1162    put(test_server_logopts, LogOpts),
1163
1164    StartedExtraTools = start_extra_tools(ExtraTools),
1165
1166    test_server_io:set_job_name(Name),
1167    test_server_io:set_gl_props([{levels,Levels},
1168				 {auto_nl,not lists:member(no_nl, LogOpts)},
1169				 {reject_io_reqs,RejectIoReqs}]),
1170    group_leader(test_server_io:get_gl(true), self()),
1171    {TimeMy,Result} = ts_tc(Mod, Func, Args),
1172    set_io_buffering(undefined),
1173    test_server_io:set_job_name(undefined),
1174    catch stop_extra_tools(StartedExtraTools),
1175    case Result of
1176	{'EXIT',test_suites_done} ->
1177	    ok;
1178	{'EXIT',_Pid,Reason} ->
1179	    print(1, "EXIT, reason ~tp", [Reason]);
1180	{'EXIT',Reason} ->
1181	    report_severe_error(Reason),
1182	    print(1, "EXIT, reason ~tp", [Reason])
1183    end,
1184    Time = TimeMy/1000000,
1185    SuccessStr =
1186	case get(test_server_failed) of
1187	    0 -> "Ok";
1188	    _ -> "FAILED"
1189	end,
1190    {SkippedN,SkipStr} =
1191	case get(test_server_skipped) of
1192	    {0,0} ->
1193		{0,""};
1194	    {USkipped,ASkipped} ->
1195		Skipped = USkipped+ASkipped,
1196		{Skipped,io_lib:format(", ~w Skipped", [Skipped])}
1197	end,
1198    OkN = get(test_server_ok),
1199    FailedN = get(test_server_failed),
1200    print(html,"\n</tbody>\n<tfoot>\n"
1201	  "<tr><td></td><td><b>TOTAL</b></td><td></td><td></td><td></td>"
1202	  "<td>~.3fs</td><td><b>~ts</b></td><td>~w Ok, ~w Failed~ts of ~w</td></tr>\n"
1203	  "</tfoot>\n",
1204	  [Time,SuccessStr,OkN,FailedN,SkipStr,OkN+FailedN+SkippedN]),
1205
1206    test_server_io:stop([major,html,unexpected_io]),
1207    {UnexpectedIoName,UnexpectedIoFooter} = get(test_server_unexpected_footer),
1208    {ok,UnexpectedIoFd} = open_html_file(UnexpectedIoName, [append]),
1209    io:put_chars(UnexpectedIoFd, "\n</pre>\n"++UnexpectedIoFooter),
1210    ok = file:close(UnexpectedIoFd).
1211
1212report_severe_error(Reason) ->
1213    test_server_sup:framework_call(report, [severe_error,Reason]).
1214
1215ts_tc(M,F,A) ->
1216    Before = erlang:monotonic_time(),
1217    Result = (catch apply(M, F, A)),
1218    After   = erlang:monotonic_time(),
1219    Elapsed = erlang:convert_time_unit(After-Before,
1220				       native,
1221				       micro_seconds),
1222    {Elapsed, Result}.
1223
1224start_extra_tools(ExtraTools) ->
1225    start_extra_tools(ExtraTools, []).
1226start_extra_tools([{cover,CoverInfo} | ExtraTools], Started) ->
1227    case start_cover(CoverInfo) of
1228	{ok,NewCoverInfo} ->
1229	    start_extra_tools(ExtraTools,[{cover,NewCoverInfo}|Started]);
1230	{error,_} ->
1231	    start_extra_tools(ExtraTools, Started)
1232    end;
1233start_extra_tools([_ | ExtraTools], Started) ->
1234    start_extra_tools(ExtraTools, Started);
1235start_extra_tools([], Started) ->
1236    Started.
1237
1238stop_extra_tools(ExtraTools) ->
1239    TestDir = get(test_server_log_dir_base),
1240    case lists:keymember(cover, 1, ExtraTools) of
1241	false ->
1242	    write_default_coverlog(TestDir);
1243	true ->
1244	    ok
1245    end,
1246    stop_extra_tools(ExtraTools, TestDir).
1247
1248stop_extra_tools([{cover,CoverInfo}|ExtraTools], TestDir) ->
1249    stop_cover(CoverInfo,TestDir),
1250    stop_extra_tools(ExtraTools, TestDir);
1251%%stop_extra_tools([_ | ExtraTools], TestDir) ->
1252%%    stop_extra_tools(ExtraTools, TestDir);
1253stop_extra_tools([], _) ->
1254    ok.
1255
1256
1257%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1258%% do_spec(SpecName, TimetrapSpec) -> {error,Reason} | exit(Result)
1259%% SpecName = string()
1260%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap}
1261%% MultiplyTimetrap = integer() | infinity
1262%% ScaleTimetrap = bool()
1263%%
1264%% Reads the named test suite specification file, and executes it.
1265%%
1266%% This function is meant to be called by a process created by
1267%% spawn_tester/10, which sets up some necessary dictionary values.
1268
1269do_spec(SpecName, TimetrapSpec) when is_list(SpecName) ->
1270    case file:consult(SpecName) of
1271	{ok,TermList} ->
1272	    do_spec_list(TermList,TimetrapSpec);
1273	{error,Reason} ->
1274	    io:format("Can't open ~ts: ~tp\n", [SpecName,Reason]),
1275	    {error,{cant_open_spec,Reason}}
1276    end.
1277
1278%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1279%% do_spec_list(TermList, TimetrapSpec) -> exit(Result)
1280%% TermList = [term()|...]
1281%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap}
1282%% MultiplyTimetrap = integer() | infinity
1283%% ScaleTimetrap = bool()
1284%%
1285%% Executes a list of test suite specification commands. The following
1286%% commands are available, and may occur zero or more times (if several,
1287%% the contents is appended):
1288%%
1289%% {topcase,TopCase} Specifies top level test goals. TopCase has the syntax
1290%% specified by collect_cases/3.
1291%%
1292%% {skip,Skip} Specifies test cases to skip, and lists requirements that
1293%% cannot be granted during the test run. Skip has the syntax specified
1294%% by collect_cases/3.
1295%%
1296%% {nodes,Nodes} Lists node names avaliable to the test suites. Nodes have
1297%% the syntax specified by collect_cases/3.
1298%%
1299%% {require_nodenames, Num} Specifies how many nodenames the test suite will
1300%% need. Theese are automaticly generated and inserted into the Config by the
1301%% test_server. The caller may specify other hosts to run theese nodes by
1302%% using the {hosts, Hosts} option. If there are no hosts specified, all
1303%% nodenames will be generated from the local host.
1304%%
1305%% {hosts, Hosts} Specifies a list of available hosts on which to start
1306%% slave nodes. It is used when the {remote, true} option is given to the
1307%% test_server:start_node/3 function. Also, if {require_nodenames, Num} is
1308%% contained in the TermList, the generated nodenames will be spread over
1309%% all hosts given in this Hosts list. The hostnames are given as atoms or
1310%% strings.
1311%%
1312%% {diskless, true}</c></tag> is kept for backwards compatiblilty and
1313%% should not be used. Use a configuration test case instead.
1314%%
1315%% This function is meant to be called by a process created by
1316%% spawn_tester/10, which sets up some necessary dictionary values.
1317
1318do_spec_list(TermList0, TimetrapSpec) ->
1319    Nodes = [],
1320    TermList =
1321	case lists:keysearch(hosts, 1, TermList0) of
1322	    {value, {hosts, Hosts0}} ->
1323		Hosts = lists:map(fun(H) -> cast_to_list(H) end, Hosts0),
1324		controller_call({set_hosts, Hosts}),
1325		lists:keydelete(hosts, 1, TermList0);
1326	    _ ->
1327		TermList0
1328	end,
1329    DefaultConfig = make_config([{nodes,Nodes}]),
1330    {TopCases,SkipList,Config} = do_spec_terms(TermList, [], [], DefaultConfig),
1331    do_test_cases(TopCases, SkipList, Config, TimetrapSpec).
1332
1333do_spec_terms([], TopCases, SkipList, Config) ->
1334    {TopCases,SkipList,Config};
1335do_spec_terms([{topcase,TopCase}|Terms], TopCases, SkipList, Config) ->
1336    do_spec_terms(Terms,[TopCase|TopCases], SkipList, Config);
1337do_spec_terms([{skip,Skip}|Terms], TopCases, SkipList, Config) ->
1338    do_spec_terms(Terms, TopCases, [Skip|SkipList], Config);
1339do_spec_terms([{nodes,Nodes}|Terms], TopCases, SkipList, Config) ->
1340    do_spec_terms(Terms, TopCases, SkipList,
1341		  update_config(Config, {nodes,Nodes}));
1342do_spec_terms([{diskless,How}|Terms], TopCases, SkipList, Config) ->
1343    do_spec_terms(Terms, TopCases, SkipList,
1344		  update_config(Config, {diskless,How}));
1345do_spec_terms([{config,MoreConfig}|Terms], TopCases, SkipList, Config) ->
1346    do_spec_terms(Terms, TopCases, SkipList, Config++MoreConfig);
1347do_spec_terms([{default_timeout,Tmo}|Terms], TopCases, SkipList, Config) ->
1348    do_spec_terms(Terms, TopCases, SkipList,
1349		  update_config(Config, {default_timeout,Tmo}));
1350
1351do_spec_terms([{require_nodenames,NumNames}|Terms], TopCases, SkipList, Config) ->
1352    NodeNames0=generate_nodenames(NumNames),
1353    NodeNames=lists:delete([], NodeNames0),
1354    do_spec_terms(Terms, TopCases, SkipList,
1355		  update_config(Config, {nodenames,NodeNames}));
1356do_spec_terms([Other|Terms], TopCases, SkipList, Config) ->
1357    io:format("** WARNING: Spec file contains unknown directive ~tp\n",
1358	      [Other]),
1359    do_spec_terms(Terms, TopCases, SkipList, Config).
1360
1361
1362
1363generate_nodenames(Num) ->
1364    Hosts = case controller_call(get_hosts) of
1365		[] ->
1366		    TI = controller_call(get_target_info),
1367		    [TI#target_info.host];
1368		List ->
1369		    List
1370	    end,
1371    generate_nodenames2(Num, Hosts, []).
1372
1373generate_nodenames2(0, _Hosts, Acc) ->
1374    Acc;
1375generate_nodenames2(N, Hosts, Acc) ->
1376    Host=lists:nth((N rem (length(Hosts)))+1, Hosts),
1377    Name=list_to_atom(temp_nodename("nod", []) ++ "@" ++ Host),
1378    generate_nodenames2(N-1, Hosts, [Name|Acc]).
1379
1380temp_nodename([], Acc) ->
1381    lists:flatten(Acc);
1382temp_nodename([Chr|Base], Acc) ->
1383    {A,B,C} = ?now,
1384    New = [Chr | integer_to_list(Chr bxor A bxor B+A bxor C+B)],
1385    temp_nodename(Base, [New|Acc]).
1386
1387%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1388%% count_test_cases(TopCases, SkipCases) -> {Suites,NoOfCases} | error
1389%% TopCases = term()      (See collect_cases/3)
1390%% SkipCases = term()     (See collect_cases/3)
1391%% Suites = list()
1392%% NoOfCases = integer() | unknown
1393%%
1394%% Counts the test cases that are about to run and returns that number.
1395%% If there's a conf group in TestSpec with a repeat property, the total number
1396%% of cases cannot be calculated and NoOfCases = unknown.
1397count_test_cases(TopCases, SkipCases) when is_list(TopCases) ->
1398    case collect_all_cases(TopCases, SkipCases) of
1399	{error,_Why} = Error ->
1400	    Error;
1401	TestSpec ->
1402	    {get_suites(TestSpec, []),
1403	     case remove_conf(TestSpec) of
1404		 {repeats,_} ->
1405		     unknown;
1406		 TestSpec1 ->
1407		     length(TestSpec1)
1408	     end}
1409    end;
1410
1411count_test_cases(TopCase, SkipCases) ->
1412    count_test_cases([TopCase], SkipCases).
1413
1414
1415remove_conf(Cases) ->
1416    remove_conf(Cases, [], false).
1417
1418remove_conf([{conf, _Ref, Props, _MF}|Cases], NoConf, Repeats) ->
1419    case get_repeat(Props) of
1420	undefined ->
1421	    remove_conf(Cases, NoConf, Repeats);
1422	{_RepType,1} ->
1423	    remove_conf(Cases, NoConf, Repeats);
1424	_ ->
1425	    remove_conf(Cases, NoConf, true)
1426    end;
1427remove_conf([{make,_Ref,_MF}|Cases], NoConf, Repeats) ->
1428    remove_conf(Cases, NoConf, Repeats);
1429remove_conf([{skip_case,{{_M,all},_Cmt},_Mode}|Cases], NoConf, Repeats) ->
1430    remove_conf(Cases, NoConf, Repeats);
1431remove_conf([{skip_case,{Type,_Ref,_MF,_Cmt}}|Cases],
1432	    NoConf, Repeats) when Type==conf;
1433				   Type==make ->
1434    remove_conf(Cases, NoConf, Repeats);
1435remove_conf([{skip_case,{Type,_Ref,_MF,_Cmt},_Mode}|Cases],
1436	    NoConf, Repeats) when Type==conf;
1437				  Type==make ->
1438    remove_conf(Cases, NoConf, Repeats);
1439remove_conf([C={Mod,error_in_suite,_}|Cases], NoConf, Repeats) ->
1440    FwMod = get_fw_mod(?MODULE),
1441    if Mod == FwMod ->
1442	    remove_conf(Cases, NoConf, Repeats);
1443       true ->
1444	    remove_conf(Cases, [C|NoConf], Repeats)
1445    end;
1446remove_conf([C={repeat,_,_}|Cases], NoConf, _Repeats) ->
1447    remove_conf(Cases, [C|NoConf], true);
1448remove_conf([C|Cases], NoConf, Repeats) ->
1449    remove_conf(Cases, [C|NoConf], Repeats);
1450remove_conf([], NoConf, true) ->
1451    {repeats,lists:reverse(NoConf)};
1452remove_conf([], NoConf, false) ->
1453    lists:reverse(NoConf).
1454
1455get_suites([{skip_case,{{Mod,_F},_Cmt},_Mode}|Tests], Mods) when is_atom(Mod) ->
1456    case add_mod(Mod, Mods) of
1457	true ->  get_suites(Tests, [Mod|Mods]);
1458	false -> get_suites(Tests, Mods)
1459    end;
1460get_suites([{Mod,_Case}|Tests], Mods) when is_atom(Mod) ->
1461    case add_mod(Mod, Mods) of
1462	true ->  get_suites(Tests, [Mod|Mods]);
1463	false -> get_suites(Tests, Mods)
1464    end;
1465get_suites([{Mod,_Func,_Args}|Tests], Mods) when is_atom(Mod) ->
1466    case add_mod(Mod, Mods) of
1467	true ->  get_suites(Tests, [Mod|Mods]);
1468	false -> get_suites(Tests, Mods)
1469    end;
1470get_suites([_|Tests], Mods) ->
1471    get_suites(Tests, Mods);
1472
1473get_suites([], Mods) ->
1474    lists:reverse(Mods).
1475
1476add_mod(Mod, Mods) ->
1477    case lists:reverse(atom_to_list(Mod)) of
1478        "ETIUS_" ++ _ -> % test suite
1479	     case lists:member(Mod, Mods) of
1480		 true ->  false;
1481		 false -> true
1482	     end;
1483        _ ->
1484            false
1485    end.
1486
1487
1488%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1489%% do_test_cases(TopCases, SkipCases, Config, TimetrapSpec) ->
1490%%    exit(Result)
1491%%
1492%% TopCases = term()      (See collect_cases/3)
1493%% SkipCases = term()     (See collect_cases/3)
1494%% Config = term()        (See collect_cases/3)
1495%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap}
1496%% MultiplyTimetrap = integer() | infinity
1497%% ScaleTimetrap = bool()
1498%%
1499%% Initializes and starts the test run, for "ordinary" test suites.
1500%% Creates log directories and log files, inserts initial timestamps and
1501%% configuration information into the log files.
1502%%
1503%% This function is meant to be called by a process created by
1504%% spawn_tester/10, which sets up some necessary dictionary values.
1505do_test_cases(TopCases, SkipCases,
1506	      Config, MultiplyTimetrap) when is_integer(MultiplyTimetrap);
1507					     MultiplyTimetrap == infinity ->
1508    do_test_cases(TopCases, SkipCases, Config, {MultiplyTimetrap,true});
1509
1510do_test_cases(TopCases, SkipCases,
1511	      Config, TimetrapData) when is_list(TopCases),
1512					 is_tuple(TimetrapData) ->
1513    {ok,TestDir} = start_log_file(),
1514    FwMod = get_fw_mod(?MODULE),
1515    case collect_all_cases(TopCases, SkipCases) of
1516	{error,Why} ->
1517	    print(1, "Error starting: ~tp", [Why]),
1518	    exit(test_suites_done);
1519	TestSpec0 ->
1520	    N = case remove_conf(TestSpec0) of
1521		    {repeats,_} -> unknown;
1522		    TS -> length(TS)
1523		end,
1524	    put(test_server_cases, N),
1525	    put(test_server_case_num, 0),
1526
1527	    TestSpec =
1528		add_init_and_end_per_suite(TestSpec0, undefined, undefined, FwMod),
1529
1530	    TI = get_target_info(),
1531	    print(1, "Starting test~ts",
1532		  [print_if_known(N, {", ~w test cases",[N]},
1533				  {" (with repeated test cases)",[]})]),
1534	    Test = get(test_server_name),
1535	    TestName = 	if is_list(Test) ->
1536				lists:flatten(io_lib:format("~ts", [Test]));
1537			   true ->
1538				lists:flatten(io_lib:format("~tp", [Test]))
1539			end,
1540	    TestDescr = "Test " ++ TestName ++ " results",
1541
1542	    test_server_sup:framework_call(report, [tests_start,{Test,N}]),
1543
1544	    {Header,Footer} =
1545		case test_server_sup:framework_call(get_html_wrapper,
1546						    [TestDescr,true,TestDir,
1547						    {[],[2,3,4,7,8],[1,6]}], "") of
1548		    Empty when (Empty == "") ; (element(2,Empty) == "")  ->
1549			put(basic_html, true),
1550			{[html_header(TestDescr),
1551			  "<h2>Results for test ", TestName, "</h2>\n"],
1552			 "\n</body>\n</html>\n"};
1553		    {basic_html,Html0,Html1} ->
1554			put(basic_html, true),
1555			{Html0++["<h1>Results for <i>",TestName,"</i></h1>\n"],
1556			 Html1};
1557		    {xhtml,Html0,Html1} ->
1558			put(basic_html, false),
1559			{Html0++["<h1>Results for <i>",TestName,"</i></h1>\n"],
1560			 Html1}
1561		end,
1562
1563	    print(html, "~ts", [Header]),
1564
1565	    print(html, xhtml("<p>", "<h4>")),
1566	    print_timestamp(html, "Test started at "),
1567	    print(html, xhtml("</p>", "</h4>")),
1568
1569	    print(html, xhtml("\n<p><b>Host info:</b><br>\n",
1570			      "\n<p><b>Host info:</b><br />\n")),
1571	    print_who(test_server_sup:hoststr(), test_server_sup:get_username()),
1572	    print(html, xhtml("<br>Used Erlang v~ts in <tt>~ts</tt></p>\n",
1573			      "<br />Used Erlang v~ts in \"~ts\"</p>\n"),
1574		  [erlang:system_info(version), code:root_dir()]),
1575
1576	    if FwMod == ?MODULE ->
1577		    print(html, xhtml("\n<p><b>Target Info:</b><br>\n",
1578				      "\n<p><b>Target Info:</b><br />\n")),
1579		    print_who(TI#target_info.host, TI#target_info.username),
1580		    print(html,xhtml("<br>Used Erlang v~ts in <tt>~ts</tt></p>\n",
1581				     "<br />Used Erlang v~ts in \"~ts\"</p>\n"),
1582			  [TI#target_info.version, TI#target_info.root_dir]);
1583	       true ->
1584		    case test_server_sup:framework_call(target_info, []) of
1585			TargetInfo when is_list(TargetInfo),
1586			                length(TargetInfo) > 0 ->
1587			    print(html, xhtml("\n<p><b>Target info:</b><br>\n",
1588					      "\n<p><b>Target info:</b><br />\n")),
1589			    print(html, "~ts</p>\n", [TargetInfo]);
1590			_ ->
1591			    ok
1592		    end
1593	    end,
1594	    CoverLog =
1595		case get(test_server_cover_log_dir) of
1596		    undefined ->
1597			?coverlog_name;
1598		    AbsLogDir ->
1599			AbsLog = filename:join(AbsLogDir,?coverlog_name),
1600			make_relative(AbsLog, TestDir)
1601		end,
1602	    print(html,
1603		  "<p><ul>\n"
1604		  "<li><a href=\"~ts\">Full textual log</a></li>\n"
1605		  "<li><a href=\"~ts\">Coverage log</a></li>\n"
1606		  "<li><a href=\"~ts\">Unexpected I/O log</a></li>\n</ul></p>\n",
1607		  [?suitelog_name,CoverLog,?unexpected_io_log]),
1608	    print(html,
1609		  "<p>~ts</p>\n" ++
1610		  xhtml("<table bgcolor=\"white\" border=\"3\" cellpadding=\"5\">\n" ++
1611			 "<thead>\n",
1612			"<table id=\"" ++ ?sortable_table_name ++ "\">\n" ++
1613			 "<thead>\n") ++
1614		      "<tr><th>Num</th><th>Module</th><th>Group</th>" ++
1615		      "<th>Case</th><th>Log</th><th>Time</th><th>Result</th>" ++
1616		      "<th>Comment</th></tr>\n</thead>\n<tbody>\n",
1617		  [print_if_known(N, {"<i>Executing <b>~w</b> test cases...</i>"
1618				      ++ xhtml("\n<br>\n", "\n<br />\n"),[N]},
1619				  {"",[]})]),
1620
1621	    print(major, "=cases         ~w", [get(test_server_cases)]),
1622	    print(major, "=user          ~ts", [TI#target_info.username]),
1623	    print(major, "=host          ~ts", [TI#target_info.host]),
1624
1625	    %% If there are no hosts specified,use only the local host
1626	    case controller_call(get_hosts) of
1627		[] ->
1628		    print(major, "=hosts         ~ts", [TI#target_info.host]),
1629		    controller_call({set_hosts, [TI#target_info.host]});
1630		Hosts ->
1631		    Str = lists:flatten(lists:map(fun(X) -> [X," "] end, Hosts)),
1632		    print(major, "=hosts         ~ts", [Str])
1633	    end,
1634	    print(major, "=emulator_vsn  ~ts", [TI#target_info.version]),
1635	    print(major, "=emulator      ~ts", [TI#target_info.emulator]),
1636	    print(major, "=otp_release   ~ts", [TI#target_info.otp_release]),
1637	    print(major, "=started       ~s",
1638		   [lists:flatten(timestamp_get(""))]),
1639
1640	    test_server_io:set_footer(Footer),
1641
1642	    run_test_cases(TestSpec, Config, TimetrapData)
1643    end;
1644
1645do_test_cases(TopCase, SkipCases, Config, TimetrapSpec) ->
1646    %% when not list(TopCase)
1647    do_test_cases([TopCase], SkipCases, Config, TimetrapSpec).
1648
1649
1650%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1651%% start_log_file() -> {ok,TestDirName} | exit({Error,Reason})
1652%% Stem = string()
1653%%
1654%% Creates the log directories, the major log file and the html log file.
1655%% The log files are initialized with some header information.
1656%%
1657%% The name of the log directory will be <Name>.logs/run.<Date>/ where
1658%% Name is the test suite name and Date is the current date and time.
1659
1660start_log_file() ->
1661    Dir  = get(test_server_dir),
1662    case file:make_dir(Dir) of
1663	ok ->
1664	    ok;
1665	{error, eexist} ->
1666	    ok;
1667	MkDirError ->
1668	    log_file_error(MkDirError, Dir)
1669    end,
1670    TestDir = timestamp_filename_get(filename:join(Dir, "run.")),
1671    TestDir1 =
1672	case file:make_dir(TestDir) of
1673	    ok ->
1674		TestDir;
1675	    {error,eexist} ->
1676		timer:sleep(1000),
1677		%% we need min 1 second between timestamps unfortunately
1678		TestDirX = timestamp_filename_get(filename:join(Dir, "run.")),
1679		case file:make_dir(TestDirX) of
1680		    ok ->
1681			TestDirX;
1682		    MkDirError2 ->
1683			log_file_error(MkDirError2, TestDirX)
1684		end;
1685	    MkDirError2 ->
1686		log_file_error(MkDirError2, TestDir)
1687	end,
1688    FilenameMode = file:native_name_encoding(),
1689    ok = write_file(filename:join(Dir, ?last_file),
1690		    TestDir1 ++ "\n",
1691		    FilenameMode),
1692    ok = write_file(?last_file, TestDir1 ++ "\n", FilenameMode),
1693    put(test_server_log_dir_base,TestDir1),
1694
1695    MajorName = filename:join(TestDir1, ?suitelog_name),
1696    HtmlName = MajorName ++ ?html_ext,
1697    UnexpectedName = filename:join(TestDir1, ?unexpected_io_log),
1698
1699    {ok,Major} = open_utf8_file(MajorName),
1700    {ok,Html}  = open_html_file(HtmlName),
1701
1702    {UnexpHeader,UnexpFooter} =
1703	case test_server_sup:framework_call(get_html_wrapper,
1704					    ["Unexpected I/O log",false,
1705					     TestDir, undefined],"") of
1706	    UEmpty when (UEmpty == "") ; (element(2,UEmpty) == "")  ->
1707		{html_header("Unexpected I/O log"),"\n</body>\n</html>\n"};
1708	    {basic_html,UH,UF} ->
1709		{UH,UF};
1710	    {xhtml,UH,UF} ->
1711		{UH,UF}
1712	end,
1713
1714    {ok,Unexpected} = open_html_file(UnexpectedName),
1715    io:put_chars(Unexpected, [UnexpHeader,
1716			      xhtml("<br>\n<h2>Unexpected I/O</h2>",
1717				    "<br />\n<h3>Unexpected I/O</h3>"),
1718			      "\n<pre>\n"]),
1719    put(test_server_unexpected_footer,{UnexpectedName,UnexpFooter}),
1720
1721    test_server_io:set_fd(major, Major),
1722    test_server_io:set_fd(html, Html),
1723    test_server_io:set_fd(unexpected_io, Unexpected),
1724
1725    %% we must assume the redirection file (to the latest suite index) can
1726    %% be stored on the level above the log directory of the current test
1727    TopDir = filename:dirname(get(test_server_framework_logdir)),
1728    RedirectLink = filename:join(TopDir, ?suitelog_latest_name ++ ?html_ext),
1729    make_html_link(RedirectLink, HtmlName, redirect),
1730
1731    make_html_link(filename:absname(?last_test ++ ?html_ext),
1732		   HtmlName, filename:basename(Dir)),
1733    LinkName = filename:join(Dir, ?last_link),
1734    make_html_link(LinkName ++ ?html_ext, HtmlName,
1735		   filename:basename(Dir)),
1736
1737    PrivDir = filename:join(TestDir1, ?priv_dir),
1738    ok = file:make_dir(PrivDir),
1739    put(test_server_priv_dir,PrivDir++"/"),
1740    print_timestamp(major, "Suite started at "),
1741
1742    LogInfo = [{topdir,Dir},{rundir,lists:flatten(TestDir1)}],
1743    test_server_sup:framework_call(report, [loginfo,LogInfo]),
1744    {ok,TestDir1}.
1745
1746log_file_error(Error, Dir) ->
1747    exit({cannot_create_log_dir,{Error,lists:flatten(Dir)}}).
1748
1749make_html_link(LinkName, Target, Explanation) ->
1750    %% if possible use a relative reference to Target.
1751    TargetL = filename:split(Target),
1752    PwdL = filename:split(filename:dirname(LinkName)),
1753    Href = case lists:prefix(PwdL, TargetL) of
1754	       true ->
1755		   uri_encode(filename:join(lists:nthtail(length(PwdL),TargetL)));
1756	       false ->
1757		   "file:" ++ uri_encode(Target)
1758	   end,
1759    H = if Explanation == redirect ->
1760                Meta = ["<meta http-equiv=\"refresh\" "
1761                        "content=\"0; url=", Href, "\" />\n"],
1762                [html_header("redirect", Meta), "</html>\n"];
1763           true ->
1764                [html_header(Explanation),
1765                 "<h1>Last test</h1>\n"
1766                 "<a href=\"",Href,"\">",Explanation,"</a>\n"
1767                 "</body>\n</html>\n"]
1768        end,
1769    ok = write_html_file(LinkName, H).
1770
1771
1772%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1773%% start_minor_log_file(Mod, Func, ParallelTC) -> AbsName
1774%% Mod = atom()
1775%% Func = atom()
1776%% ParallelTC = bool()
1777%% AbsName = string()
1778%%
1779%% Create a minor log file for the test case Mod,Func,Args. The log file
1780%% will be stored in the log directory under the name <Mod>.<Func>.html.
1781%% Some header info will also be inserted into the log file. If the test
1782%% case runs in a parallel group, then to avoid clashing file names if the
1783%% case is executed more than once, the name <Mod>.<Func>.<Timestamp>.html
1784%% is used.
1785
1786start_minor_log_file(Mod, Func, ParallelTC) ->
1787    MFA = {Mod,Func,1},
1788    LogDir = get(test_server_log_dir_base),
1789    Name = minor_log_file_name(Mod,Func),
1790    AbsName = filename:join(LogDir, Name),
1791    case (ParallelTC orelse (element(1,file:read_file_info(AbsName))==ok)) of
1792	false ->                           %% normal case, unique name
1793	    start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA);
1794	true ->                            %% special case, duplicate names
1795	    Tag = test_server_sup:unique_name(),
1796            Name1 = minor_log_file_name(Mod,Func,[$.|Tag]),
1797	    AbsName1 = filename:join(LogDir, Name1),
1798	    start_minor_log_file1(Mod, Func, LogDir, AbsName1, MFA)
1799    end.
1800
1801start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA) ->
1802    {ok,Fd} = open_html_file(AbsName),
1803    Lev = get(test_server_minor_level)+1000, %% far down in the minor levels
1804    put(test_server_minor_fd, Fd),
1805    test_server_gl:set_minor_fd(group_leader(), Fd, MFA),
1806
1807    TestDescr = io_lib:format("Test ~w:~tw result", [Mod,Func]),
1808    {Header,Footer} =
1809	case test_server_sup:framework_call(get_html_wrapper,
1810					    [TestDescr,false,
1811					     filename:dirname(AbsName),
1812					     undefined], "") of
1813	    Empty when (Empty == "") ; (element(2,Empty) == "")  ->
1814		put(basic_html, true),
1815		{html_header(TestDescr), "\n</body>\n</html>\n"};
1816	    {basic_html,Html0,Html1} ->
1817		put(basic_html, true),
1818		{Html0,Html1};
1819	    {xhtml,Html0,Html1} ->
1820		put(basic_html, false),
1821		{Html0,Html1}
1822	end,
1823    put(test_server_minor_footer, Footer),
1824    io:put_chars(Fd, Header),
1825
1826    io:put_chars(Fd, "<a name=\"top\"></a>"),
1827    io:put_chars(Fd, "<pre>\n"),
1828
1829    SrcListing = downcase(atom_to_list(Mod)) ++ ?src_listing_ext,
1830
1831    case get_fw_mod(?MODULE) of
1832	Mod when Func == error_in_suite ->
1833	    ok;
1834	_ ->
1835	    {Info,Arity} =
1836		if Func == init_per_suite; Func == end_per_suite ->
1837			{"Config function: ", 1};
1838		   Func == init_per_group; Func == end_per_group ->
1839			{"Config function: ", 2};
1840		   true ->
1841			{"Test case: ", 1}
1842		end,
1843
1844	    case {filelib:is_file(filename:join(LogDir, SrcListing)),
1845		  lists:member(no_src, get(test_server_logopts))} of
1846		{true,false} ->
1847		    print(Lev, ["$tc_html",
1848				Info ++ "<a href=\"~ts#~ts\">~w:~tw/~w</a> "
1849				"(click for source code)\n"],
1850			  [uri_encode(SrcListing),
1851			   uri_encode(atom_to_list(Func)++"-1",utf8),
1852			   Mod,Func,Arity]);
1853		_ ->
1854		    print(Lev, ["$tc_html",Info ++ "~w:~tw/~w\n"], [Mod,Func,Arity])
1855	    end
1856    end,
1857
1858    AbsName.
1859
1860stop_minor_log_file() ->
1861    test_server_gl:unset_minor_fd(group_leader()),
1862    Fd = get(test_server_minor_fd),
1863    Footer = get(test_server_minor_footer),
1864    io:put_chars(Fd, "</pre>\n" ++ Footer),
1865    ok = file:close(Fd),
1866    put(test_server_minor_fd, undefined).
1867
1868minor_log_file_name(Mod,Func) ->
1869    minor_log_file_name(Mod,Func,"").
1870minor_log_file_name(Mod,Func,Tag) ->
1871    Name =
1872        downcase(
1873          lists:flatten(
1874            io_lib:format("~w.~tw~s~s", [Mod,Func,Tag,?html_ext]))),
1875    Ok = file:native_name_encoding()==utf8
1876        orelse io_lib:printable_latin1_list(Name),
1877    if Ok -> Name;
1878       true -> exit({error,unicode_name_on_latin1_file_system})
1879    end.
1880
1881downcase(S) -> downcase(S, []).
1882downcase([Uc|Rest], Result) when $A =< Uc, Uc =< $Z ->
1883    downcase(Rest, [Uc-$A+$a|Result]);
1884downcase([C|Rest], Result) ->
1885    downcase(Rest, [C|Result]);
1886downcase([], Result) ->
1887    lists:reverse(Result).
1888
1889%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1890%% html_convert_modules(TestSpec, Config) -> ok
1891%%  Isolate the modules affected by TestSpec and
1892%%  make sure they are converted to html.
1893%%
1894%%  Errors are silently ignored.
1895
1896html_convert_modules(TestSpec, _Config, FwMod) ->
1897    Mods = html_isolate_modules(TestSpec, FwMod),
1898    html_convert_modules(Mods),
1899    copy_html_files(get(test_server_dir), get(test_server_log_dir_base)).
1900
1901%% Retrieve a list of modules out of the test spec.
1902html_isolate_modules(List, FwMod) ->
1903    html_isolate_modules(List, sets:new(), FwMod).
1904
1905html_isolate_modules([], Set, _) -> sets:to_list(Set);
1906html_isolate_modules([{skip_case,{_Case,_Cmt},_Mode}|Cases], Set, FwMod) ->
1907    html_isolate_modules(Cases, Set, FwMod);
1908html_isolate_modules([{conf,_Ref,Props,{FwMod,_Func}}|Cases], Set, FwMod) ->
1909    Set1 = case proplists:get_value(suite, Props) of
1910	       undefined -> Set;
1911	       Mod -> sets:add_element(Mod, Set)
1912	   end,
1913    html_isolate_modules(Cases, Set1, FwMod);
1914html_isolate_modules([{conf,_Ref,_Props,{Mod,_Func}}|Cases], Set, FwMod) ->
1915    html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod);
1916html_isolate_modules([{skip_case,{conf,_Ref,{FwMod,_Func},_Cmt},Mode}|Cases],
1917		     Set, FwMod) ->
1918    Set1 = case proplists:get_value(suite, get_props(Mode)) of
1919	       undefined -> Set;
1920	       Mod -> sets:add_element(Mod, Set)
1921	   end,
1922    html_isolate_modules(Cases, Set1, FwMod);
1923html_isolate_modules([{skip_case,{conf,_Ref,{Mod,_Func},_Cmt},_Props}|Cases],
1924		     Set, FwMod) ->
1925    html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod);
1926html_isolate_modules([{Mod,_Case}|Cases], Set, FwMod) ->
1927    html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod);
1928html_isolate_modules([{Mod,_Case,_Args}|Cases], Set, FwMod) ->
1929    html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod).
1930
1931%% Given a list of modules, convert each module's source code to HTML.
1932html_convert_modules([Mod|Mods]) ->
1933    case code:which(Mod) of
1934	Path when is_list(Path) ->
1935	    SrcFile = filename:rootname(Path) ++ ".erl",
1936	    FoundSrcFile =
1937		case file:read_file_info(SrcFile) of
1938		    {ok,SInfo} ->
1939			{SrcFile,SInfo};
1940		    {error,_} ->
1941			ModInfo = Mod:module_info(compile),
1942			case proplists:get_value(source, ModInfo) of
1943			    undefined ->
1944				undefined;
1945			    OtherSrcFile ->
1946				case file:read_file_info(OtherSrcFile) of
1947				    {ok,SInfo} ->
1948					{OtherSrcFile,SInfo};
1949				    {error,_} ->
1950					undefined
1951				end
1952			end
1953		end,
1954	    case FoundSrcFile of
1955		undefined ->
1956		    html_convert_modules(Mods);
1957		{SrcFile1,SrcFileInfo} ->
1958		    DestDir = get(test_server_dir),
1959		    Name = atom_to_list(Mod),
1960		    DestFile = filename:join(DestDir,
1961					     downcase(Name)++?src_listing_ext),
1962		    _ = html_possibly_convert(SrcFile1, SrcFileInfo, DestFile),
1963		    html_convert_modules(Mods)
1964	    end;
1965	_Other ->
1966	    html_convert_modules(Mods)
1967    end;
1968html_convert_modules([]) -> ok.
1969
1970%% Convert source code to HTML if possible and needed.
1971html_possibly_convert(Src, SrcInfo, Dest) ->
1972    case file:read_file_info(Dest) of
1973	{ok,DestInfo} when DestInfo#file_info.mtime >= SrcInfo#file_info.mtime ->
1974	    ok;					% dest file up to date
1975	_ ->
1976	    InclPath = case application:get_env(test_server, include) of
1977			   {ok,Incls} -> Incls;
1978			   _ -> []
1979		       end,
1980
1981	    OutDir = get(test_server_log_dir_base),
1982	    case test_server_sup:framework_call(get_html_wrapper,
1983						["Module "++Src,false,
1984						 OutDir,undefined,
1985						 encoding(Src)], "") of
1986		Empty when (Empty == "") ; (element(2,Empty) == "")  ->
1987		    erl2html2:convert(Src, Dest, InclPath);
1988		{_,Header,_} ->
1989		    erl2html2:convert(Src, Dest, InclPath, Header)
1990	    end
1991    end.
1992
1993%% Copy all HTML files in InDir to OutDir.
1994copy_html_files(InDir, OutDir) ->
1995    Files = filelib:wildcard(filename:join(InDir, "*" ++ ?src_listing_ext)),
1996    lists:foreach(fun (Src) -> copy_html_file(Src, OutDir) end, Files).
1997
1998copy_html_file(Src, DestDir) ->
1999    Dest = filename:join(DestDir, filename:basename(Src)),
2000    case file:read_file(Src) of
2001	{ok,Bin} ->
2002	    ok = write_binary_file(Dest, Bin);
2003	{error,_Reason} ->
2004	    io:format("File ~ts: read failed\n", [Src])
2005    end.
2006
2007%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2008%% add_init_and_end_per_suite(TestSpec, Mod, Ref, FwMod) -> NewTestSpec
2009%%
2010%% Expands TestSpec with an initial init_per_suite, and a final
2011%% end_per_suite element, per each discovered suite in the list.
2012
2013add_init_and_end_per_suite([{make,_,_}=Case|Cases], LastMod, LastRef, FwMod) ->
2014    [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
2015add_init_and_end_per_suite([{skip_case,{{Mod,all},_},_}=Case|Cases], LastMod,
2016			   LastRef, FwMod) when Mod =/= LastMod ->
2017    {PreCases, NextMod, NextRef} =
2018	do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod),
2019    PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
2020						 NextRef, FwMod)];
2021add_init_and_end_per_suite([{skip_case,{{Mod,_},_Cmt},_Mode}=Case|Cases],
2022			   LastMod, LastRef, FwMod) when Mod =/= LastMod ->
2023    {PreCases, NextMod, NextRef} =
2024	do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
2025    PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
2026						 NextRef, FwMod)];
2027add_init_and_end_per_suite([{skip_case,{conf,_,{Mod,_},_},_}=Case|Cases],
2028			   LastMod, LastRef, FwMod) when Mod =/= LastMod ->
2029    {PreCases, NextMod, NextRef} =
2030	do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
2031    PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
2032						 NextRef, FwMod)];
2033add_init_and_end_per_suite([{skip_case,{conf,_,{Mod,_},_}}=Case|Cases], LastMod,
2034			   LastRef, FwMod) when Mod =/= LastMod ->
2035    {PreCases, NextMod, NextRef} =
2036	do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
2037    PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
2038						 NextRef, FwMod)];
2039add_init_and_end_per_suite([{conf,Ref,Props,{FwMod,Func}}=Case|Cases], LastMod,
2040			   LastRef, FwMod) ->
2041    %% if Mod == FwMod, this conf test is (probably) a test case group where
2042    %% the init- and end-functions are missing in the suite, and if so,
2043    %% the suite name should be stored as {suite,Suite} in Props
2044    case proplists:get_value(suite, Props) of
2045	Suite when Suite =/= undefined, Suite =/= LastMod ->
2046	    {PreCases, NextMod, NextRef} =
2047		do_add_init_and_end_per_suite(LastMod, LastRef, Suite, FwMod),
2048	    Case1 = {conf,Ref,[{suite,NextMod}|proplists:delete(suite,Props)],
2049		     {FwMod,Func}},
2050	    PreCases ++ [Case1|add_init_and_end_per_suite(Cases, NextMod,
2051							  NextRef, FwMod)];
2052	_ ->
2053	    [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)]
2054    end;
2055add_init_and_end_per_suite([{conf,_,_,{Mod,_}}=Case|Cases], LastMod,
2056			   LastRef, FwMod) when Mod =/= LastMod, Mod =/= FwMod ->
2057    {PreCases, NextMod, NextRef} =
2058	do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
2059    PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
2060						 NextRef, FwMod)];
2061add_init_and_end_per_suite([SkipCase|Cases], LastMod, LastRef, FwMod)
2062  when element(1,SkipCase) == skip_case;  element(1,SkipCase) == auto_skip_case->
2063    [SkipCase|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
2064add_init_and_end_per_suite([{conf,_,_,_}=Case|Cases], LastMod, LastRef, FwMod) ->
2065    [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
2066add_init_and_end_per_suite([{repeat,{Mod,_},_}=Case|Cases], LastMod, LastRef, FwMod)
2067  when Mod =/= LastMod, Mod =/= FwMod ->
2068    {PreCases, NextMod, NextRef} =
2069	do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
2070    PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
2071						 NextRef, FwMod)];
2072add_init_and_end_per_suite([{repeat,_,_}=Case|Cases], LastMod, LastRef, FwMod) ->
2073    [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
2074add_init_and_end_per_suite([{Mod,_}=Case|Cases], LastMod, LastRef, FwMod)
2075  when Mod =/= LastMod, Mod =/= FwMod ->
2076    {PreCases, NextMod, NextRef} =
2077	do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
2078    PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
2079						 NextRef, FwMod)];
2080add_init_and_end_per_suite([{Mod,_,_}=Case|Cases], LastMod, LastRef, FwMod)
2081  when Mod =/= LastMod, Mod =/= FwMod ->
2082    {PreCases, NextMod, NextRef} =
2083	do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
2084    PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
2085						 NextRef, FwMod)];
2086add_init_and_end_per_suite([Case|Cases], LastMod, LastRef, FwMod)->
2087    [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
2088add_init_and_end_per_suite([], _LastMod, undefined, _FwMod) ->
2089    [];
2090add_init_and_end_per_suite([], _LastMod, skipped_suite, _FwMod) ->
2091    [];
2092add_init_and_end_per_suite([], LastMod, LastRef, FwMod) ->
2093    %% we'll add end_per_suite here even if it's not exported
2094    %% (and simply let the call fail if it's missing)
2095    case {erlang:function_exported(LastMod, end_per_suite, 1),
2096          erlang:function_exported(LastMod, init_per_suite, 1)} of
2097	{false,false} ->
2098	    %% let's call a "fake" end_per_suite if it exists
2099	    case erlang:function_exported(FwMod, end_per_suite, 1) of
2100		true ->
2101		    [{conf,LastRef,[{suite,LastMod}],{FwMod,end_per_suite}}];
2102		false ->
2103		    [{conf,LastRef,[],{LastMod,end_per_suite}}]
2104	    end;
2105	_ ->
2106            %% If any of these exist, the other should too
2107            %% (required and documented). If it isn't, it will fail
2108            %% with reason 'undef'.
2109	    [{conf,LastRef,[],{LastMod,end_per_suite}}]
2110    end.
2111
2112do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) ->
2113    _ = case code:is_loaded(Mod) of
2114	false -> code:load_file(Mod);
2115	_ -> ok
2116    end,
2117    {Init,NextMod,NextRef} =
2118	case {erlang:function_exported(Mod, init_per_suite, 1),
2119              erlang:function_exported(Mod, end_per_suite, 1)} of
2120	    {false,false} ->
2121		%% let's call a "fake" init_per_suite if it exists
2122		case erlang:function_exported(FwMod, init_per_suite, 1) of
2123		    true ->
2124			Ref = make_ref(),
2125			{[{conf,Ref,[{suite,Mod}],
2126			   {FwMod,init_per_suite}}],Mod,Ref};
2127		    false ->
2128			{[],Mod,undefined}
2129		end;
2130	    _ ->
2131                %% If any of these exist, the other should too
2132                %% (required and documented). If it isn't, it will fail
2133                %% with reason 'undef'.
2134		Ref = make_ref(),
2135		{[{conf,Ref,[],{Mod,init_per_suite}}],Mod,Ref}
2136	end,
2137    Cases =
2138	if LastRef==undefined ->
2139		Init;
2140	   LastRef==skipped_suite ->
2141		Init;
2142	   true ->
2143		%% we'll add end_per_suite here even if it's not exported
2144		%% (and simply let the call fail if it's missing)
2145		case {erlang:function_exported(LastMod, end_per_suite, 1),
2146                      erlang:function_exported(LastMod, init_per_suite, 1)} of
2147		    {false,false} ->
2148			%% let's call a "fake" end_per_suite if it exists
2149			case erlang:function_exported(FwMod, end_per_suite, 1) of
2150			    true ->
2151				[{conf,LastRef,[{suite,LastMod}],
2152				  {FwMod,end_per_suite}}|Init];
2153			    false ->
2154				[{conf,LastRef,[],{LastMod,end_per_suite}}|Init]
2155			end;
2156		    _ ->
2157                        %% If any of these exist, the other should too
2158                        %% (required and documented). If it isn't, it will fail
2159                        %% with reason 'undef'.
2160			[{conf,LastRef,[],{LastMod,end_per_suite}}|Init]
2161                end
2162	end,
2163    {Cases,NextMod,NextRef}.
2164
2165do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) ->
2166    case LastRef of
2167	No when No==undefined ; No==skipped_suite ->
2168	    {[],Mod,skipped_suite};
2169	_Ref ->
2170	    case {erlang:function_exported(LastMod, end_per_suite, 1),
2171                  erlang:function_exported(LastMod, init_per_suite, 1)} of
2172		{false,false} ->
2173		    case erlang:function_exported(FwMod, end_per_suite, 1) of
2174			true ->
2175			    %% let's call "fake" end_per_suite if it exists
2176			    {[{conf,LastRef,[],{FwMod,end_per_suite}}],
2177			     Mod,skipped_suite};
2178			false ->
2179			    {[{conf,LastRef,[],{LastMod,end_per_suite}}],
2180			     Mod,skipped_suite}
2181		    end;
2182		_ ->
2183                    %% If any of these exist, the other should too
2184                    %% (required and documented). If it isn't, it will fail
2185                    %% with reason 'undef'.
2186		    {[{conf,LastRef,[],{LastMod,end_per_suite}}],
2187		     Mod,skipped_suite}
2188	    end
2189    end.
2190
2191
2192%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2193%% run_test_cases(TestSpec, Config, TimetrapData) -> exit(Result)
2194%%
2195%% Runs the specified tests, then displays/logs the summary.
2196
2197run_test_cases(TestSpec, Config, TimetrapData) ->
2198    test_server:init_memory_checker(),
2199    case lists:member(no_src, get(test_server_logopts)) of
2200	true ->
2201	    ok;
2202	false ->
2203	    FwMod = get_fw_mod(?MODULE),
2204	    html_convert_modules(TestSpec, Config, FwMod)
2205    end,
2206
2207    run_test_cases_loop(TestSpec, [Config], TimetrapData, [], []),
2208
2209    {AllSkippedN,UserSkipN,AutoSkipN,SkipStr} =
2210	case get(test_server_skipped) of
2211	    {0,0} -> {0,0,0,""};
2212	    {US,AS} -> {US+AS,US,AS,io_lib:format(", ~w skipped", [US+AS])}
2213	end,
2214    OkN = get(test_server_ok),
2215    FailedN = get(test_server_failed),
2216    print(1, "TEST COMPLETE, ~w ok, ~w failed~ts of ~w test cases\n",
2217	  [OkN,FailedN,SkipStr,OkN+FailedN+AllSkippedN]),
2218    test_server_sup:framework_call(report, [tests_done,
2219					    {OkN,FailedN,{UserSkipN,AutoSkipN}}]),
2220    print(major, "=finished      ~s", [lists:flatten(timestamp_get(""))]),
2221    print(major, "=failed        ~w", [FailedN]),
2222    print(major, "=successful    ~w", [OkN]),
2223    print(major, "=user_skipped  ~w", [UserSkipN]),
2224    print(major, "=auto_skipped  ~w", [AutoSkipN]),
2225    exit(test_suites_done).
2226
2227
2228%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2229%% run_test_cases_loop(TestCases, Config, TimetrapData, Mode, Status) -> ok
2230%% TestCases = [Test,...]
2231%% Config = [[{Key,Val},...],...]
2232%% TimetrapData = {MultiplyTimetrap,ScaleTimetrap}
2233%% MultiplyTimetrap = integer() | infinity
2234%% ScaleTimetrap = bool()
2235%% Mode = [{Ref,[Prop,..],StartTime}]
2236%% Ref = reference()
2237%% Prop = {name,Name} | sequence | parallel |
2238%%        shuffle | {shuffle,Seed} |
2239%%        repeat | {repeat,N} |
2240%%        repeat_until_all_ok | {repeat_until_all_ok,N} |
2241%%        repeat_until_any_ok | {repeat_until_any_ok,N} |
2242%%        repeat_until_any_fail | {repeat_until_any_fail,N} |
2243%%        repeat_until_all_fail | {repeat_until_all_fail,N}
2244%% Status = [{Ref,{{Ok,Skipped,Failed},CopiedCases}}]
2245%% Ok = Skipped = Failed = [Case,...]
2246%%
2247%% Execute the TestCases under configuration Config. Config is a list
2248%% of lists, where hd(Config) holds the config tuples for the current
2249%% conf case and tl(Config) is the data for the higher level conf cases.
2250%% Config data is "inherited" from top to nested conf cases, but
2251%% never the other way around. if length(Config) == 1, Config contains
2252%% only the initial config data for the suite.
2253%%
2254%% Test may be one of the following:
2255%%
2256%% {conf,Ref,Props,{Mod,Func}} Mod:Func is a configuration modification
2257%% function, call it with the current configuration as argument. It will
2258%% return a new configuration.
2259%%
2260%% {make,Ref,{Mod,Func,Args}} Mod:Func is a make function, and it is called
2261%% with the given arguments.
2262%%
2263%% {Mod,Case} This is a normal test case. Determine the correct
2264%% configuration, and insert {Mod,Case,Config} as head of the list,
2265%% then reiterate.
2266%%
2267%% {Mod,Case,Args} A test case with predefined argument (usually a normal
2268%% test case which just got a fresh configuration (see above)).
2269%%
2270%% {skip_case,{conf,Ref,Case,Comment}} An init conf case gets skipped
2271%% by the user. This will also cause the end conf case to be skipped.
2272%% Note that it is not possible to skip an end conf case directly (it
2273%% can only be skipped indirectly by a skipped init conf case). The
2274%% comment (which gets printed in the log files) describes why the case
2275%% was skipped.
2276%%
2277%% {skip_case,{Case,Comment},Mode} A normal test case skipped by the user.
2278%% The comment (which gets printed in the log files) describes why the
2279%% case was skipped.
2280%%
2281%% {auto_skip_case,{conf,Ref,Case,Comment},Mode} This is the result of
2282%% an end conf case being automatically skipped due to a failing init
2283%% conf case. It could also be a nested conf case that gets skipped
2284%% because of a failed or skipped top level conf.
2285%%
2286%% {auto_skip_case,{Case,Comment},Mode} This is a normal test case which
2287%% gets automatically skipped because of a failing init conf case or
2288%% because of a failing previous test case in a sequence.
2289%%
2290%% -------------------------------------------------------------------
2291%% Description of IO handling during execution of parallel test cases:
2292%% -------------------------------------------------------------------
2293%%
2294%% A conf group can have an associated list of properties. If the
2295%% parallel property is specified for a group, it means the test cases
2296%% should be spawned and run in parallel rather than called sequentially
2297%% (which is always the default mode). Test cases that execute in parallel
2298%% also write to their respective minor log files in parallel. Printouts
2299%% to common log files, such as the summary html file and the major log
2300%% file on text format, still have to be processed sequentially. For this
2301%% reason, the Mode argument specifies if a parallel group is currently
2302%% being executed.
2303%%
2304%% The low-level mechanism for buffering IO for the common log files
2305%% is handled by the test_server_io module. Buffering is turned on by
2306%% test_server_io:start_transaction/0 and off by calling
2307%% test_server_io:end_transaction/0. The buffered data for the transaction
2308%% can printed by calling test_server_io:print_buffered/1.
2309%%
2310%% This module is responsible for turning on IO buffering and to later
2311%% test_server_io:print_buffered/1 to print the data. To help with this,
2312%% two variables in the process dictionary are used:
2313%% 'test_server_common_io_handler' and 'test_server_queued_io'. The values
2314%% are set to as following:
2315%%
2316%%   Value	Meaning
2317%%   -----     -------
2318%%   undefined	No parallel test cases running
2319%%   {tc,Pid}	Running test cases in a top-level parallel group
2320%%   {Ref,Pid}	Running sequential test case inside a parallel group
2321%%
2322%% FIXME: The Pid is no longer used.
2323%%
2324%% If a conf group nested under a parallel group in the test
2325%% specification should be started, the 'test_server_common_io_handler'
2326%% value gets set also on the main process.
2327%%
2328%% During execution of a parallel group (or of a group nested under a
2329%% parallel group), *any* new test case being started gets registered
2330%% in a list saved in the dictionary with 'test_server_queued_io' as key.
2331%% When the top level parallel group is finished (only then can we be
2332%% sure all parallel test cases have finished and "reported in"), the
2333%% list of test cases is traversed in order and test_server_io:print_buffered/1
2334%% can be called for each test case. See handle_test_case_io_and_status/0
2335%% for details.
2336%%
2337%% To be able to handle nested conf groups with different properties,
2338%% the Mode argument specifies a list of {Ref,Properties} tuples.
2339%% The head of the Mode list at any given time identifies the group
2340%% currently being processed. The tail of the list identifies groups
2341%% on higher level.
2342%%
2343%% -------------------------------------------------------------------
2344%% Notes on parallel execution of test cases
2345%% -------------------------------------------------------------------
2346%%
2347%% A group nested under a parallel group will start executing in
2348%% parallel with previous (parallel) test cases (no matter what
2349%% properties the nested group has). Test cases are however never
2350%% executed in parallel with the start or end conf case of the same
2351%% group! Because of this, the test_server_ctrl loop waits at
2352%% the end conf of a group for all parallel cases to finish
2353%% before the end conf case actually executes. This has the effect
2354%% that it's only after a nested group has finished that any
2355%% remaining parallel cases in the previous group get spawned (*).
2356%% Example (all parallel cases):
2357%%
2358%% group1_init   |---->
2359%% group1_case1        | --------->
2360%% group1_case2        | --------------------------------->
2361%% group2_init         | ---->
2362%% group2_case1               | ------>
2363%% group2_case2               | ---------->
2364%% group2_end                              | --->
2365%% group1_case3                               (*)| ---->
2366%% group1_case4                               (*)| -->
2367%% group1_end                                              | --->
2368%%
2369
2370run_test_cases_loop([{SkipTag,CaseData={Type,_Ref,_Case,_Comment}}|Cases],
2371		    Config, TimetrapData, Mode, Status) when
2372      ((SkipTag==auto_skip_case) or (SkipTag==skip_case)) and
2373      ((Type==conf) or (Type==make)) ->
2374    run_test_cases_loop([{SkipTag,CaseData,Mode}|Cases],
2375			Config, TimetrapData, Mode, Status);
2376
2377run_test_cases_loop([{SkipTag,{Type,Ref,Case,Comment},SkipMode}|Cases],
2378		    Config, TimetrapData, Mode, Status) when
2379      ((SkipTag==auto_skip_case) or (SkipTag==skip_case)) and
2380      ((Type==conf) or (Type==make)) ->
2381    ok = file:set_cwd(filename:dirname(get(test_server_dir))),
2382    CurrIOHandler = get(test_server_common_io_handler),
2383    ParentMode = tl(Mode),
2384
2385    {AutoOrUser,ReportTag} =
2386	if SkipTag == auto_skip_case -> {auto,tc_auto_skip};
2387	   SkipTag == skip_case      -> {user,tc_user_skip}
2388	end,
2389
2390    %% check and update the mode for test case execution and io msg handling
2391    case {curr_ref(Mode),check_props(parallel, Mode)} of
2392	{Ref,Ref} ->
2393	    case check_props(parallel, ParentMode) of
2394		false ->
2395		    %% this is a skipped end conf for a top level parallel
2396		    %% group, buffered io can be flushed
2397		    _ = handle_test_case_io_and_status(),
2398		    set_io_buffering(undefined),
2399		    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
2400					   false, SkipMode),
2401		    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
2402		    test_server_sup:framework_call(report,
2403						   [ReportTag,ConfData]),
2404		    run_test_cases_loop(Cases, Config, TimetrapData, ParentMode,
2405					delete_status(Ref, Status));
2406		_ ->
2407		    %% this is a skipped end conf for a parallel group nested
2408		    %% under a parallel group (io buffering is active)
2409		    _ = wait_for_cases(Ref),
2410		    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
2411					   true, SkipMode),
2412		    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
2413		    test_server_sup:framework_call(report, [ReportTag,ConfData]),
2414		    case CurrIOHandler of
2415			{Ref,_} ->
2416			    %% current_io_handler was set by start conf of this
2417			    %% group, so we can unset it now (no more io from main
2418			    %% process needs to be buffered)
2419			    set_io_buffering(undefined);
2420			_ ->
2421			    ok
2422		    end,
2423		    run_test_cases_loop(Cases, Config,
2424					TimetrapData, ParentMode,
2425					delete_status(Ref, Status))
2426	    end;
2427	{Ref,false} ->
2428	    %% this is a skipped end conf for a non-parallel group that's not
2429	    %% nested under a parallel group
2430	    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
2431				   false, SkipMode),
2432	    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
2433	    test_server_sup:framework_call(report, [ReportTag,ConfData]),
2434
2435	    %% Check if this group is auto skipped because of error in the
2436	    %% init conf. If so, check if the parent group is a sequence,
2437	    %% and if it is, skip all proceeding tests in that group.
2438	    GrName = get_name(Mode),
2439	    Cases1 =
2440		case get_tc_results(Status) of
2441		    {_,_,Fails} when length(Fails) > 0 ->
2442			case lists:member({group_result,GrName}, Fails) of
2443			    true ->
2444				case check_prop(sequence, ParentMode) of
2445				    false ->
2446					Cases;
2447				    ParentRef ->
2448					Reason = {group_result,GrName,failed},
2449					skip_cases_upto(ParentRef, Cases,
2450							Reason, tc, ParentMode,
2451							SkipTag)
2452				end;
2453			    false ->
2454				Cases
2455			end;
2456		    _ ->
2457			Cases
2458		end,
2459	    run_test_cases_loop(Cases1, Config, TimetrapData, ParentMode,
2460				delete_status(Ref, Status));
2461	{Ref,_} ->
2462	    %% this is a skipped end conf for a non-parallel group nested under
2463	    %% a parallel group (io buffering is active)
2464	    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
2465				   true, SkipMode),
2466	    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
2467	    test_server_sup:framework_call(report, [ReportTag,ConfData]),
2468	    case CurrIOHandler of
2469		{Ref,_} ->
2470		    %% current_io_handler was set by start conf of this
2471		    %% group, so we can unset it now (no more io from main
2472		    %% process needs to be buffered)
2473		    set_io_buffering(undefined);
2474		_ ->
2475		    ok
2476	    end,
2477	    run_test_cases_loop(Cases, Config, TimetrapData, tl(Mode),
2478				delete_status(Ref, Status));
2479	{_,false} ->
2480	    %% this is a skipped start conf for a group which is not nested
2481	    %% under a parallel group
2482	    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
2483				   false, SkipMode),
2484	    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
2485	    test_server_sup:framework_call(report, [ReportTag,ConfData]),
2486	    run_test_cases_loop(Cases, Config, TimetrapData,
2487				[conf(Ref,[])|Mode], Status);
2488	{_,Ref0} when is_reference(Ref0) ->
2489	    %% this is a skipped start conf for a group nested under a parallel
2490	    %% group and if this is the first nested group, io buffering must
2491	    %% be activated
2492	    if CurrIOHandler == undefined ->
2493		    set_io_buffering({Ref,self()});
2494	       true ->
2495		    ok
2496	    end,
2497	    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
2498				   true, SkipMode),
2499	    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
2500	    test_server_sup:framework_call(report, [ReportTag,ConfData]),
2501	    run_test_cases_loop(Cases, Config, TimetrapData,
2502				[conf(Ref,[])|Mode], Status)
2503    end;
2504
2505run_test_cases_loop([{auto_skip_case,{Case,Comment},SkipMode}|Cases],
2506		    Config, TimetrapData, Mode, Status) ->
2507    {Mod,Func} = skip_case(auto, undefined, get(test_server_case_num)+1,
2508			   Case, Comment, is_io_buffered(), SkipMode),
2509    test_server_sup:framework_call(report, [tc_auto_skip,
2510					    {Mod,{Func,get_name(SkipMode)},
2511					     Comment}]),
2512    run_test_cases_loop(Cases, Config, TimetrapData, Mode,
2513			update_status(skipped, Mod, Func, Status));
2514
2515run_test_cases_loop([{skip_case,{{Mod,all}=Case,Comment},SkipMode}|Cases],
2516		    Config, TimetrapData, Mode, Status) ->
2517    _ = skip_case(user, undefined, 0, Case, Comment, false, SkipMode),
2518    test_server_sup:framework_call(report, [tc_user_skip,
2519					    {Mod,{all,get_name(SkipMode)},
2520					     Comment}]),
2521    run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status);
2522
2523run_test_cases_loop([{skip_case,{Case,Comment},SkipMode}|Cases],
2524		    Config, TimetrapData, Mode, Status) ->
2525    {Mod,Func} = skip_case(user, undefined, get(test_server_case_num)+1,
2526			   Case, Comment, is_io_buffered(), SkipMode),
2527    test_server_sup:framework_call(report, [tc_user_skip,
2528					    {Mod,{Func,get_name(SkipMode)},
2529					     Comment}]),
2530    run_test_cases_loop(Cases, Config, TimetrapData, Mode,
2531			update_status(skipped, Mod, Func, Status));
2532
2533%% a start *or* end conf case, wrapping test cases or other conf cases
2534run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
2535		    Config, TimetrapData, Mode0, Status) ->
2536    CurrIOHandler = get(test_server_common_io_handler),
2537    %% check and update the mode for test case execution and io msg handling
2538    {StartConf,Mode,IOHandler,ConfTime,Status1} =
2539	case {curr_ref(Mode0),check_props(parallel, Mode0)} of
2540	    {Ref,Ref} ->
2541		case check_props(parallel, tl(Mode0)) of
2542		    false ->
2543			%% this is an end conf for a top level parallel group,
2544			%% collect results from the test case processes
2545			%% and calc total time
2546			OkSkipFail = handle_test_case_io_and_status(),
2547			ok = file:set_cwd(filename:dirname(get(test_server_dir))),
2548			After = ?now,
2549			Before = get(test_server_parallel_start_time),
2550			Elapsed = timer:now_diff(After, Before)/1000000,
2551			put(test_server_total_time, Elapsed),
2552			{false,tl(Mode0),undefined,Elapsed,
2553			 update_status(Ref, OkSkipFail, Status)};
2554		    _ ->
2555			%% this is an end conf for a parallel group nested under a
2556			%% parallel group (io buffering is active)
2557			OkSkipFail = wait_for_cases(Ref),
2558			queue_test_case_io(Ref, self(), 0, Mod, Func),
2559			Elapsed = timer:now_diff(?now, conf_start(Ref, Mode0))/1000000,
2560			case CurrIOHandler of
2561			    {Ref,_} ->
2562				%% current_io_handler was set by start conf of this
2563				%% group, so we can unset it after this case (no
2564				%% more io from main process needs to be buffered)
2565				{false,tl(Mode0),undefined,Elapsed,
2566				 update_status(Ref, OkSkipFail, Status)};
2567			    _ ->
2568				{false,tl(Mode0),CurrIOHandler,Elapsed,
2569				 update_status(Ref, OkSkipFail, Status)}
2570			end
2571		end;
2572	    {Ref,false} ->
2573		%% this is an end conf for a non-parallel group that's not
2574		%% nested under a parallel group, so no need to buffer io
2575		{false,tl(Mode0),undefined,
2576		 timer:now_diff(?now, conf_start(Ref, Mode0))/1000000, Status};
2577	    {Ref,_} ->
2578		%% this is an end conf for a non-parallel group nested under
2579		%% a parallel group (io buffering is active)
2580		queue_test_case_io(Ref, self(), 0, Mod, Func),
2581		Elapsed = timer:now_diff(?now, conf_start(Ref, Mode0))/1000000,
2582		case CurrIOHandler of
2583		    {Ref,_} ->
2584			%% current_io_handler was set by start conf of this
2585			%% group, so we can unset it after this case (no
2586			%% more io from main process needs to be buffered)
2587			{false,tl(Mode0),undefined,Elapsed,Status};
2588		    _ ->
2589			{false,tl(Mode0),CurrIOHandler,Elapsed,Status}
2590		end;
2591	    {_,false} ->
2592		%% this is a start conf for a group which is not nested under a
2593		%% parallel group, check if this case starts a new parallel group
2594		case lists:member(parallel, Props) of
2595		    true ->
2596			%% prepare for execution of parallel group
2597			put(test_server_parallel_start_time, ?now),
2598			put(test_server_queued_io, []);
2599		    false ->
2600			ok
2601		end,
2602		{true,[conf(Ref,Props)|Mode0],undefined,0,Status};
2603	    {_,_Ref0} ->
2604		%% this is a start conf for a group nested under a parallel group, the
2605		%% parallel_start_time and parallel_test_cases values have already been set
2606		queue_test_case_io(Ref, self(), 0, Mod, Func),
2607		%% if this is the first nested group under a parallel group, io
2608		%% buffering must be activated
2609		IOHandler1 = if CurrIOHandler == undefined ->
2610				     IOH = {Ref,self()},
2611				     set_io_buffering(IOH),
2612				     IOH;
2613				true ->
2614				     CurrIOHandler
2615			     end,
2616		{true,[conf(Ref,Props)|Mode0],IOHandler1,0,Status}
2617	end,
2618
2619    %% if this is a start conf we check if cases should be shuffled
2620    {[_Conf|Cases1]=Cs1,Shuffle} =
2621	if StartConf ->
2622		case get_shuffle(Props) of
2623		    undefined ->
2624			{Cs0,undefined};
2625		    {_,repeated} ->
2626			%% if group is repeated, a new seed should not be set every
2627			%% turn - last one is saved in dictionary
2628			CurrSeed = get(test_server_curr_random_seed),
2629			{shuffle_cases(Ref, Cs0, CurrSeed),{shuffle,CurrSeed}};
2630		    {_,Seed} ->
2631			UseSeed=
2632			    %% Determine which seed to use by:
2633			    %% 1. check the TS_RANDOM_SEED env variable
2634			    %% 2. check random_seed in process state
2635			    %% 3. use value provided with shuffle option
2636			    %% 4. use timestamp() values for seed
2637			    case os:getenv("TS_RANDOM_SEED") of
2638				Undef when Undef == false ; Undef == "undefined" ->
2639				    case get(test_server_random_seed) of
2640					undefined -> Seed;
2641					TSRS -> TSRS
2642				    end;
2643				NumStr ->
2644				    %% Ex: "123 456 789" or "123,456,789" -> {123,456,789}
2645				    list_to_tuple([list_to_integer(NS) ||
2646						   NS <- string:lexemes(NumStr, [$ ,$:,$,])])
2647			    end,
2648			{shuffle_cases(Ref, Cs0, UseSeed),{shuffle,UseSeed}}
2649		end;
2650	   not StartConf ->
2651		{Cs0,undefined}
2652	end,
2653
2654    %% if this is a start conf we check if Props specifies repeat and if so
2655    %% we copy the group and carry the copy until the end conf where we
2656    %% decide to perform the repetition or not
2657    {Repeating,Status2,Cases,ReportRepeatStop} =
2658	if StartConf ->
2659		case get_repeat(Props) of
2660		    undefined ->
2661			%% we *must* have a status entry for every conf since we
2662			%% will continously update status with test case results
2663			%% without knowing the Ref (but update hd(Status))
2664			{false,new_status(Ref, Status1),Cases1,?void_fun};
2665		    {_RepType,N} when N =< 1 ->
2666			{false,new_status(Ref, Status1),Cases1,?void_fun};
2667		    _ ->
2668			{Copied,_} = copy_cases(Ref, make_ref(), Cs1),
2669			{true,new_status(Ref, Copied, Status1),Cases1,?void_fun}
2670		end;
2671	   not StartConf ->
2672		RepVal = get_repeat(get_props(Mode0)),
2673		ReportStop =
2674		    fun() ->
2675			    print(minor, "~n*** Stopping repeat operation ~w", [RepVal]),
2676			    print(1, "Stopping repeat operation ~w", [RepVal])
2677		    end,
2678		CopiedCases = get_copied_cases(Status1),
2679		EndStatus = delete_status(Ref, Status1),
2680		%% check in Mode0 if this is a repeat conf
2681		case RepVal of
2682		    undefined ->
2683			{false,EndStatus,Cases1,?void_fun};
2684		    {_RepType,N} when N =< 1 ->
2685			{false,EndStatus,Cases1,?void_fun};
2686		    {repeat,_} ->
2687			{true,EndStatus,CopiedCases++Cases1,?void_fun};
2688		    {repeat_until_all_ok,_} ->
2689			{RestCs,Fun} = case get_tc_results(Status1) of
2690					   {_,_,[]} ->
2691					       {Cases1,ReportStop};
2692					   _ ->
2693					       {CopiedCases++Cases1,?void_fun}
2694				       end,
2695			{true,EndStatus,RestCs,Fun};
2696		    {repeat_until_any_ok,_} ->
2697			{RestCs,Fun} = case get_tc_results(Status1) of
2698					   {Ok,_,_Fails} when length(Ok) > 0 ->
2699					       {Cases1,ReportStop};
2700					   _ ->
2701					       {CopiedCases++Cases1,?void_fun}
2702				       end,
2703			{true,EndStatus,RestCs,Fun};
2704		    {repeat_until_any_fail,_} ->
2705			{RestCs,Fun} = case get_tc_results(Status1) of
2706					   {_,_,Fails} when length(Fails) > 0 ->
2707					       {Cases1,ReportStop};
2708					   _ ->
2709					       {CopiedCases++Cases1,?void_fun}
2710				 end,
2711			{true,EndStatus,RestCs,Fun};
2712		    {repeat_until_all_fail,_} ->
2713			{RestCs,Fun} = case get_tc_results(Status1) of
2714					   {[],_,_} ->
2715					       {Cases1,ReportStop};
2716					   _ ->
2717					       {CopiedCases++Cases1,?void_fun}
2718				       end,
2719			{true,EndStatus,RestCs,Fun}
2720		end
2721	end,
2722
2723    ReportAbortRepeat = fun(What) when Repeating ->
2724				print(minor, "~n*** Aborting repeat operation "
2725				      "(configuration case ~w)", [What]),
2726				print(1, "Aborting repeat operation "
2727				      "(configuration case ~w)", [What]);
2728			   (_) -> ok
2729			end,
2730    CfgProps = if StartConf ->
2731		       if Shuffle == undefined ->
2732			       [{tc_group_properties,Props}];
2733			  true ->
2734			       [{tc_group_properties,
2735				 [Shuffle|delete_shuffle(Props)]}]
2736		       end;
2737		  not StartConf ->
2738		       {TcOk,TcSkip,TcFail} = get_tc_results(Status1),
2739		       [{tc_group_properties,get_props(Mode0)},
2740			{tc_group_result,[{ok,TcOk},
2741					  {skipped,TcSkip},
2742					  {failed,TcFail}]}]
2743	       end,
2744
2745    SuiteName = proplists:get_value(suite, Props),
2746    case get(test_server_create_priv_dir) of
2747	auto_per_run ->				% use common priv_dir
2748	    TSDirs = [{priv_dir,get(test_server_priv_dir)},
2749		      {data_dir,get_data_dir(Mod, SuiteName)}];
2750	_ ->
2751	    TSDirs = [{data_dir,get_data_dir(Mod, SuiteName)}]
2752    end,
2753
2754    ActualCfg =
2755	if not StartConf ->
2756		update_config(hd(Config), TSDirs ++ CfgProps);
2757	   true ->
2758		GroupPath = lists:flatmap(fun({_Ref,[],_T}) -> [];
2759					     ({_Ref,GrProps,_T}) -> [GrProps]
2760					  end, Mode0),
2761		update_config(hd(Config),
2762			      TSDirs ++ [{tc_group_path,GroupPath} | CfgProps])
2763	end,
2764
2765    CurrMode = curr_mode(Ref, Mode0, Mode),
2766    ConfCaseResult = run_test_case(Ref, 0, Mod, Func, [ActualCfg], skip_init,
2767				   TimetrapData, CurrMode),
2768
2769    case ConfCaseResult of
2770	{_,NewCfg,_} when Func == init_per_suite, is_list(NewCfg) ->
2771	    %% check that init_per_suite returned data on correct format
2772	    case lists:filter(fun({_,_}) -> false;
2773				 (_) -> true end, NewCfg) of
2774		[] ->
2775		    set_io_buffering(IOHandler),
2776		    stop_minor_log_file(),
2777		    run_test_cases_loop(Cases, [NewCfg|Config],
2778					TimetrapData, Mode, Status2);
2779		Bad ->
2780		    print(minor,
2781			  "~n*** ~tw returned bad elements in Config: ~tp.~n",
2782			  [Func,Bad]),
2783		    Reason = {failed,{Mod,init_per_suite,bad_return}},
2784		    Cases2 = skip_cases_upto(Ref, Cases, Reason, conf, CurrMode,
2785					     auto_skip_case),
2786		    set_io_buffering(IOHandler),
2787		    stop_minor_log_file(),
2788		    run_test_cases_loop(Cases2, Config, TimetrapData, Mode,
2789					delete_status(Ref, Status2))
2790	    end;
2791	{_,NewCfg,_} when StartConf, is_list(NewCfg) ->
2792	    print_conf_time(ConfTime),
2793	    set_io_buffering(IOHandler),
2794	    stop_minor_log_file(),
2795	    run_test_cases_loop(Cases, [NewCfg|Config], TimetrapData, Mode, Status2);
2796	{_,{framework_error,{FwMod,FwFunc},Reason},_} ->
2797	    print(minor, "~n*** ~w failed in ~tw. Reason: ~tp~n",
2798		  [FwMod,FwFunc,Reason]),
2799	    print(1, "~w failed in ~tw. Reason: ~tp~n", [FwMod,FwFunc,Reason]),
2800	    exit(framework_error);
2801	{_,Fail,_} when element(1,Fail) == 'EXIT';
2802			element(1,Fail) == timetrap_timeout;
2803			element(1,Fail) == user_timetrap_error;
2804			element(1,Fail) == failed ->
2805	    {Cases2,Config1,Status3} =
2806		if StartConf ->
2807			ReportAbortRepeat(failed),
2808			print(minor, "~n*** ~tw failed.~n"
2809			      "    Skipping all cases.", [Func]),
2810			Reason = {failed,{Mod,Func,Fail}},
2811			{skip_cases_upto(Ref, Cases, Reason, conf, CurrMode,
2812					 auto_skip_case),
2813			 Config,
2814			 update_status(failed, group_result, get_name(Mode),
2815				       delete_status(Ref, Status2))};
2816		   not StartConf ->
2817			ReportRepeatStop(),
2818			print_conf_time(ConfTime),
2819			{Cases,tl(Config),delete_status(Ref, Status2)}
2820		end,
2821	    set_io_buffering(IOHandler),
2822	    stop_minor_log_file(),
2823	    run_test_cases_loop(Cases2, Config1, TimetrapData, Mode, Status3);
2824
2825	{_,{auto_skip,SkipReason},_} ->
2826	    %% this case can only happen if the framework (not the user)
2827	    %% decides to skip execution of a conf function
2828	    {Cases2,Config1,Status3} =
2829		if StartConf ->
2830			ReportAbortRepeat(auto_skipped),
2831			print(minor, "~n*** ~tw auto skipped.~n"
2832			      "    Skipping all cases.", [Func]),
2833			{skip_cases_upto(Ref, Cases, SkipReason, conf, CurrMode,
2834					 auto_skip_case),
2835			 Config,
2836			 delete_status(Ref, Status2)};
2837		   not StartConf ->
2838			ReportRepeatStop(),
2839			print_conf_time(ConfTime),
2840			{Cases,tl(Config),delete_status(Ref, Status2)}
2841		end,
2842	    set_io_buffering(IOHandler),
2843	    stop_minor_log_file(),
2844	    run_test_cases_loop(Cases2, Config1, TimetrapData, Mode, Status3);
2845
2846	{_,{Skip,Reason},_} when StartConf and ((Skip==skip) or (Skip==skipped)) ->
2847	    ReportAbortRepeat(skipped),
2848	    print(minor, "~n*** ~tw skipped.~n"
2849		  "    Skipping all cases.", [Func]),
2850	    set_io_buffering(IOHandler),
2851	    stop_minor_log_file(),
2852	    run_test_cases_loop(skip_cases_upto(Ref, Cases, Reason, conf,
2853						CurrMode, skip_case),
2854				Config, TimetrapData, Mode,
2855				delete_status(Ref, Status2));
2856	{_,{skip_and_save,Reason,_SavedConfig},_} when StartConf ->
2857	    ReportAbortRepeat(skipped),
2858	    print(minor, "~n*** ~tw skipped.~n"
2859		  "    Skipping all cases.", [Func]),
2860	    set_io_buffering(IOHandler),
2861	    stop_minor_log_file(),
2862	    run_test_cases_loop(skip_cases_upto(Ref, Cases, Reason, conf,
2863						CurrMode, skip_case),
2864				[hd(Config)|Config], TimetrapData, Mode,
2865				delete_status(Ref, Status2));
2866	{_,_Other,_} when Func == init_per_suite ->
2867	    print(minor, "~n*** init_per_suite failed to return a Config list.~n", []),
2868	    Reason = {failed,{Mod,init_per_suite,bad_return}},
2869	    Cases2 = skip_cases_upto(Ref, Cases, Reason, conf, CurrMode,
2870				     auto_skip_case),
2871	    set_io_buffering(IOHandler),
2872	    stop_minor_log_file(),
2873	    run_test_cases_loop(Cases2, Config, TimetrapData, Mode,
2874				delete_status(Ref, Status2));
2875	{_,_Other,_} when StartConf ->
2876	    print_conf_time(ConfTime),
2877	    set_io_buffering(IOHandler),
2878	    ReportRepeatStop(),
2879	    stop_minor_log_file(),
2880	    run_test_cases_loop(Cases, [hd(Config)|Config], TimetrapData,
2881				Mode, Status2);
2882	{_,_EndConfRetVal,Opts} ->
2883	    %% Check if return_group_result is set (ok, skipped or failed) and
2884	    %% if so:
2885	    %% 1) *If* the parent group is a sequence, skip all proceeding tests
2886	    %%    in that group.
2887	    %% 2) Return the value to the group "above" so that result may be
2888	    %%    used for evaluating a 'repeat_until_*' property.
2889	    GrName = get_name(Mode0, Func),
2890	    {Cases2,Status3} =
2891		case lists:keysearch(return_group_result, 1, Opts) of
2892		    {value,{_,failed}} ->
2893			case {curr_ref(Mode),check_prop(sequence, Mode)} of
2894			    {ParentRef,ParentRef} ->
2895				Reason = {group_result,GrName,failed},
2896				{skip_cases_upto(ParentRef, Cases, Reason, tc,
2897						 Mode, auto_skip_case),
2898				 update_status(failed, group_result, GrName,
2899					       delete_status(Ref, Status2))};
2900			    _ ->
2901				{Cases,update_status(failed, group_result, GrName,
2902						     delete_status(Ref, Status2))}
2903			end;
2904		    {value,{_,GroupResult}} ->
2905			{Cases,update_status(GroupResult, group_result, GrName,
2906					     delete_status(Ref, Status2))};
2907		    false ->
2908			{Cases,update_status(ok, group_result, GrName,
2909					     delete_status(Ref, Status2))}
2910		end,
2911	    print_conf_time(ConfTime),
2912	    ReportRepeatStop(),
2913	    set_io_buffering(IOHandler),
2914	    stop_minor_log_file(),
2915	    run_test_cases_loop(Cases2, tl(Config), TimetrapData,
2916				Mode, Status3)
2917    end;
2918
2919run_test_cases_loop([{make,Ref,{Mod,Func,Args}}|Cases0], Config, TimetrapData,
2920		    Mode, Status) ->
2921    case run_test_case(Ref, 0, Mod, Func, Args, skip_init, TimetrapData) of
2922	{_,Why={'EXIT',_},_} ->
2923	    print(minor, "~n*** ~tw failed.~n"
2924 		  "    Skipping all cases.", [Func]),
2925	    Reason = {failed,{Mod,Func,Why}},
2926	    Cases = skip_cases_upto(Ref, Cases0, Reason, conf, Mode,
2927				    auto_skip_case),
2928	    stop_minor_log_file(),
2929	    run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status);
2930	{_,_Whatever,_} ->
2931	    stop_minor_log_file(),
2932	    run_test_cases_loop(Cases0, Config, TimetrapData, Mode, Status)
2933    end;
2934
2935run_test_cases_loop([{conf,_Ref,_Props,_X}=Conf|_Cases0],
2936		    Config, _TimetrapData, _Mode, _Status) ->
2937    erlang:error(badarg, [Conf,Config]);
2938
2939run_test_cases_loop([{repeat,Case,{RepeatType,N}}|Cases0], Config,
2940                    TimeTrapData, Mode, Status) ->
2941    Ref = make_ref(),
2942    Parallel = check_prop(parallel, Mode) =/= false,
2943    Sequence = check_prop(sequence, Mode) =/= false,
2944    RepeatStop = RepeatType=:=repeat_until_fail
2945        orelse RepeatType=:=repeat_until_ok,
2946
2947    if Parallel andalso RepeatStop ->
2948            %% Cannot check results of test case during parallal
2949            %% execution, so only RepeatType=:=repeat is allowed in
2950            %% combination with parallel groups.
2951            erlang:error({illegal_combination,{parallel,RepeatType}});
2952       Sequence andalso RepeatStop ->
2953            %% Sequence is stop on fail + skip rest, so only
2954            %% RepeatType=:=repeat makes sense inside a sequence.
2955            erlang:error({illegal_combination,{sequence,RepeatType}});
2956       true ->
2957            Mode1 = [{Ref,[{repeat,{RepeatType,1,N}}],?now}|Mode],
2958            run_test_cases_loop([Case | Cases0], Config, TimeTrapData,
2959                                Mode1, Status)
2960    end;
2961
2962run_test_cases_loop([{Mod,Case}|Cases], Config, TimetrapData, Mode, Status) ->
2963    ActualCfg =
2964	case get(test_server_create_priv_dir) of
2965	    auto_per_run ->
2966		update_config(hd(Config), [{priv_dir,get(test_server_priv_dir)},
2967					   {data_dir,get_data_dir(Mod)}]);
2968	    _ ->
2969		update_config(hd(Config), [{data_dir,get_data_dir(Mod)}])
2970	end,
2971    run_test_cases_loop([{Mod,Case,[ActualCfg]}|Cases], Config,
2972			TimetrapData, Mode, Status);
2973
2974run_test_cases_loop([{Mod,Func,Args}=Case|Cases], Config, TimetrapData, Mode0, Status) ->
2975    {Num,RunInit} =
2976	case FwMod = get_fw_mod(?MODULE) of
2977	    Mod when Func == error_in_suite ->
2978		{-1,skip_init};
2979	    _ ->
2980		{put(test_server_case_num, get(test_server_case_num)+1),
2981		 run_init}
2982	end,
2983
2984    Mode =
2985        case Mode0 of
2986            [{_,[{repeat,{_,_,_}}],_}|RestMode] ->
2987                RestMode;
2988            _ ->
2989                Mode0
2990        end,
2991
2992    %% check the current execution mode and save info about the case if
2993    %% detected that printouts to common log files is handled later
2994
2995    case check_prop(parallel, Mode) =:= false andalso is_io_buffered() of
2996	true ->
2997	    %% sequential test case nested in a parallel group;
2998	    %% io is buffered, so we must queue this test case
2999	    queue_test_case_io(undefined, self(), Num+1, Mod, Func);
3000	false ->
3001	    ok
3002    end,
3003
3004    case run_test_case(undefined, Num+1, Mod, Func, Args,
3005		       RunInit, TimetrapData, Mode) of
3006	%% callback to framework module failed, exit immediately
3007	{_,{framework_error,{FwMod,FwFunc},Reason},_} ->
3008	    print(minor, "~n*** ~w failed in ~tw. Reason: ~tp~n",
3009		  [FwMod,FwFunc,Reason]),
3010	    print(1, "~w failed in ~tw. Reason: ~tp~n", [FwMod,FwFunc,Reason]),
3011	    stop_minor_log_file(),
3012	    exit(framework_error);
3013	%% sequential execution of test case finished
3014	{Time,RetVal,_} ->
3015            RetTag =
3016                if is_tuple(RetVal) -> element(1,RetVal);
3017                   true -> undefined
3018                end,
3019	    {Result,Failed,Status1} =
3020                case RetTag of
3021                    Skip when Skip==skip; Skip==skipped ->
3022                        {skipped,false,update_status(skipped, Mod, Func, Status)};
3023                    Fail when Fail=='EXIT'; Fail==failed ->
3024                        {failed,true,update_status(failed, Mod, Func, Status)};
3025                    _ when Time==died, RetVal=/=ok ->
3026                        {failed,true,update_status(failed, Mod, Func, Status)};
3027                    _ ->
3028                        {ok,false,update_status(ok, Mod, Func, Status)}
3029                end,
3030	    case check_prop(sequence, Mode) of
3031		false ->
3032                    {Cases1,Mode1} =
3033                        check_repeat_testcase(Case,Result,Cases,Mode0),
3034		    stop_minor_log_file(),
3035		    run_test_cases_loop(Cases1, Config, TimetrapData, Mode1, Status1);
3036		Ref ->
3037		    %% the case is in a sequence; we must check the result and
3038		    %% determine if the following cases should run or be skipped
3039		    if not Failed ->	      % proceed with next case
3040                            {Cases1,Mode1} =
3041                                check_repeat_testcase(Case,Result,Cases,Mode0),
3042			    stop_minor_log_file(),
3043			    run_test_cases_loop(Cases1, Config, TimetrapData, Mode1, Status1);
3044		       true ->	              % skip rest of cases in sequence
3045			    print(minor, "~n*** ~tw failed.~n"
3046				  "    Skipping all other cases in sequence.",
3047				  [Func]),
3048                            {Cases1,Mode1} =
3049                                check_repeat_testcase(Case,Result,Cases,Mode0),
3050			    Reason = {failed,{Mod,Func}},
3051			    Cases2 = skip_cases_upto(Ref, Cases1, Reason, tc,
3052						     Mode, auto_skip_case),
3053			    stop_minor_log_file(),
3054			    run_test_cases_loop(Cases2, Config, TimetrapData, Mode1, Status1)
3055		    end
3056	    end;
3057	%% the test case is being executed in parallel with the main process (and
3058	%% other test cases) and Pid is the dedicated process executing the case
3059	Pid ->
3060	    %% io from Pid will be buffered by the test_server_io process and
3061	    %% handled later, so we have to save info about the case
3062	    queue_test_case_io(undefined, Pid, Num+1, Mod, Func),
3063            {Cases1,Mode1} = check_repeat_testcase(Case,ok,Cases,Mode0),
3064	    run_test_cases_loop(Cases1, Config, TimetrapData, Mode1, Status)
3065    end;
3066
3067%% TestSpec processing finished
3068run_test_cases_loop([], _Config, _TimetrapData, _, _) ->
3069    ok.
3070
3071%%--------------------------------------------------------------------
3072%% various help functions
3073
3074new_status(Ref, Status) ->
3075    [{Ref,{{[],[],[]},[]}} | Status].
3076
3077new_status(Ref, CopiedCases, Status) ->
3078    [{Ref,{{[],[],[]},CopiedCases}} | Status].
3079
3080delete_status(Ref, Status) ->
3081    lists:keydelete(Ref, 1, Status).
3082
3083update_status(ok, Mod, Func, [{Ref,{{Ok,Skip,Fail},Cs}} | Status]) ->
3084    [{Ref,{{Ok++[{Mod,Func}],Skip,Fail},Cs}} | Status];
3085
3086update_status(skipped, Mod, Func, [{Ref,{{Ok,Skip,Fail},Cs}} | Status]) ->
3087    [{Ref,{{Ok,Skip++[{Mod,Func}],Fail},Cs}} | Status];
3088
3089update_status(failed, Mod, Func, [{Ref,{{Ok,Skip,Fail},Cs}} | Status]) ->
3090    [{Ref,{{Ok,Skip,Fail++[{Mod,Func}]},Cs}} | Status];
3091
3092update_status(_, _, _, []) ->
3093    [].
3094
3095update_status(Ref, {Ok,Skip,Fail}, [{Ref,{{Ok0,Skip0,Fail0},Cs}} | Status]) ->
3096    [{Ref,{{Ok0++Ok,Skip0++Skip,Fail0++Fail},Cs}} | Status].
3097
3098get_copied_cases([{_,{_,Cases}} | _Status]) ->
3099    Cases.
3100
3101get_tc_results([{_,{OkSkipFail,_}} | _Status]) ->
3102    OkSkipFail;
3103get_tc_results([]) ->		      % in case init_per_suite crashed
3104    {[],[],[]}.
3105
3106conf(Ref, Props) ->
3107    {Ref,Props,?now}.
3108
3109curr_ref([{Ref,_Props,_}|_]) ->
3110    Ref;
3111curr_ref([]) ->
3112    undefined.
3113
3114curr_mode(Ref, Mode0, Mode1) ->
3115    case curr_ref(Mode1) of
3116	Ref -> Mode1;
3117	_   -> Mode0
3118    end.
3119
3120get_props([{_,Props,_} | _]) ->
3121    Props;
3122get_props([]) ->
3123    [].
3124
3125check_prop(_Attrib, []) ->
3126    false;
3127check_prop(Attrib, [{Ref,Props,_}|_]) ->
3128    case lists:member(Attrib, Props) of
3129	true -> Ref;
3130	false -> false
3131    end.
3132
3133check_props(Attrib, Mode) ->
3134    case [R || {R,Ps,_} <- Mode, lists:member(Attrib, Ps)] of
3135	[] -> false;
3136	[Ref|_] -> Ref
3137    end.
3138
3139get_name(Mode, Def) ->
3140    case get_name(Mode) of
3141	undefined -> Def;
3142	Name      -> Name
3143    end.
3144
3145get_name([{_Ref,Props,_}|_]) ->
3146    proplists:get_value(name, Props);
3147get_name([]) ->
3148    undefined.
3149
3150conf_start(Ref, Mode) ->
3151    case lists:keysearch(Ref, 1, Mode) of
3152	{value,{_,_,T}} -> T;
3153	false -> 0
3154    end.
3155
3156
3157get_data_dir(Mod) ->
3158    get_data_dir(Mod, undefined).
3159
3160get_data_dir(Mod, Suite) ->
3161    UseMod = if Suite == undefined -> Mod;
3162		true               -> Suite
3163	     end,
3164    case code:which(UseMod) of
3165	non_existing ->
3166	    print(12, "The module ~w is not loaded", [Mod]),
3167	    [];
3168	cover_compiled ->
3169	    MainCoverNode = cover:get_main_node(),
3170	    {file,File} = rpc:call(MainCoverNode,cover,is_compiled,[UseMod]),
3171	    do_get_data_dir(UseMod,File);
3172	FullPath ->
3173	    do_get_data_dir(UseMod,FullPath)
3174    end.
3175
3176do_get_data_dir(Mod,File) ->
3177    filename:dirname(File) ++ "/" ++ atom_to_list(Mod) ++ ?data_dir_suffix.
3178
3179print_conf_time(0) ->
3180    ok;
3181print_conf_time(ConfTime) ->
3182    print(major, "=group_time    ~.3fs", [ConfTime]),
3183    print(minor, "~n=== Total execution time of group: ~.3fs~n", [ConfTime]).
3184
3185print_props([]) ->
3186    ok;
3187print_props(Props) ->
3188    print(major, "=group_props   ~tp", [Props]),
3189    print(minor, "Group properties: ~tp~n", [Props]).
3190
3191%% repeat N times:                                  {repeat,N}
3192%% repeat N times or until all successful:          {repeat_until_all_ok,N}
3193%% repeat N times or until at least one successful: {repeat_until_any_ok,N}
3194%% repeat N times or until at least one case fails: {repeat_until_any_fail,N}
3195%% repeat N times or until all fails:               {repeat_until_all_fail,N}
3196%% N      = integer() | forever
3197get_repeat(Props) ->
3198    get_prop([repeat,repeat_until_all_ok,repeat_until_any_ok,
3199	      repeat_until_any_fail,repeat_until_all_fail], forever, Props).
3200
3201update_repeat(Props) ->
3202    case get_repeat(Props) of
3203	undefined ->
3204	    Props;
3205	{RepType,N} ->
3206	    Props1 =
3207		if N == forever ->
3208			[{RepType,N}|lists:keydelete(RepType, 1, Props)];
3209		   N < 3 ->
3210			lists:keydelete(RepType, 1, Props);
3211		   N >= 3 ->
3212			[{RepType,N-1}|lists:keydelete(RepType, 1, Props)]
3213		end,
3214	    %% if shuffle is used in combination with repeat, a new
3215	    %% seed shouldn't be set every new turn
3216	    case get_shuffle(Props1) of
3217		undefined ->
3218		    Props1;
3219		_ ->
3220		    [{shuffle,repeated}|delete_shuffle(Props1)]
3221	    end
3222    end.
3223
3224get_shuffle(Props) ->
3225    get_prop([shuffle], ?now, Props).
3226
3227delete_shuffle(Props) ->
3228    delete_prop([shuffle], Props).
3229
3230%% Return {Item,Value} if found, else if Item alone
3231%% is found, return {Item,Default}
3232get_prop([Item|Items], Default, Props) ->
3233    case lists:keysearch(Item, 1, Props) of
3234	{value,R} ->
3235	    R;
3236	false ->
3237	    case lists:member(Item, Props) of
3238		true ->
3239		    {Item,Default};
3240		false ->
3241		    get_prop(Items, Default, Props)
3242	    end
3243    end;
3244get_prop([], _Def, _Props) ->
3245    undefined.
3246
3247delete_prop([Item|Items], Props) ->
3248    Props1 = lists:delete(Item, lists:keydelete(Item, 1, Props)),
3249    delete_prop(Items, Props1);
3250delete_prop([], Props) ->
3251    Props.
3252
3253%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3254%% shuffle_cases(Ref, Cases, Seed) -> Cases1
3255%%
3256%% Shuffles the order of Cases.
3257
3258shuffle_cases(Ref, Cases, undefined) ->
3259    shuffle_cases(Ref, Cases, rand:seed_s(exsplus));
3260
3261shuffle_cases(Ref, [{conf,Ref,_,_}=Start | Cases], Seed0) ->
3262    {N,CasesToShuffle,Rest} = cases_to_shuffle(Ref, Cases),
3263    Seed = case Seed0 of
3264	       {X,Y,Z} when is_integer(X+Y+Z) ->
3265		   rand:seed(exsplus, Seed0);
3266	       _ ->
3267		   Seed0
3268	   end,
3269    ShuffledCases = random_order(N, rand:uniform_s(N, Seed), CasesToShuffle, []),
3270    [Start|ShuffledCases] ++ Rest.
3271
3272cases_to_shuffle(Ref, Cases) ->
3273    cases_to_shuffle(Ref, Cases, 1, []).
3274
3275cases_to_shuffle(Ref, [{conf,Ref,_,_} | _]=Cs, N, Ix) ->          % end
3276    {N-1,Ix,Cs};
3277cases_to_shuffle(Ref, [{skip_case,{_,Ref,_,_},_} | _]=Cs, N, Ix) -> % end
3278    {N-1,Ix,Cs};
3279
3280cases_to_shuffle(Ref, [{conf,Ref1,_,_}=C | Cs], N, Ix) ->          % nested group
3281    {Cs1,Rest} = get_subcases(Ref1, Cs, []),
3282    cases_to_shuffle(Ref, Rest, N+1, [{N,[C|Cs1]} | Ix]);
3283cases_to_shuffle(Ref, [{skip_case,{_,Ref1,_,_},_}=C | Cs], N, Ix) -> % nested group
3284    {Cs1,Rest} = get_subcases(Ref1, Cs, []),
3285    cases_to_shuffle(Ref, Rest, N+1, [{N,[C|Cs1]} | Ix]);
3286
3287cases_to_shuffle(Ref, [C | Cs], N, Ix) ->
3288    cases_to_shuffle(Ref, Cs, N+1, [{N,[C]} | Ix]).
3289
3290get_subcases(SubRef, [{conf,SubRef,_,_}=C | Cs], SubCs) ->
3291    {lists:reverse([C|SubCs]),Cs};
3292get_subcases(SubRef, [{skip_case,{_,SubRef,_,_},_}=C | Cs], SubCs) ->
3293    {lists:reverse([C|SubCs]),Cs};
3294get_subcases(SubRef, [C|Cs], SubCs) ->
3295    get_subcases(SubRef, Cs, [C|SubCs]).
3296
3297random_order(1, {_Pos,Seed}, [{_Ix,CaseOrGroup}], Shuffled) ->
3298    %% save current seed to be used if test cases are repeated
3299    put(test_server_curr_random_seed, Seed),
3300    Shuffled++CaseOrGroup;
3301random_order(N, {Pos,NewSeed}, IxCases, Shuffled) ->
3302    {First,[{_Ix,CaseOrGroup}|Rest]} = lists:split(Pos-1, IxCases),
3303    random_order(N-1, rand:uniform_s(N-1, NewSeed),
3304		 First++Rest, Shuffled++CaseOrGroup).
3305
3306
3307%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3308%% skip_case(Type, Ref, CaseNum, Case, Comment, SendSync) -> {Mod,Func}
3309%%
3310%% Prints info about a skipped case in the major and html log files.
3311%% SendSync determines if start and finished messages must be sent so
3312%% that the printouts can be buffered and handled in order with io from
3313%% parallel processes.
3314skip_case(Type, Ref, CaseNum, Case, Comment, SendSync, Mode) ->
3315    MF = {Mod,Func} = case Case of
3316			  {M,F,_A} -> {M,F};
3317			  {M,F} -> {M,F}
3318		      end,
3319    if SendSync ->
3320	    queue_test_case_io(Ref, self(), CaseNum, Mod, Func),
3321	    self() ! {started,Ref,self(),CaseNum,Mod,Func},
3322	    test_server_io:start_transaction(),
3323	    skip_case1(Type, CaseNum, Mod, Func, Comment, Mode),
3324	    test_server_io:end_transaction(),
3325	    self() ! {finished,Ref,self(),CaseNum,Mod,Func,skipped,{0,skipped,[]}};
3326       not SendSync ->
3327	    skip_case1(Type, CaseNum, Mod, Func, Comment, Mode)
3328    end,
3329    MF.
3330
3331skip_case1(Type, CaseNum, Mod, Func, Comment, Mode) ->
3332    {{Col0,Col1},_} = get_font_style((CaseNum > 0), Mode),
3333    ResultCol = if Type == auto -> ?auto_skip_color;
3334		   Type == user -> ?user_skip_color
3335		end,
3336    print(major, "~n=case          ~w:~tw", [Mod,Func]),
3337    GroupName =	case get_name(Mode) of
3338		    undefined ->
3339			"";
3340		    GrName ->
3341			GrName1 = cast_to_list(GrName),
3342			print(major, "=group_props   ~tp", [[{name,GrName1}]]),
3343			GrName1
3344		end,
3345    print(major, "=started       ~s", [lists:flatten(timestamp_get(""))]),
3346    Comment1 = reason_to_string(Comment),
3347    if Type == auto ->
3348	    print(major, "=result        auto_skipped: ~ts", [Comment1]);
3349       Type == user ->
3350	    print(major, "=result        skipped: ~ts", [Comment1])
3351    end,
3352    if CaseNum == 0 ->
3353	    print(2,"*** Skipping ~tw ***", [{Mod,Func}]);
3354       true ->
3355	    print(2,"*** Skipping test case #~w ~tw ***", [CaseNum,{Mod,Func}])
3356    end,
3357    TR = xhtml("<tr valign=\"top\">",
3358               "<tr class=\"" ++ odd_or_even() ++ "\">"),
3359    GroupName =	case get_name(Mode) of
3360		    undefined -> "";
3361		    Name      -> cast_to_list(Name)
3362		end,
3363    print(html,
3364	  TR ++ "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>"
3365	  "<td>" ++ Col0 ++ "~w" ++ Col1 ++ "</td>"
3366	  "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>"
3367	  "<td>" ++ Col0 ++ "~tw" ++ Col1 ++ "</td>"
3368	  "<td>" ++ Col0 ++ "< >" ++ Col1 ++ "</td>"
3369	  "<td>" ++ Col0 ++ "0.000s" ++ Col1 ++ "</td>"
3370	  "<td><font color=\"~ts\">SKIPPED</font></td>"
3371	  "<td>~ts</td></tr>\n",
3372	  [num2str(CaseNum),fw_name(Mod),GroupName,Func,ResultCol,Comment1]),
3373
3374    if CaseNum > 0 ->
3375	    {US,AS} = get(test_server_skipped),
3376	    case Type of
3377		user -> put(test_server_skipped, {US+1,AS});
3378		auto -> put(test_server_skipped, {US,AS+1})
3379	    end,
3380	    put(test_server_case_num, CaseNum);
3381       true ->					% conf
3382	    ok
3383    end.
3384
3385
3386%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3387%% skip_cases_upto(Ref, Cases, Reason, Origin, Mode, SkipType) -> Cases1
3388%%
3389%% SkipType = skip_case | auto_skip_case
3390%% Mark all cases tagged with Ref as skipped.
3391
3392skip_cases_upto(Ref, Cases, Reason, Origin, Mode, SkipType) ->
3393    {_,Modified,Rest} =
3394	modify_cases_upto(Ref, {skip,Reason,Origin,Mode,SkipType}, Cases),
3395    Modified++Rest.
3396
3397%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3398%% copy_cases(OrigRef, NewRef, Cases) -> Cases1
3399%%
3400%% Copy the test cases marked with OrigRef and tag the copies with NewRef.
3401%% The start conf case copy will also get its repeat property updated.
3402
3403copy_cases(OrigRef, NewRef, Cases) ->
3404    {Original,Altered,Rest} = modify_cases_upto(OrigRef, {copy,NewRef}, Cases),
3405    {Altered,Original++Altered++Rest}.
3406
3407%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3408%% modify_cases_upto(Ref, ModOp, Cases) -> {Original,Altered,Remaining}
3409%%
3410%% ModOp = {skip,Reason,Origin,Mode} | {copy,NewRef}
3411%% Origin = conf | tc
3412%%
3413%% Modifies Cases according to ModOp and returns the original elements,
3414%% the modified versions of these elements and the remaining (untouched)
3415%% cases.
3416
3417modify_cases_upto(Ref, ModOp, Cases) ->
3418    {Original,Altered,Rest} = modify_cases_upto(Ref, ModOp, Cases, [], []),
3419    {lists:reverse(Original),lists:reverse(Altered),Rest}.
3420
3421%% first case of a copy operation is the start conf
3422modify_cases_upto(Ref, {copy,NewRef}=Op, [{conf,Ref,Props,MF}=C|T], Orig, Alt) ->
3423    modify_cases_upto(Ref, Op, T, [C|Orig], [{conf,NewRef,update_repeat(Props),MF}|Alt]);
3424
3425modify_cases_upto(Ref, ModOp, Cases, Orig, Alt) ->
3426    %% we need to check if there's an end conf case with the
3427    %% same ref in the list, if not, this *is* an end conf case
3428    case lists:any(fun({_,R,_,_}) when R == Ref -> true;
3429		      ({_,R,_})   when R == Ref -> true;
3430		      ({skip_case,{_,R,_,_},_}) when R == Ref -> true;
3431		      ({skip_case,{_,R,_,_}}) when R == Ref -> true;
3432		      (_) -> false
3433		   end, Cases) of
3434	true ->
3435	    modify_cases_upto1(Ref, ModOp, Cases, Orig, Alt);
3436	false ->
3437	    {[],[],Cases}
3438    end.
3439
3440%% next case is a conf with same ref, must be end conf = we're done
3441modify_cases_upto1(Ref, {skip,Reason,conf,Mode,skip_case},
3442		   [{conf,Ref,_Props,MF}|T], Orig, Alt) ->
3443    {Orig,[{skip_case,{conf,Ref,MF,Reason},Mode}|Alt],T};
3444modify_cases_upto1(Ref, {skip,Reason,conf,Mode,auto_skip_case},
3445		   [{conf,Ref,_Props,MF}|T], Orig, Alt) ->
3446    {Orig,[{auto_skip_case,{conf,Ref,MF,Reason},Mode}|Alt],T};
3447modify_cases_upto1(Ref, {copy,NewRef}, [{conf,Ref,Props,MF}=C|T], Orig, Alt) ->
3448    {[C|Orig],[{conf,NewRef,update_repeat(Props),MF}|Alt],T};
3449
3450%% we've skipped all remaining cases in a sequence
3451modify_cases_upto1(Ref, {skip,_,tc,_,_},
3452		   [{conf,Ref,_Props,_MF}|_]=Cs, Orig, Alt) ->
3453    {Orig,Alt,Cs};
3454
3455%% next is a make case
3456modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType},
3457		   [{make,Ref,MF}|T], Orig, Alt) ->
3458    {Orig,[{SkipType,{make,Ref,MF,Reason},Mode}|Alt],T};
3459modify_cases_upto1(Ref, {copy,NewRef}, [{make,Ref,MF}=M|T], Orig, Alt) ->
3460    {[M|Orig],[{make,NewRef,MF}|Alt],T};
3461
3462%% next case is a user skipped end conf with the same ref = we're done
3463modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType},
3464		   [{skip_case,{Type,Ref,MF,_Cmt},_}|T], Orig, Alt) ->
3465    {Orig,[{SkipType,{Type,Ref,MF,Reason},Mode}|Alt],T};
3466modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType},
3467		   [{skip_case,{Type,Ref,MF,_Cmt}}|T], Orig, Alt) ->
3468    {Orig,[{SkipType,{Type,Ref,MF,Reason},Mode}|Alt],T};
3469modify_cases_upto1(Ref, {copy,NewRef},
3470		   [{skip_case,{Type,Ref,MF,Cmt},Mode}=C|T], Orig, Alt) ->
3471    {[C|Orig],[{skip_case,{Type,NewRef,MF,Cmt},Mode}|Alt],T};
3472modify_cases_upto1(Ref, {copy,NewRef},
3473		   [{skip_case,{Type,Ref,MF,Cmt}}=C|T], Orig, Alt) ->
3474    {[C|Orig],[{skip_case,{Type,NewRef,MF,Cmt}}|Alt],T};
3475
3476%% next is a skip_case, could be one test case or 'all' in suite, we must proceed
3477modify_cases_upto1(Ref, ModOp, [{skip_case,{_F,_Cmt},_Mode}=MF|T], Orig, Alt) ->
3478    modify_cases_upto1(Ref, ModOp, T, [MF|Orig], [MF|Alt]);
3479
3480%% next is a normal case (possibly in a sequence), mark as skipped, or copy, and proceed
3481modify_cases_upto1(Ref, {skip,Reason,_,Mode,skip_case}=Op,
3482		   [{_M,_F}=MF|T], Orig, Alt) ->
3483    modify_cases_upto1(Ref, Op, T, Orig, [{skip_case,{MF,Reason},Mode}|Alt]);
3484modify_cases_upto1(Ref, {skip,Reason,_,Mode,auto_skip_case}=Op,
3485		   [{_M,_F}=MF|T], Orig, Alt) ->
3486    modify_cases_upto1(Ref, Op, T, Orig, [{auto_skip_case,{MF,Reason},Mode}|Alt]);
3487modify_cases_upto1(Ref, CopyOp, [{_M,_F}=MF|T], Orig, Alt) ->
3488    modify_cases_upto1(Ref, CopyOp, T, [MF|Orig], [MF|Alt]);
3489
3490%% next is a conf case, modify the Mode arg to keep track of sub groups
3491modify_cases_upto1(Ref, {skip,Reason,FType,Mode,SkipType},
3492		   [{conf,OtherRef,Props,_MF}|T], Orig, Alt) ->
3493    case hd(Mode) of
3494	{OtherRef,_,_} ->			% end conf
3495	    modify_cases_upto1(Ref, {skip,Reason,FType,tl(Mode),SkipType},
3496			       T, Orig, Alt);
3497	_ ->					% start conf
3498	    Mode1 = [conf(OtherRef,Props)|Mode],
3499	    modify_cases_upto1(Ref, {skip,Reason,FType,Mode1,SkipType},
3500			       T, Orig, Alt)
3501    end;
3502
3503%% next is a repeated test case
3504modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType}=Op,
3505                   [{repeat,{_M,_F}=MF,_Repeat}|T], Orig, Alt) ->
3506    modify_cases_upto1(Ref, Op, T, Orig, [{SkipType,{MF,Reason},Mode}|Alt]);
3507
3508%% next is an already skipped case, ignore or copy
3509modify_cases_upto1(Ref, {skip,_,_,_,_}=Op, [{SkipType,_,_}|T], Orig, Alt)
3510  when SkipType=:=skip_case; SkipType=:=auto_skip_case ->
3511    modify_cases_upto1(Ref, Op, T, Orig, Alt);
3512
3513%% next is some other case, mark as skipped or copy
3514modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType}=Op, [Other|T], Orig, Alt) ->
3515    modify_cases_upto1(Ref, Op, T, Orig, [{SkipType,{Other,Reason},Mode}|Alt]);
3516modify_cases_upto1(Ref, CopyOp, [C|T], Orig, Alt) ->
3517    modify_cases_upto1(Ref, CopyOp, T, [C|Orig], [C|Alt]).
3518
3519
3520%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3521%% set_io_buffering(IOHandler) -> PrevIOHandler
3522%%
3523%% Save info about current process (always the main process) buffering
3524%% io printout messages from parallel test case processes (*and* possibly
3525%% also the main process).
3526
3527set_io_buffering(IOHandler) ->
3528    put(test_server_common_io_handler, IOHandler).
3529
3530%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3531%% is_io_buffered() -> true|false
3532%%
3533%% Test whether is being buffered.
3534
3535is_io_buffered() ->
3536    get(test_server_common_io_handler) =/= undefined.
3537
3538%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3539%% queue_test_case_io(Pid, Num, Mod, Func) -> ok
3540%%
3541%% Save info about test case that gets its io buffered. This can
3542%% be a parallel test case or it can be a test case (conf or normal)
3543%% that belongs to a group nested under a parallel group. The queue
3544%% is processed after io buffering is disabled. See run_test_cases_loop/4
3545%% and handle_test_case_io_and_status/0 for more info.
3546
3547queue_test_case_io(Ref, Pid, Num, Mod, Func) ->
3548    Entry = {Ref,Pid,Num,Mod,Func},
3549    %% the order of the test cases is very important!
3550    put(test_server_queued_io,
3551	get(test_server_queued_io)++[Entry]).
3552
3553%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3554%% wait_for_cases(Ref) -> {Ok,Skipped,Failed}
3555%%
3556%% At the end of a nested parallel group, we have to wait for the test
3557%% cases to terminate before we can go on (since test cases never execute
3558%% in parallel with the end conf case of the group). When a top level
3559%% parallel group is finished, buffered io messages must be handled and
3560%% this is taken care of by handle_test_case_io_and_status/0.
3561
3562wait_for_cases(Ref) ->
3563    case get(test_server_queued_io) of
3564	[] ->
3565	    {[],[],[]};
3566	Cases ->
3567	    [_Start|TCs] =
3568		lists:dropwhile(fun({R,_,_,_,_}) when R == Ref -> false;
3569				   (_) -> true
3570				end, Cases),
3571	    wait_and_resend(Ref, TCs, [],[],[])
3572    end.
3573
3574wait_and_resend(Ref, [{OtherRef,_,0,_,_}|Ps],
3575		Ok,Skip,Fail) when is_reference(OtherRef),
3576				   OtherRef /= Ref ->
3577    %% ignore cases that belong to nested group
3578    Ps1 = rm_cases_upto(OtherRef, Ps),
3579    wait_and_resend(Ref, Ps1, Ok,Skip,Fail);
3580
3581wait_and_resend(Ref, [{_,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) ->
3582    receive
3583	{finished,_Ref,CurrPid,CaseNum,Mod,Func,Result,_RetVal} = Msg ->
3584	    %% resend message to main process so that it can be used
3585	    %% to test_server_io:print_buffered/1 later
3586	    self() ! Msg,
3587	    MF = {Mod,Func},
3588	    {Ok1,Skip1,Fail1} =
3589		case Result of
3590		    ok -> {[MF|Ok],Skip,Fail};
3591		    skipped -> {Ok,[MF|Skip],Fail};
3592		    failed -> {Ok,Skip,[MF|Fail]}
3593		end,
3594	    wait_and_resend(Ref, Ps, Ok1,Skip1,Fail1);
3595	{'EXIT',CurrPid,Reason} when Reason /= normal ->
3596	    %% unexpected termination of test case process
3597	    {value,{_,_,CaseNum,Mod,Func}} = lists:keysearch(CurrPid, 2, Cases),
3598	    print(1, "Error! Process for test case #~w (~w:~tw) died! Reason: ~tp",
3599		  [CaseNum, Mod, Func, Reason]),
3600	    exit({unexpected_termination,{CaseNum,Mod,Func},{CurrPid,Reason}})
3601    end;
3602
3603wait_and_resend(_, [], Ok,Skip,Fail) ->
3604    {lists:reverse(Ok),lists:reverse(Skip),lists:reverse(Fail)}.
3605
3606rm_cases_upto(Ref, [{Ref,_,0,_,_}|Ps]) ->
3607    Ps;
3608rm_cases_upto(Ref, [_|Ps]) ->
3609    rm_cases_upto(Ref, Ps).
3610
3611%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3612%% handle_test_case_io_and_status() -> [Ok,Skipped,Failed}
3613%%
3614%% Each parallel test case process prints to its own minor log file during
3615%% execution. The common log files (major, html etc) must however be
3616%% written to sequentially. This is handled by calling
3617%% test_server_io:start_transaction/0 to tell the test_server_io process
3618%% to buffer all print requests.
3619%%
3620%% An io session is always started with a
3621%% {started,Ref,Pid,Num,Mod,Func} message (and
3622%% test_server_io:start_transaction/0 will be called) and terminated
3623%% with {finished,Ref,Pid,Num,Mod,Func,Result,RetVal} (and
3624%% test_server_io:end_transaction/0 will be called).  The result
3625%% shipped with the finished message from a parallel process is used
3626%% to update status data of the current test run. An 'EXIT' message
3627%% from each parallel test case process (after finishing and
3628%% terminating) is also received and handled here.
3629%%
3630%% During execution of a parallel group, any cases (conf or normal)
3631%% belonging to a nested group will also get its io printouts buffered.
3632%% This is necessary to get the major and html log files written in
3633%% correct sequence. This function handles also the print messages
3634%% generated by nested group cases that have been executed sequentially
3635%% by the main process (note that these cases do not generate 'EXIT'
3636%% messages, only 'start' and 'finished' messages).
3637%%
3638%% See the header comment for run_test_cases_loop/4 for more
3639%% info about IO handling.
3640%%
3641%% Note: It is important that the type of messages handled here
3642%% do not get consumed by test_server:run_test_case_msgloop/5
3643%% during the test case execution (e.g. in the catch clause of
3644%% the receive)!
3645
3646handle_test_case_io_and_status() ->
3647    case get(test_server_queued_io) of
3648	[] ->
3649	    {[],[],[]};
3650	Cases ->
3651	    %% Cases = [{Ref,Pid,CaseNum,Mod,Func} | ...]
3652	    Result = handle_io_and_exit_loop([], Cases, [],[],[]),
3653	    Main = self(),
3654	    %% flush normal exit messages
3655	    lists:foreach(fun({_,Pid,_,_,_}) when Pid /= Main ->
3656				  receive
3657				      {'EXIT',Pid,normal} -> ok
3658				  after
3659				      1000 -> ok
3660				  end;
3661			     (_) ->
3662				  ok
3663		  end, Cases),
3664	    Result
3665    end.
3666
3667%% Handle cases (without Ref) that belong to the top parallel group (i.e. when Refs = [])
3668handle_io_and_exit_loop([], [{undefined,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) ->
3669    %% retrieve the start message for the current io session (= testcase)
3670    receive
3671	{started,_,CurrPid,CaseNum,Mod,Func} ->
3672	    {Ok1,Skip1,Fail1} =
3673		case handle_io_and_exits(self(), CurrPid, CaseNum, Mod, Func, Cases) of
3674		    {ok,MF} -> {[MF|Ok],Skip,Fail};
3675		    {skipped,MF} -> {Ok,[MF|Skip],Fail};
3676		    {failed,MF} -> {Ok,Skip,[MF|Fail]}
3677		end,
3678	    handle_io_and_exit_loop([], Ps, Ok1,Skip1,Fail1)
3679    after
3680	1000 ->
3681	    exit({testcase_failed_to_start,Mod,Func})
3682    end;
3683
3684%% Handle cases that belong to groups nested under top parallel group
3685handle_io_and_exit_loop(Refs, [{Ref,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) ->
3686    receive
3687	{started,_,CurrPid,CaseNum,Mod,Func} ->
3688	    _ = handle_io_and_exits(self(), CurrPid, CaseNum, Mod, Func, Cases),
3689	    Refs1 =
3690		case Refs of
3691		    [Ref|Rs] ->	                % must be end conf case for subgroup
3692			Rs;
3693		    _ when is_reference(Ref) -> % must be start of new subgroup
3694			[Ref|Refs];
3695		    _ -> 			% must be normal subgroup testcase
3696			Refs
3697		end,
3698	    handle_io_and_exit_loop(Refs1, Ps, Ok,Skip,Fail)
3699    after
3700	1000 ->
3701	    exit({testcase_failed_to_start,Mod,Func})
3702    end;
3703
3704handle_io_and_exit_loop(_, [], Ok,Skip,Fail) ->
3705    {lists:reverse(Ok),lists:reverse(Skip),lists:reverse(Fail)}.
3706
3707handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) ->
3708    receive
3709	{abort_current_testcase=Tag,_Reason,From} ->
3710	    %% If a parallel group is executing, there is no unique
3711	    %% current test case, so we must generate an error.
3712	    From ! {self(),Tag,{error,parallel_group}},
3713	    handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases);
3714	%% end of io session from test case executed by main process
3715	{finished,_,Main,CaseNum,Mod,Func,Result,_RetVal} ->
3716	    test_server_io:print_buffered(CurrPid),
3717	    {Result,{Mod,Func}};
3718	%% end of io session from test case executed by parallel process
3719	{finished,_,CurrPid,CaseNum,Mod,Func,Result,RetVal} ->
3720	    test_server_io:print_buffered(CurrPid),
3721	    case Result of
3722		ok ->
3723		    put(test_server_ok, get(test_server_ok)+1);
3724		failed ->
3725		    put(test_server_failed, get(test_server_failed)+1);
3726		skipped ->
3727		    SkipCounters =
3728			update_skip_counters(RetVal, get(test_server_skipped)),
3729		    put(test_server_skipped, SkipCounters)
3730	    end,
3731	    {Result,{Mod,Func}};
3732
3733	%% unexpected termination of test case process
3734	{'EXIT',TCPid,Reason} when Reason /= normal ->
3735	    test_server_io:print_buffered(CurrPid),
3736	    {value,{_,_,Num,M,F}} = lists:keysearch(TCPid, 2, Cases),
3737	    print(1, "Error! Process for test case #~w (~w:~tw) died! Reason: ~tp",
3738		  [Num, M, F, Reason]),
3739	    exit({unexpected_termination,{Num,M,F},{TCPid,Reason}})
3740    end.
3741
3742
3743%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3744%% run_test_case(Ref, Num, Mod, Func, Args, RunInit,
3745%%               TimetrapData, Mode) -> RetVal
3746%%
3747%% Creates the minor log file and inserts some test case specific headers
3748%% and footers into the log files. Then the test case is executed and the
3749%% result is printed to the log files (also info about lingering processes
3750%% & slave nodes in the system is presented).
3751%%
3752%% RunInit decides if the per test case init is to be run (true for all
3753%% but conf cases).
3754%%
3755%% Mode specifies if the test case should be executed by a dedicated,
3756%% parallel, process rather than sequentially by the main process. If
3757%% the former, the new process is spawned and the dictionary of the main
3758%% process is copied to the test case process.
3759%%
3760%% RetVal is the result of executing the test case. It contains info
3761%% about the execution time and the return value of the test case function.
3762
3763run_test_case(Ref, Num, Mod, Func, Args, RunInit, TimetrapData) ->
3764    ok = file:set_cwd(filename:dirname(get(test_server_dir))),
3765    run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
3766		   TimetrapData, [], self()).
3767
3768run_test_case(Ref, Num, Mod, Func, Args, skip_init, TimetrapData, Mode) ->
3769    %% a conf case is always executed by the main process
3770    run_test_case1(Ref, Num, Mod, Func, Args, skip_init,
3771		   TimetrapData, Mode, self());
3772
3773run_test_case(Ref, Num, Mod, Func, Args, RunInit, TimetrapData, Mode) ->
3774    ok = file:set_cwd(filename:dirname(get(test_server_dir))),
3775    Main = self(),
3776    case check_prop(parallel, Mode) of
3777	false ->
3778	    %% this is a sequential test case
3779	    run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
3780			   TimetrapData, Mode, Main);
3781	_Ref ->
3782	    %% this a parallel test case, spawn the new process
3783	    Dictionary = get(),
3784	    {dictionary,Dictionary} = process_info(self(), dictionary),
3785	    spawn_link(
3786	      fun() ->
3787		      process_flag(trap_exit, true),
3788                      ct_util:mark_process(),
3789		      _ = [put(Key, Val) || {Key,Val} <- Dictionary],
3790		      set_io_buffering({tc,Main}),
3791		      run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
3792				     TimetrapData, Mode, Main)
3793	      end)
3794    end.
3795
3796run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
3797	       TimetrapData, Mode, Main) ->
3798    group_leader(test_server_io:get_gl(Main == self()), self()),
3799
3800    %% if io is being buffered, send start io session message
3801    %% (no matter if case runs on parallel or main process)
3802    case is_io_buffered() of
3803	false -> ok;
3804	true ->
3805	    test_server_io:start_transaction(),
3806	    Main ! {started,Ref,self(),Num,Mod,Func},
3807	    ok
3808    end,
3809    TSDir = get(test_server_dir),
3810
3811    print(major, "=case          ~w:~tw", [Mod, Func]),
3812    MinorName = start_minor_log_file(Mod, Func, self() /= Main),
3813    MinorBase = filename:basename(MinorName),
3814    print(major, "=logfile       ~ts", [filename:basename(MinorName)]),
3815
3816    UpdatedArgs =
3817	%% maybe create unique private directory for test case or config func
3818	case get(test_server_create_priv_dir) of
3819	    auto_per_run ->
3820		update_config(hd(Args), [{tc_logfile,MinorName}]);
3821	    PrivDirMode ->
3822		%% create unique private directory for test case
3823		RunDir = filename:dirname(MinorName),
3824		Ext =
3825		    if Num == 0 ->
3826			    Int = erlang:unique_integer([positive,monotonic]),
3827			    lists:flatten(io_lib:format(".cfg.~w", [Int]));
3828		       true ->
3829			    lists:flatten(io_lib:format(".~w", [Num]))
3830		    end,
3831		PrivDir = filename:join(RunDir, ?priv_dir) ++ Ext,
3832		if PrivDirMode == auto_per_tc ->
3833			ok = file:make_dir(PrivDir);
3834		   PrivDirMode == manual_per_tc ->
3835			ok
3836		end,
3837		update_config(hd(Args), [{priv_dir,PrivDir++"/"},
3838					 {tc_logfile,MinorName}])
3839	end,
3840    GrName = get_name(Mode),
3841    test_server_sup:framework_call(report,
3842				   [tc_start,{{Mod,{Func,GrName}},
3843					      MinorName}]),
3844
3845    {ok,Cwd} = file:get_cwd(),
3846    Args2Print = if is_list(UpdatedArgs) ->
3847			 lists:keydelete(tc_group_result, 1, UpdatedArgs);
3848		     true ->
3849			 UpdatedArgs
3850		 end,
3851    if RunInit == skip_init ->
3852	    print_props(get_props(Mode));
3853       true ->
3854	    ok
3855    end,
3856
3857    print(minor,
3858          "~ts",
3859	  [escape_chars(io_lib:format("Config value:\n\n    ~tp\n", [Args2Print]))]),
3860    print(minor, "Current directory is ~tp\n", [Cwd]),
3861
3862    GrNameStr =	case GrName of
3863		    undefined -> "";
3864		    Name      -> cast_to_list(Name)
3865		end,
3866    print(major, "=started       ~s", [lists:flatten(timestamp_get(""))]),
3867    {{Col0,Col1},Style} = get_font_style((RunInit==run_init), Mode),
3868    TR = xhtml("<tr valign=\"top\">", "<tr class=\"" ++ odd_or_even() ++ "\">"),
3869    EncMinorBase = uri_encode(MinorBase),
3870    print(html,	TR ++ "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>"
3871	  "<td>" ++ Col0 ++ "~w" ++ Col1 ++ "</td>"
3872	  "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>"
3873	  "<td><a href=\"~ts\">~tw</a></td>"
3874	  "<td><a href=\"~ts#top\">&lt;</a> <a href=\"~ts#end\">&gt;</a></td>",
3875	  [num2str(Num),fw_name(Mod),GrNameStr,EncMinorBase,Func,
3876	   EncMinorBase,EncMinorBase]),
3877
3878    do_unless_parallel(Main, fun erlang:yield/0),
3879
3880    %% run the test case
3881    {Result,DetectedFail,ProcsBefore,ProcsAfter} =
3882	run_test_case_apply(Num, Mod, Func, [UpdatedArgs], GrName,
3883			    RunInit, TimetrapData),
3884    {Time,RetVal,Loc,Opts,Comment} =
3885	case Result of
3886	    Normal={_Time,_RetVal,_Loc,_Opts,_Comment} -> Normal;
3887	    {died,DReason,DLoc,DCmt} -> {died,DReason,DLoc,[],DCmt}
3888	end,
3889
3890    print(minor, "<a name=\"end\"></a>", [], internal_raw),
3891    print(minor, "\n", [], internal_raw),
3892    print_timestamp(minor, "Ended at "),
3893    print(major, "=ended         ~s", [timestamp_get("")]),
3894
3895    do_unless_parallel(Main, fun() -> file:set_cwd(filename:dirname(TSDir)) end),
3896
3897    %% call the appropriate progress function clause to print the results to log
3898    Status =
3899	case {Time,RetVal} of
3900	    {died,{timetrap_timeout,TimetrapTimeout}} ->
3901		progress(failed, Num, Mod, Func, GrName, Loc,
3902			 timetrap_timeout, TimetrapTimeout, Comment, Style);
3903	    {died,Reason={auto_skip,_Why}} ->
3904                %% died in init_per_testcase or in a hook in this context
3905		progress(skip, Num, Mod, Func, GrName, Loc, Reason,
3906			 Time, Comment, Style);
3907	    {died,{Skip,Reason}} when Skip==skip; Skip==skipped ->
3908                %% died in init_per_testcase
3909		progress(skip, Num, Mod, Func, GrName, Loc, Reason,
3910			 Time, Comment, Style);
3911	    {died,Reason} when Reason=/=ok ->
3912                %% (If Reason==ok it means that process died in
3913                %% end_per_testcase after successfully completing the
3914                %% test case itself - then we shall not fail, but a
3915                %% warning will be issued in the comment field.)
3916		progress(failed, Num, Mod, Func, GrName, Loc, Reason,
3917			 Time, Comment, Style);
3918	    {_,{'EXIT',{Skip,Reason}}} when Skip==skip; Skip==skipped;
3919					    Skip==auto_skip ->
3920		progress(skip, Num, Mod, Func, GrName, Loc, Reason,
3921			 Time, Comment, Style);
3922	    {_,{'EXIT',_Pid,{Skip,Reason}}} when Skip==skip; Skip==skipped ->
3923		progress(skip, Num, Mod, Func, GrName, Loc, Reason,
3924			 Time, Comment, Style);
3925	    {_,{'EXIT',_Pid,Reason}} ->
3926		progress(failed, Num, Mod, Func, GrName, Loc, Reason,
3927			 Time, Comment, Style);
3928	    {_,{'EXIT',Reason}} ->
3929		progress(failed, Num, Mod, Func, GrName, Loc, Reason,
3930			 Time, Comment, Style);
3931	    {_,{Fail,Reason}} when Fail =:= fail; Fail =:= failed ->
3932		progress(failed, Num, Mod, Func, GrName, Loc, Reason,
3933			 Time, Comment, Style);
3934	    {_,Reason={auto_skip,_Why}} ->
3935		progress(skip, Num, Mod, Func, GrName, Loc, Reason,
3936			 Time, Comment, Style);
3937	    {_,{Skip,Reason}} when Skip==skip; Skip==skipped ->
3938		progress(skip, Num, Mod, Func, GrName, Loc, Reason,
3939			 Time, Comment, Style);
3940	    {Time,RetVal} ->
3941		case DetectedFail of
3942		    [] ->
3943			progress(ok, Num, Mod, Func, GrName, Loc, RetVal,
3944				 Time, Comment, Style);
3945
3946		    Reason ->
3947			progress(failed, Num, Mod, Func, GrName, Loc, Reason,
3948				 Time, Comment, Style)
3949		end
3950	end,
3951    %% if the test case was executed sequentially, this updates the
3952    %% status count on the main process (status of parallel test cases
3953    %% is updated later by the handle_test_case_io_and_status/0 function)
3954    case {RunInit,Status} of
3955	{skip_init,_} ->			% conf doesn't count
3956	    ok;
3957	{_,ok} ->
3958	    put(test_server_ok, get(test_server_ok)+1);
3959	{_,failed} ->
3960	    put(test_server_failed, get(test_server_failed)+1);
3961	{_,skip} ->
3962	    {US,AS} = get(test_server_skipped),
3963	    put(test_server_skipped, {US+1,AS});
3964	{_,auto_skip} ->
3965	    {US,AS} = get(test_server_skipped),
3966	    put(test_server_skipped, {US,AS+1})
3967    end,
3968    %% only if test case execution is sequential do we care about the
3969    %% remaining processes and slave nodes count
3970    case self() of
3971	Main ->
3972	    case test_server_sup:framework_call(warn, [processes], true) of
3973		true ->
3974		    if ProcsBefore < ProcsAfter ->
3975			    print(minor,
3976				  "WARNING: ~w more processes in system after test case",
3977				  [ProcsAfter-ProcsBefore]);
3978		       ProcsBefore > ProcsAfter ->
3979			    print(minor,
3980				  "WARNING: ~w less processes in system after test case",
3981				  [ProcsBefore-ProcsAfter]);
3982		       true -> ok
3983		    end;
3984		false ->
3985		    ok
3986	    end,
3987	    case test_server_sup:framework_call(warn, [nodes], true) of
3988		true ->
3989		    case catch controller_call(kill_slavenodes) of
3990			{'EXIT',_} = Exit ->
3991			    print(minor,
3992				  "WARNING: There might be slavenodes left in the"
3993				  " system. I tried to kill them, but I failed: ~tp\n",
3994				  [Exit]);
3995			[] -> ok;
3996			List ->
3997			    print(minor, "WARNING: ~w slave nodes in system after test"++
3998				  "case. Tried to killed them.~n"++
3999				  "         Names:~tp",
4000				  [length(List),List])
4001		    end;
4002		false ->
4003		    ok
4004	    end;
4005	_ ->
4006	    ok
4007    end,
4008    %% if the test case was executed sequentially, this updates the execution
4009    %% time count on the main process (adding execution time of parallel test
4010    %% case groups is done in run_test_cases_loop/4)
4011    if is_number(Time) ->
4012	    put(test_server_total_time, get(test_server_total_time)+Time);
4013       true ->
4014	    ok
4015    end,
4016    test_server_sup:check_new_crash_dumps(),
4017
4018    %% if io is being buffered, send finished message
4019    %% (no matter if case runs on parallel or main process)
4020    case is_io_buffered() of
4021	false ->
4022	    ok;
4023	true ->
4024	    test_server_io:end_transaction(),
4025	    Main ! {finished,Ref,self(),Num,Mod,Func,
4026		    ?mod_result(Status),{Time,RetVal,Opts}},
4027		    ok
4028    end,
4029    {Time,RetVal,Opts}.
4030
4031
4032%%--------------------------------------------------------------------
4033%% various help functions
4034
4035%% Call Action if we are running on the main process (not parallel).
4036do_unless_parallel(Main, Action) when is_function(Action, 0) ->
4037    case self() of
4038	Main -> Action();
4039	_ -> ok
4040    end.
4041
4042num2str(0) -> "";
4043num2str(N) -> integer_to_list(N).
4044
4045%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4046%% progress(Result, CaseNum, Mod, Func, Location, Reason, Time,
4047%%	    Comment, TimeFormat) -> Result
4048%%
4049%% Prints the result of the test case to log file.
4050%% Note: Strings that are to be written to the minor log must
4051%% be prefixed with "=== " here, or the indentation will be wrong.
4052
4053progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time,
4054	 Comment, {St0,St1}) ->
4055    {Reason1,{Color,Ret,ReportTag}} =
4056	if_auto_skip(Reason,
4057		     fun() -> {?auto_skip_color,auto_skip,auto_skipped} end,
4058		     fun() -> {?user_skip_color,skip,skipped} end),
4059    print(major, "=result        ~w: ~tp", [ReportTag,Reason1]),
4060    print(1, "*** SKIPPED ~ts ***",
4061	  [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
4062    test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},
4063						     {ReportTag,Reason1}}]),
4064    TimeStr = io_lib:format(if is_float(Time) -> "~.3fs";
4065			       true -> "~w"
4066			    end, [Time]),
4067    ReasonStr = escape_chars(reason_to_string(Reason1)),
4068    ReasonStr1 = lists:flatten([string:trim(S,leading,"\s") ||
4069				S <- string:lexemes(ReasonStr,[$\n])]),
4070    ReasonLength = string:length(ReasonStr1),
4071    ReasonStr2 =
4072	if ReasonLength > 80 ->
4073		string:slice(ReasonStr1, 0, 77) ++ "...";
4074	   true ->
4075		ReasonStr1
4076	end,
4077    Comment1 = case Comment of
4078		   "" -> "";
4079		   _ -> xhtml("<br>(","<br />(") ++ to_string(Comment) ++ ")"
4080	       end,
4081    print(html,
4082	  "<td>" ++ St0 ++ "~ts" ++ St1 ++ "</td>"
4083	  "<td><font color=\"~ts\">SKIPPED</font></td>"
4084	  "<td>~ts~ts</td></tr>\n",
4085	  [TimeStr,Color,ReasonStr2,Comment1]),
4086    FormatLoc = test_server_sup:format_loc(Loc),
4087    print(minor, "=== Location: ~ts", [FormatLoc]),
4088    print(minor, "=== Reason: ~ts", [ReasonStr1]),
4089    Ret;
4090
4091progress(failed, CaseNum, Mod, Func, GrName, Loc, timetrap_timeout, T,
4092	 Comment0, {St0,St1}) ->
4093    print(major, "=result        failed: timeout, ~tp", [Loc]),
4094    print(1, "*** FAILED ~ts ***",
4095	  [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
4096    test_server_sup:framework_call(report,
4097				   [tc_done,{Mod,{Func,GrName},
4098					     {failed,timetrap_timeout}}]),
4099    FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)),
4100    ErrorReason = io_lib:format("{timetrap_timeout,~ts}", [FormatLastLoc]),
4101    Comment =
4102	case Comment0 of
4103	    "" -> "<font color=\"red\">" ++ ErrorReason ++ "</font>";
4104	    _ -> "<font color=\"red\">" ++ ErrorReason ++
4105		 xhtml("</font><br>","</font><br />") ++ to_string(Comment0)
4106	end,
4107    print(html,
4108	  "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>"
4109	  "<td><font color=\"red\">FAILED</font></td>"
4110	  "<td>~ts</td></tr>\n",
4111	  [T/1000,Comment]),
4112    FormatLoc = test_server_sup:format_loc(Loc),
4113    print(minor, "=== Location: ~ts", [FormatLoc]),
4114    print(minor, "=== Reason: timetrap timeout", []),
4115    failed;
4116
4117progress(failed, CaseNum, Mod, Func, GrName, Loc, {testcase_aborted,Reason}, _T,
4118	 Comment0, {St0,St1}) ->
4119    print(major, "=result        failed: testcase_aborted, ~tp", [Loc]),
4120    print(1, "*** FAILED ~ts ***",
4121	  [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
4122    test_server_sup:framework_call(report,
4123				   [tc_done,{Mod,{Func,GrName},
4124					     {failed,testcase_aborted}}]),
4125    FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)),
4126    ErrorReason = io_lib:format("{testcase_aborted,~ts}", [FormatLastLoc]),
4127    Comment =
4128	case Comment0 of
4129	    "" -> "<font color=\"red\">" ++ ErrorReason ++ "</font>";
4130	    _ -> "<font color=\"red\">" ++ ErrorReason ++
4131		 xhtml("</font><br>","</font><br />") ++ to_string(Comment0)
4132	end,
4133    print(html,
4134	  "<td>" ++ St0 ++ "died" ++ St1 ++ "</td>"
4135	  "<td><font color=\"red\">FAILED</font></td>"
4136	  "<td>~ts</td></tr>\n",
4137	  [Comment]),
4138    FormatLoc = test_server_sup:format_loc(Loc),
4139    print(minor, "=== Location: ~ts", [FormatLoc]),
4140    print(minor,
4141          "~ts",
4142	  [escape_chars(io_lib:format("=== Reason: {testcase_aborted,~tp}",
4143				     [Reason]))]),
4144    failed;
4145
4146progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time,
4147	 Comment0, {St0,St1}) ->
4148    print(major, "=result        failed: ~tp, ~w", [Reason,unknown_location]),
4149    print(1, "*** FAILED ~ts ***",
4150	  [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
4151    test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},
4152						     {failed,Reason}}]),
4153    TimeStr = io_lib:format(if is_float(Time) -> "~.3fs";
4154			       true -> "~w"
4155			    end, [Time]),
4156    ErrorReason = escape_chars(lists:flatten(io_lib:format("~tp", [Reason]))),
4157    ErrorReason1 = lists:flatten([string:trim(S,leading,"\s") ||
4158				  S <- string:lexemes(ErrorReason,[$\n])]),
4159    ErrorReasonLength = string:length(ErrorReason1),
4160    ErrorReason2 =
4161	if ErrorReasonLength > 63 ->
4162		string:slice(ErrorReason1, 0, 60) ++ "...";
4163	   true ->
4164		ErrorReason1
4165	end,
4166    Comment =
4167	case Comment0 of
4168	    "" -> "<font color=\"red\">" ++ ErrorReason2 ++ "</font>";
4169	    _ -> "<font color=\"red\">" ++ ErrorReason2 ++
4170		 xhtml("</font><br>","</font><br />") ++
4171		 to_string(Comment0)
4172	end,
4173    print(html,
4174	  "<td>" ++ St0 ++ "~ts" ++ St1 ++ "</td>"
4175	  "<td><font color=\"red\">FAILED</font></td>"
4176	  "<td>~ts</td></tr>\n",
4177	  [TimeStr,Comment]),
4178    print(minor, "=== Location: ~w", [unknown]),
4179    {FStr,FormattedReason} = format_exception(Reason),
4180    print(minor,
4181          "~ts",
4182	  [escape_chars(io_lib:format("=== Reason: " ++ FStr, [FormattedReason]))]),
4183    failed;
4184
4185progress(failed, CaseNum, Mod, Func, GrName, Loc, Reason, Time,
4186	 Comment0, {St0,St1}) ->
4187    {LocMaj,LocMin} = if Func == error_in_suite ->
4188			      case get_fw_mod(undefined) of
4189				  Mod -> {unknown_location,unknown};
4190				  _   -> {Loc,Loc}
4191			      end;
4192			 true -> {Loc,Loc}
4193		       end,
4194    print(major, "=result        failed: ~tp, ~tp", [Reason,LocMaj]),
4195    print(1, "*** FAILED ~ts ***",
4196	  [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
4197    test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},
4198						     {failed,Reason}}]),
4199    TimeStr = io_lib:format(if is_float(Time) -> "~.3fs";
4200			       true -> "~w"
4201			    end, [Time]),
4202    Comment =
4203	case Comment0 of
4204	    "" -> "";
4205	    _ -> xhtml("<br>","<br />") ++ to_string(Comment0)
4206	end,
4207    FormatLastLoc = test_server_sup:format_loc(get_last_loc(LocMaj)),
4208    print(html,
4209	  "<td>" ++ St0 ++ "~ts" ++ St1 ++ "</td>"
4210	  "<td><font color=\"red\">FAILED</font></td>"
4211	  "<td><font color=\"red\">~ts</font>~ts</td></tr>\n",
4212	  [TimeStr,FormatLastLoc,Comment]),
4213    FormatLoc = test_server_sup:format_loc(LocMin),
4214    print(minor, "=== Location: ~ts", [FormatLoc]),
4215    {FStr,FormattedReason} = format_exception(Reason),
4216    print(minor, "~ts",
4217          ["=== Reason: " ++
4218           escape_chars(io_lib:format(FStr, [FormattedReason]))]),
4219    failed;
4220
4221progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time,
4222	 Comment0, {St0,St1}) ->
4223    print(minor, "successfully completed test case", []),
4224    test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},ok}]),
4225    TimeStr = io_lib:format(if is_float(Time) -> "~.3fs";
4226			       true -> "~w"
4227			    end, [Time]),
4228    Comment =
4229	case RetVal of
4230	    {comment,RetComment} ->
4231		String = to_string(RetComment),
4232		HtmlCmt = test_server_sup:framework_call(format_comment,
4233							 [String],
4234							 String),
4235		print(major, "=result        ok: ~ts", [String]),
4236		"<td>" ++ HtmlCmt ++ "</td>";
4237	    _ ->
4238		print(major, "=result        ok", []),
4239		case Comment0 of
4240		    "" -> "<td></td>";
4241		    _ -> "<td>" ++ to_string(Comment0) ++ "</td>"
4242		end
4243	end,
4244    print(major, "=elapsed       ~p", [Time]),
4245    print(html,
4246	  "<td>" ++ St0 ++ "~ts" ++ St1 ++ "</td>"
4247	  "<td><font color=\"green\">Ok</font></td>"
4248	  "~ts</tr>\n",
4249	  [TimeStr,Comment]),
4250    print(minor,
4251          "~ts",
4252	  [escape_chars(io_lib:format("=== Returned value: ~tp", [RetVal]))]),
4253    ok.
4254
4255%%--------------------------------------------------------------------
4256%% various help functions
4257escape_chars(Term) when not is_list(Term), not is_binary(Term) ->
4258    esc_chars_in_list(io_lib:format("~tp", [Term]));
4259escape_chars(List = [Term | _]) when not is_list(Term), not is_integer(Term) ->
4260    esc_chars_in_list(io_lib:format("~tp", [List]));
4261escape_chars(List) ->
4262    esc_chars_in_list(List).
4263
4264esc_chars_in_list([Bin | Io]) when is_binary(Bin) ->
4265    [Bin | esc_chars_in_list(Io)];
4266esc_chars_in_list([List | Io]) when is_list(List) ->
4267    [esc_chars_in_list(List) | esc_chars_in_list(Io)];
4268esc_chars_in_list([$< | Io]) ->
4269    ["&lt;" | esc_chars_in_list(Io)];
4270esc_chars_in_list([$> | Io]) ->
4271    ["&gt;" | esc_chars_in_list(Io)];
4272esc_chars_in_list([$& | Io]) ->
4273    ["&amp;" | esc_chars_in_list(Io)];
4274esc_chars_in_list([Char | Io]) when is_integer(Char) ->
4275    [Char | esc_chars_in_list(Io)];
4276esc_chars_in_list([]) ->
4277    [];
4278esc_chars_in_list(Bin) ->
4279    Bin.
4280
4281get_fw_mod(Mod) ->
4282    case get(test_server_framework) of
4283	undefined ->
4284	    case os:getenv("TEST_SERVER_FRAMEWORK") of
4285		FW when FW =:= false; FW =:= "undefined" ->
4286		    Mod;
4287		FW ->
4288		    list_to_atom(FW)
4289	    end;
4290	'$none' -> Mod;
4291	FW      -> FW
4292    end.
4293
4294fw_name(?MODULE) ->
4295    test_server;
4296fw_name(Mod) ->
4297    case get(test_server_framework_name) of
4298	undefined ->
4299	    case get_fw_mod(undefined) of
4300		undefined ->
4301		    Mod;
4302		Mod ->
4303		    case os:getenv("TEST_SERVER_FRAMEWORK_NAME") of
4304			FWName when FWName =:= false; FWName =:= "undefined" ->
4305			    Mod;
4306			FWName ->
4307			    list_to_atom(FWName)
4308		    end;
4309		_ ->
4310		    Mod
4311	    end;
4312	'$none' ->
4313	    Mod;
4314	FWName ->
4315	    case get_fw_mod(Mod) of
4316		Mod -> FWName;
4317		_ -> Mod
4318	    end
4319    end.
4320
4321if_auto_skip(Reason={failed,{_,init_per_testcase,_}}, True, _False) ->
4322    {Reason,True()};
4323if_auto_skip({skip,Reason={failed,{_,init_per_testcase,_}}}, True, _False) ->
4324    {Reason,True()};
4325if_auto_skip({auto_skip,Reason}, True, _False) ->
4326    {Reason,True()};
4327if_auto_skip(Reason, _True, False) ->
4328    {Reason,False()}.
4329
4330update_skip_counters({_T,Pat,_Opts}, {US,AS}) ->
4331    {_,Result} = if_auto_skip(Pat, fun() -> {US,AS+1} end, fun() -> {US+1,AS} end),
4332    Result;
4333update_skip_counters(Pat, {US,AS}) ->
4334    {_,Result} = if_auto_skip(Pat, fun() -> {US,AS+1} end, fun() -> {US+1,AS} end),
4335    Result.
4336
4337get_info_str(Mod,Func, 0, _Cases) ->
4338    io_lib:format("~tw", [{Mod,Func}]);
4339get_info_str(_Mod,_Func, CaseNum, unknown) ->
4340    "test case " ++ integer_to_list(CaseNum);
4341get_info_str(_Mod,_Func, CaseNum, Cases) ->
4342    "test case " ++ integer_to_list(CaseNum) ++
4343	" of " ++ integer_to_list(Cases).
4344
4345print_if_known(Known, {SK,AK}, {SU,AU}) ->
4346    {S,A} = if Known == unknown -> {SU,AU};
4347	       true -> {SK,AK}
4348	    end,
4349    io_lib:format(S, A).
4350
4351to_string(Term) when is_list(Term) ->
4352    case (catch io_lib:format("~ts", [Term])) of
4353	{'EXIT',_} -> lists:flatten(io_lib:format("~tp", [Term]));
4354	String     -> lists:flatten(String)
4355    end;
4356to_string(Term) ->
4357    lists:flatten(io_lib:format("~tp", [Term])).
4358
4359get_last_loc(Loc) when is_tuple(Loc) ->
4360    Loc;
4361get_last_loc([Loc|_]) when is_tuple(Loc) ->
4362    [Loc];
4363get_last_loc(Loc) ->
4364    Loc.
4365
4366reason_to_string({failed,{_,FailFunc,bad_return}}) ->
4367    atom_to_list(FailFunc) ++ " bad return value";
4368reason_to_string({failed,{_,FailFunc,{timetrap_timeout,_}}}) ->
4369    atom_to_list(FailFunc) ++ " timed out";
4370reason_to_string(FWInitFail = {failed,{_CB,init_tc,_Reason}}) ->
4371    to_string(FWInitFail);
4372reason_to_string({failed,{_,FailFunc,_}}) ->
4373    atom_to_list(FailFunc) ++ " failed";
4374reason_to_string(Other) ->
4375    to_string(Other).
4376
4377%get_font_style(Prop) ->
4378%    {Col,St0,St1} = get_font_style1(Prop),
4379%    {{"<font color="++Col++">","</font>"},
4380%     {"<font color="++Col++">"++St0,St1++"</font>"}}.
4381
4382get_font_style(NormalCase, Mode) ->
4383    Prop = if not NormalCase ->
4384		   default;
4385	      true ->
4386		   case check_prop(parallel, Mode) of
4387		       false ->
4388			   case check_prop(sequence, Mode) of
4389			       false ->
4390				   default;
4391			       _ ->
4392				   sequence
4393			   end;
4394		       _ ->
4395			   parallel
4396		   end
4397	   end,
4398    {Col,St0,St1} = get_font_style1(Prop),
4399    {{"<font color="++Col++">","</font>"},
4400     {"<font color="++Col++">"++St0,St1++"</font>"}}.
4401
4402get_font_style1(parallel) ->
4403    {"\"darkslategray\"","<i>","</i>"};
4404get_font_style1(sequence) ->
4405%    {"\"darkolivegreen\"","",""};
4406    {"\"saddlebrown\"","",""};
4407get_font_style1(default) ->
4408    {"\"black\"","",""}.
4409%%get_font_style1(skipped) ->
4410%%    {"\"lightgray\"","",""}.
4411
4412
4413%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4414%% format_exception({Error,Stack}) -> {CtrlSeq,Term}
4415%%
4416%% The default behaviour is that error information gets formatted
4417%% (like in the erlang shell) before printed to the minor log file.
4418%% The framework application can switch this feature off by setting
4419%% *its* application environment variable 'format_exception' to false.
4420%% It is also possible to switch formatting off by starting the
4421%% test_server node with init argument 'test_server_format_exception'
4422%% set to false.
4423
4424format_exception(Reason={_Error,Stack}) when is_list(Stack) ->
4425    case get_fw_mod(undefined) of
4426	undefined ->
4427	    case application:get_env(test_server, format_exception) of
4428		{ok,false} ->
4429		    {"~tp",Reason};
4430		_ ->
4431		    do_format_exception(Reason)
4432	    end;
4433	FW ->
4434	    case application:get_env(FW, format_exception) of
4435		{ok,false} ->
4436		    {"~tp",Reason};
4437		_ ->
4438		    do_format_exception(Reason)
4439	    end
4440    end;
4441format_exception(Error) ->
4442    format_exception({Error,[]}).
4443
4444do_format_exception(Reason={Error,Stack}) ->
4445    StackFun = fun(_, _, _) -> false end,
4446    PF = fun(Term, I) ->
4447		 io_lib:format("~." ++ integer_to_list(I) ++ "tp", [Term])
4448	 end,
4449    case catch erl_error:format_exception(1, error, Error, Stack, StackFun, PF, utf8) of
4450	{'EXIT',_R} ->
4451	    {"~tp",Reason};
4452	Formatted  ->
4453	    Formatted1 = re:replace(Formatted, "exception error: ", "", [{return,list},unicode]),
4454	    {"~ts",lists:flatten(Formatted1)}
4455    end.
4456
4457
4458%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4459%% run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit,
4460%%                     TimetrapData) ->
4461%%  {{Time,RetVal,Loc,Opts,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} |
4462%%  {{died,Reason,unknown,Comment},DetectedFail,ProcessesBefore,ProcessesAfter}
4463%% Name = atom()
4464%% Time = float()   (seconds)
4465%% RetVal = term()
4466%% Loc = term()
4467%% Comment = string()
4468%% Reason = term()
4469%% DetectedFail = [{File,Line}]
4470%% ProcessesBefore = ProcessesAfter = integer()
4471%%
4472
4473run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit,
4474		    TimetrapData) ->
4475    test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,
4476				     TimetrapData}).
4477
4478%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4479%% print(Detail, Format, Args) -> ok
4480%% Detail = integer()
4481%% Format = string()
4482%% Args = [term()]
4483%%
4484%% Just like io:format, except that depending on the Detail value, the output
4485%% is directed to console, major and/or minor log files.
4486
4487print(Detail, Format) ->
4488    print(Detail, Format, []).
4489
4490print(Detail, Format, Args) ->
4491    print(Detail, Format, Args, internal).
4492
4493print(Detail, ["$tc_html",Format], Args, Printer) ->
4494    Msg = io_lib:format(Format, Args),
4495    print_or_buffer(Detail, ["$tc_html",Msg], Printer);
4496
4497print(Detail, Format, Args, Printer) ->
4498    Msg = io_lib:format(Format, Args),
4499    print_or_buffer(Detail, Msg, Printer).
4500
4501print_or_buffer(Detail, Msg, Printer) ->
4502    test_server_gl:print(group_leader(), Detail, Msg, Printer).
4503
4504%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4505%% print_timestamp(Detail, Leader) -> ok
4506%%
4507%% Prints Leader followed by a time stamp (date and time). Depending on
4508%% the Detail value, the output is directed to console, major and/or minor
4509%% log files.
4510
4511print_timestamp(Detail, Leader) ->
4512    print(Detail, timestamp_get(Leader), []).
4513
4514%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4515%% print_who(Host, User) -> ok
4516%%
4517%% Logs who runs the suite.
4518
4519print_who(Host, User) ->
4520    UserStr = case User of
4521		  "" -> "";
4522		  _ -> " by " ++ User
4523	      end,
4524    print(html, "Run~ts on ~ts", [UserStr,Host]).
4525
4526%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4527%% format(Format) -> IoLibReturn
4528%% format(Detail, Format) -> IoLibReturn
4529%% format(Format, Args) -> IoLibReturn
4530%% format(Detail, Format, Args) -> IoLibReturn
4531%%
4532%% Detail = integer()
4533%% Format = string()
4534%% Args = [term(),...]
4535%% IoLibReturn = term()
4536%%
4537%% Logs the Format string and Args, similar to io:format/1/2 etc. If
4538%% Detail is not specified, the default detail level (which is 50) is used.
4539%% Which log files the string will be logged in depends on the thresholds
4540%% set with set_levels/3. Typically with default detail level, only the
4541%% minor log file is used.
4542
4543format(Format) ->
4544    format(minor, Format, []).
4545
4546format(major, Format) ->
4547    format(major, Format, []);
4548format(minor, Format) ->
4549    format(minor, Format, []);
4550format(Detail, Format) when is_integer(Detail) ->
4551    format(Detail, Format, []);
4552format(Format, Args) ->
4553    format(minor, Format, Args).
4554
4555format(Detail, Format, Args) ->
4556    Str =
4557	case catch io_lib:format(Format, Args) of
4558	    {'EXIT',_} ->
4559		io_lib:format("illegal format; ~tp with args ~tp.\n",
4560			      [Format,Args]);
4561	    Valid -> Valid
4562	end,
4563    print_or_buffer(Detail, Str, self()).
4564
4565%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4566%% xhtml(BasicHtml, XHtml) -> BasicHtml | XHtml
4567%%
4568xhtml(HTML, XHTML) ->
4569    case get(basic_html) of
4570	true -> HTML;
4571	_ -> XHTML
4572    end.
4573
4574%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4575%% odd_or_even() -> "odd" | "even"
4576%%
4577odd_or_even() ->
4578    case get(odd_or_even) of
4579	even ->
4580	    put(odd_or_even, odd),
4581	    "even";
4582	_ ->
4583	    put(odd_or_even, even),
4584	    "odd"
4585    end.
4586
4587%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4588%% timestamp_filename_get(Leader) -> string()
4589%% Leader = string()
4590%%
4591%% Returns a string consisting of Leader concatenated with the current
4592%% date and time. The resulting string is suitable as a filename.
4593timestamp_filename_get(Leader) ->
4594    timestamp_get_internal(Leader,
4595			   "~ts~w-~2.2.0w-~2.2.0w_~2.2.0w.~2.2.0w.~2.2.0w").
4596
4597%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4598%% timestamp_get(Leader) -> string()
4599%% Leader = string()
4600%%
4601%% Returns a string consisting of Leader concatenated with the current
4602%% date and time. The resulting string is suitable for display.
4603timestamp_get(Leader) ->
4604    timestamp_get_internal(Leader,
4605			   "~ts~w-~2.2.0w-~2.2.0w ~2.2.0w:~2.2.0w:~2.2.0w").
4606
4607timestamp_get_internal(Leader, Format) ->
4608    {YY,MM,DD,H,M,S} = time_get(),
4609    lists:flatten(io_lib:format(Format, [Leader,YY,MM,DD,H,M,S])).
4610
4611%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4612%% time_get() -> {YY,MM,DD,H,M,S}
4613%% YY = integer()
4614%% MM = integer()
4615%% DD = integer()
4616%% H = integer()
4617%% M = integer()
4618%% S = integer()
4619%%
4620%% Returns the current Year,Month,Day,Hours,Minutes,Seconds.
4621%% The function checks that the date doesn't wrap while calling
4622%% getting the time.
4623time_get() ->
4624    {YY,MM,DD} = date(),
4625    {H,M,S} = time(),
4626    case date() of
4627	{YY,MM,DD} ->
4628	    {YY,MM,DD,H,M,S};
4629	_NewDay ->
4630	    %% date changed between call to date() and time(), try again
4631	    time_get()
4632    end.
4633
4634
4635%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4636%% make_config(Config) -> NewConfig
4637%% Config = [{Key,Value},...]
4638%% NewConfig = [{Key,Value},...]
4639%%
4640%% Creates a configuration list (currently returns it's input)
4641
4642make_config(Initial) ->
4643    Initial.
4644
4645%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4646%% update_config(Config, Update) -> NewConfig
4647%% Config = [{Key,Value},...]
4648%% Update = [{Key,Value},...] | {Key,Value}
4649%% NewConfig = [{Key,Value},...]
4650%%
4651%% Adds or replaces the key-value pairs in config with those in update.
4652%% Returns the updated list.
4653
4654update_config(Config, {Key,Val}) ->
4655    case lists:keymember(Key, 1, Config) of
4656	true ->
4657	    lists:keyreplace(Key, 1, Config, {Key,Val});
4658	false ->
4659	    [{Key,Val}|Config]
4660    end;
4661update_config(Config, [Assoc|Assocs]) ->
4662    NewConfig = update_config(Config, Assoc),
4663    update_config(NewConfig, Assocs);
4664update_config(Config, []) ->
4665    Config.
4666
4667
4668%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4669%% collect_cases(CurMod, TopCase, SkipList) ->
4670%%     BasicCaseList | {error,Reason}
4671%%
4672%% CurMod = atom()
4673%% TopCase = term()
4674%% SkipList = [term(),...]
4675%% BasicCaseList = [term(),...]
4676%%
4677%% Parses the given test goal(s) in TopCase, and transforms them to a
4678%% simple list of test cases to call, when executing the test suite.
4679%%
4680%% CurMod is the "current" module, that is, the module the last instruction
4681%% was read from. May be be set to 'none' initially.
4682%%
4683%% SkipList is the list of test cases to skip and requirements to deny.
4684%%
4685%% The BasicCaseList is built out of TopCase, which may be any of the
4686%% following terms:
4687%%
4688%% []                        Nothing is added
4689%% List list()               The list is decomposed, and each element is
4690%%                           treated according to this table
4691%% Case atom()               CurMod:Case(suite) is called
4692%% {module,Case}             CurMod:Case(suite) is called
4693%% {Module,Case}             Module:Case(suite) is called
4694%% {module,Module,Case}      Module:Case(suite) is called
4695%% {module,Module,Case,Args} Module:Case is called with Args as arguments
4696%% {dir,Dir}                 All modules *_SUITE in the named directory
4697%%                           are listed, and each Module:all(suite) is called
4698%% {dir,Dir,Pattern}         All modules <Pattern>_SUITE in the named dir
4699%%                           are listed, and each Module:all(suite) is called
4700%% {conf,InitMF,Cases,FinMF}
4701%% {conf,Props,InitMF,Cases,FinMF}
4702%%                           InitMF is placed in the BasicCaseList, then
4703%%                           Cases is treated according to this table, then
4704%%                           FinMF is placed in the BasicCaseList. InitMF
4705%%                           and FinMF are configuration manipulation
4706%%                           functions. See below.
4707%% {make,InitMFA,Cases,FinMFA}
4708%%                           InitMFA is placed in the BasicCaseList, then
4709%%                           Cases is treated according to this table, then
4710%%                           FinMFA is placed in the BasicCaseList. InitMFA
4711%%                           and FinMFA are make/unmake functions. If InitMFA
4712%%                           fails, Cases are not run.
4713%%
4714%% When a function is called, above, it means that the function is invoked
4715%% and the return is expected to be:
4716%%
4717%% []                        Leaf case
4718%% {req,ReqList}             Kept for backwards compatibility - same as []
4719%% {req,ReqList,Cases}       Kept for backwards compatibility -
4720%%                           Cases parsed recursively with collect_cases/3
4721%% Cases (list)              Recursively parsed with collect_cases/3
4722%%
4723%% Leaf cases are added to the BasicCaseList as Module:Case(Config). Each
4724%% case is checked against the SkipList. If present, a skip instruction
4725%% is inserted instead, which only prints the case name and the reason
4726%% why the case was skipped in the log files.
4727%%
4728%% Configuration manipulation functions are called with the current
4729%% configuration list as only argument, and are expected to return a new
4730%% configuration list. Such a pair of function may, for example, start a
4731%% server and stop it after a serie of test cases.
4732%%
4733%% SkipCases is expected to be in the format:
4734%%
4735%% Other                     Recursively parsed with collect_cases/3
4736%% {Mod,Comment}             Skip Mod, with Comment
4737%% {Mod,Funcs,Comment}       Skip listed functions in Mod with Comment
4738%% {Mod,Func,Comment}        Skip named function in Mod with Comment
4739%%
4740-record(cc, {mod,				% current module
4741	     skip}).				% skip list
4742
4743collect_all_cases(Top, Skip) when is_list(Skip) ->
4744    Result =
4745	case collect_cases(Top, #cc{mod=[],skip=Skip}, []) of
4746	    {ok,Cases,_St} -> Cases;
4747	    Other          -> Other
4748	end,
4749    Result.
4750
4751
4752collect_cases([], St, _) -> {ok,[],St};
4753collect_cases([Case|Cs0], St0, Mode) ->
4754    case collect_cases(Case, St0, Mode) of
4755	{ok,FlatCases1,St1} ->
4756	    case collect_cases(Cs0, St1, Mode) of
4757		{ok,FlatCases2,St} ->
4758		    {ok,FlatCases1 ++ FlatCases2,St};
4759		{error,_Reason} = Error -> Error
4760	    end;
4761	{error,_Reason} = Error -> Error
4762    end;
4763
4764
4765collect_cases({module,Case}, St, Mode) when is_atom(Case), is_atom(St#cc.mod) ->
4766    collect_case({St#cc.mod,Case}, St, Mode);
4767collect_cases({module,Mod,Case}, St, Mode) ->
4768    collect_case({Mod,Case}, St, Mode);
4769collect_cases({module,Mod,Case,Args}, St, Mode) ->
4770    collect_case({Mod,Case,Args}, St, Mode);
4771
4772collect_cases({dir,SubDir}, St, Mode) ->
4773    collect_files(SubDir, "*_SUITE", St, Mode);
4774collect_cases({dir,SubDir,Pattern}, St, Mode) ->
4775    collect_files(SubDir, Pattern++"*", St, Mode);
4776
4777collect_cases({conf,InitF,CaseList,FinMF}, St, Mode) when is_atom(InitF) ->
4778    collect_cases({conf,[],{St#cc.mod,InitF},CaseList,FinMF}, St, Mode);
4779collect_cases({conf,InitMF,CaseList,FinF}, St, Mode) when is_atom(FinF) ->
4780    collect_cases({conf,[],InitMF,CaseList,{St#cc.mod,FinF}}, St, Mode);
4781collect_cases({conf,InitMF,CaseList,FinMF}, St0, Mode) ->
4782    collect_cases({conf,[],InitMF,CaseList,FinMF}, St0, Mode);
4783collect_cases({conf,Props,InitF,CaseList,FinMF}, St, Mode) when is_atom(InitF) ->
4784    case init_props(Props) of
4785	{error,_} ->
4786	    {ok,[],St};
4787	Props1 ->
4788	    collect_cases({conf,Props1,{St#cc.mod,InitF},CaseList,FinMF},
4789			  St, Mode)
4790    end;
4791collect_cases({conf,Props,InitMF,CaseList,FinF}, St, Mode) when is_atom(FinF) ->
4792    case init_props(Props) of
4793	{error,_} ->
4794	    {ok,[],St};
4795	Props1 ->
4796	    collect_cases({conf,Props1,InitMF,CaseList,{St#cc.mod,FinF}},
4797			  St, Mode)
4798    end;
4799collect_cases({conf,Props,InitMF,CaseList,FinMF} = Conf, St, Mode) ->
4800    case init_props(Props) of
4801	{error,_} ->
4802	    {ok,[],St};
4803	Props1 ->
4804	    Ref = make_ref(),
4805	    Skips = St#cc.skip,
4806	    Props2 = [{suite,St#cc.mod} | lists:delete(suite,Props1)],
4807	    Mode1 = [{Ref,Props2,undefined} | Mode],
4808	    case in_skip_list({St#cc.mod,Conf}, Skips) of
4809		{true,Comment} ->	    	           % conf init skipped
4810		    {ok,[{skip_case,{conf,Ref,InitMF,Comment},Mode1} |
4811			 [] ++ [{conf,Ref,[],FinMF}]],St};
4812		{true,Name,Comment} when is_atom(Name) ->  % all cases skipped
4813		    case collect_cases(CaseList, St, Mode1) of
4814			{ok,[],_St} = Empty ->
4815			    Empty;
4816			{ok,FlatCases,St1} ->
4817			    Cases2Skip = FlatCases ++ [{conf,Ref,
4818							keep_name(Props1),
4819							FinMF}],
4820			    Skipped = skip_cases_upto(Ref, Cases2Skip, Comment,
4821						      conf, Mode1, skip_case),
4822			    {ok,[{skip_case,{conf,Ref,InitMF,Comment},Mode1} |
4823				 Skipped],St1};
4824			{error,_Reason} = Error ->
4825			    Error
4826		    end;
4827		{true,ToSkip,_} when is_list(ToSkip) ->    % some cases skipped
4828		    case collect_cases(CaseList,
4829				       St#cc{skip=ToSkip++Skips}, Mode1) of
4830			{ok,[],_St} = Empty ->
4831			    Empty;
4832			{ok,FlatCases,St1} ->
4833			    {ok,[{conf,Ref,Props1,InitMF} |
4834				 FlatCases ++ [{conf,Ref,
4835						keep_name(Props1),
4836						FinMF}]],St1#cc{skip=Skips}};
4837			{error,_Reason} = Error ->
4838			    Error
4839		    end;
4840		false ->
4841		    case collect_cases(CaseList, St, Mode1) of
4842			{ok,[],_St} = Empty ->
4843			    Empty;
4844			{ok,FlatCases,St1} ->
4845			    {ok,[{conf,Ref,Props1,InitMF} |
4846				 FlatCases ++ [{conf,Ref,
4847						keep_name(Props1),
4848						FinMF}]],St1};
4849			{error,_Reason} = Error ->
4850			    Error
4851		    end
4852	    end
4853    end;
4854
4855collect_cases({make,InitMFA,CaseList,FinMFA}, St0, Mode) ->
4856    case collect_cases(CaseList, St0, Mode) of
4857	{ok,[],_St} = Empty -> Empty;
4858	{ok,FlatCases,St} ->
4859	    Ref = make_ref(),
4860	    {ok,[{make,Ref,InitMFA}|FlatCases ++
4861		 [{make,Ref,FinMFA}]],St};
4862	{error,_Reason} = Error -> Error
4863    end;
4864
4865collect_cases({repeat,{Module, Case}, Repeat}, St, Mode) ->
4866    case catch collect_case([Case], St#cc{mod=Module}, [], Mode) of
4867        {ok, [{Module,Case}], _} ->
4868            {ok, [{repeat,{Module, Case}, Repeat}], St};
4869        Other ->
4870            {error,Other}
4871    end;
4872
4873collect_cases({Module, Cases}, St, Mode) when is_list(Cases)  ->
4874    case (catch collect_case(Cases, St#cc{mod=Module}, [], Mode)) of
4875	Result = {ok,_,_} ->
4876 	    Result;
4877 	Other ->
4878	    {error,Other}
4879     end;
4880
4881collect_cases({_Mod,_Case}=Spec, St, Mode) ->
4882    collect_case(Spec, St, Mode);
4883
4884collect_cases({_Mod,_Case,_Args}=Spec, St, Mode) ->
4885    collect_case(Spec, St, Mode);
4886collect_cases(Case, St, Mode) when is_atom(Case), is_atom(St#cc.mod) ->
4887    collect_case({St#cc.mod,Case}, St, Mode);
4888collect_cases(Other, St, _Mode) ->
4889    {error,{bad_subtest_spec,St#cc.mod,Other}}.
4890
4891collect_case({Mod,{conf,_,_,_,_}=Conf}, St, Mode) ->
4892    collect_case_invoke(Mod, Conf, [], St, Mode);
4893
4894collect_case(MFA, St, Mode) ->
4895    case in_skip_list(MFA, St#cc.skip) of
4896	{true,Comment} when Comment /= make_failed ->
4897	    {ok,[{skip_case,{MFA,Comment},Mode}],St};
4898	_ ->
4899	    case MFA of
4900		{Mod,Case} -> collect_case_invoke(Mod, Case, MFA, St, Mode);
4901		{_Mod,_Case,_Args} -> {ok,[MFA],St}
4902	    end
4903    end.
4904
4905collect_case([], St, Acc, _Mode) ->
4906    {ok, Acc, St};
4907
4908collect_case([Case | Cases], St, Acc, Mode) ->
4909    {ok, FlatCases, NewSt}  = collect_case({St#cc.mod, Case}, St, Mode),
4910    collect_case(Cases, NewSt, Acc ++ FlatCases, Mode).
4911
4912collect_case_invoke(Mod, Case, MFA, St, Mode) ->
4913    case get_fw_mod(undefined) of
4914	undefined ->
4915	    case catch apply(Mod, Case, [suite]) of
4916		{'EXIT',_} ->
4917		    {ok,[MFA],St};
4918		Suite ->
4919		    collect_subcases(Mod, Case, MFA, St, Suite, Mode)
4920	    end;
4921	_ ->
4922	    Suite = test_server_sup:framework_call(get_suite,
4923						   [Mod,Case],
4924						   []),
4925	    collect_subcases(Mod, Case, MFA, St, Suite, Mode)
4926    end.
4927
4928collect_subcases(Mod, Case, MFA, St, Suite, Mode) ->
4929    case Suite of
4930	[] when Case == all -> {ok,[],St};
4931	[] when element(1, Case) == conf -> {ok,[],St};
4932	[] -> {ok,[MFA],St};
4933%%%! --- START Kept for backwards compatibility ---
4934%%%! Requirements are not used
4935	{req,ReqList} ->
4936	    collect_case_deny(Mod, Case, MFA, ReqList, [], St, Mode);
4937	{req,ReqList,SubCases} ->
4938	    collect_case_deny(Mod, Case, MFA, ReqList, SubCases, St, Mode);
4939%%%! --- END Kept for backwards compatibility ---
4940	{Skip,Reason} when Skip==skip; Skip==skipped ->
4941	    {ok,[{skip_case,{MFA,Reason},Mode}],St};
4942	{error,Reason} ->
4943	    throw(Reason);
4944	SubCases ->
4945	    collect_case_subcases(Mod, Case, SubCases, St, Mode)
4946    end.
4947
4948collect_case_subcases(Mod, Case, SubCases, St0, Mode) ->
4949    OldMod = St0#cc.mod,
4950    case collect_cases(SubCases, St0#cc{mod=Mod}, Mode) of
4951	{ok,FlatCases,St} ->
4952	    {ok,FlatCases,St#cc{mod=OldMod}};
4953	{error,Reason} ->
4954	    {error,{{Mod,Case},Reason}}
4955    end.
4956
4957collect_files(Dir, Pattern, St, Mode) ->
4958    {ok,Cwd} = file:get_cwd(),
4959    Dir1 = filename:join(Cwd, Dir),
4960    Wc = filename:join([Dir1,Pattern++"{.erl,"++code:objfile_extension()++"}"]),
4961    case catch filelib:wildcard(Wc) of
4962	{'EXIT', Reason} ->
4963	    io:format("Could not collect files: ~tp~n", [Reason]),
4964	    {error,{collect_fail,Dir,Pattern}};
4965	Files ->
4966	    %% convert to module names and remove duplicates
4967	    Mods = lists:foldl(fun(File, Acc) ->
4968				       Mod = fullname_to_mod(File),
4969				       case lists:member(Mod, Acc) of
4970					   true  -> Acc;
4971					   false -> [Mod | Acc]
4972				       end
4973			       end, [], Files),
4974	    Tests = [{Mod,all} || Mod <- lists:sort(Mods)],
4975	    collect_cases(Tests, St, Mode)
4976    end.
4977
4978fullname_to_mod(Path) when is_list(Path) ->
4979    %% If this is called with a binary, then we are probably in +fnu
4980    %% mode and have found a beam file with name encoded as latin1. We
4981    %% will let this crash since it cannot work to load such a module
4982    %% anyway. It should be removed or renamed!
4983    list_to_atom(filename:rootname(filename:basename(Path))).
4984
4985collect_case_deny(Mod, Case, MFA, ReqList, SubCases, St, Mode) ->
4986    case {check_deny(ReqList, St#cc.skip),SubCases} of
4987	{{denied,Comment},_SubCases} ->
4988	    {ok,[{skip_case,{MFA,Comment},Mode}],St};
4989	{granted,[]} ->
4990	    {ok,[MFA],St};
4991	{granted,SubCases} ->
4992	    collect_case_subcases(Mod, Case, SubCases, St, Mode)
4993    end.
4994
4995check_deny([Req|Reqs], DenyList) ->
4996    case check_deny_req(Req, DenyList) of
4997	{denied,_Comment}=Denied -> Denied;
4998	granted -> check_deny(Reqs, DenyList)
4999    end;
5000check_deny([], _DenyList) -> granted;
5001check_deny(Req, DenyList) -> check_deny([Req], DenyList).
5002
5003check_deny_req({Req,Val}, DenyList) ->
5004    %%io:format("ValCheck ~p=~p in ~p\n", [Req,Val,DenyList]),
5005    case lists:keysearch(Req, 1, DenyList) of
5006	{value,{_Req,DenyVal}} when Val >= DenyVal ->
5007	    {denied,io_lib:format("Requirement ~tp=~tp", [Req,Val])};
5008	_ ->
5009	    check_deny_req(Req, DenyList)
5010    end;
5011check_deny_req(Req, DenyList) ->
5012    case lists:member(Req, DenyList) of
5013	true -> {denied,io_lib:format("Requirement ~tp", [Req])};
5014	false -> granted
5015    end.
5016
5017in_skip_list({Mod,{conf,Props,InitMF,_CaseList,_FinMF}}, SkipList) ->
5018    case in_skip_list(InitMF, SkipList) of
5019	{true,_} = Yes ->
5020	    Yes;
5021	_ ->
5022	    case proplists:get_value(name, Props) of
5023		undefined ->
5024		    false;
5025		Name ->
5026		    ToSkip =
5027			lists:flatmap(
5028			  fun({M,{conf,SProps,_,SCaseList,_},Cmt}) when
5029				    M == Mod ->
5030				  case proplists:get_value(name, SProps) of
5031				      all ->
5032					  [{M,all,Cmt}];
5033				      Name ->
5034					  case SCaseList of
5035					      all ->
5036						  [{M,all,Cmt}];
5037					      _ ->
5038						  [{M,F,Cmt} || F <- SCaseList]
5039					  end;
5040				      _ ->
5041					  []
5042				  end;
5043			     (_) ->
5044				  []
5045			  end, SkipList),
5046		    case ToSkip of
5047			[] ->
5048			    false;
5049			_ ->
5050			    case lists:keysearch(all, 2, ToSkip) of
5051				{value,{_,_,Cmt}} -> {true,Name,Cmt};
5052				_                 -> {true,ToSkip,""}
5053			    end
5054		    end
5055	    end
5056    end;
5057
5058in_skip_list({Mod,Func,_Args}, SkipList) ->
5059    in_skip_list({Mod,Func}, SkipList);
5060in_skip_list({Mod,Func}, [{Mod,Funcs,Comment}|SkipList]) when is_list(Funcs) ->
5061    case lists:member(Func, Funcs) of
5062	true ->
5063	    {true,Comment};
5064	_ ->
5065	    in_skip_list({Mod,Func}, SkipList)
5066    end;
5067in_skip_list({Mod,Func}, [{Mod,Func,Comment}|_SkipList]) ->
5068    {true,Comment};
5069in_skip_list({Mod,_Func}, [{Mod,Comment}|_SkipList]) ->
5070    {true,Comment};
5071in_skip_list({Mod,Func}, [_|SkipList]) ->
5072    in_skip_list({Mod,Func}, SkipList);
5073in_skip_list(_, []) ->
5074    false.
5075
5076%% remove unnecessary properties
5077init_props(Props) ->
5078    case get_repeat(Props) of
5079	Repeat = {_RepType,N} when N < 2 ->
5080	    if N == 0 ->
5081		    {error,{invalid_property,Repeat}};
5082	       true ->
5083		    lists:delete(Repeat, Props)
5084	    end;
5085	_ ->
5086	    Props
5087    end.
5088
5089keep_name(Props) ->
5090    lists:filter(fun({name,_}) -> true;
5091		    ({suite,_}) -> true;
5092		    (_) -> false end, Props).
5093
5094%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5095%%                 Node handling functions                   %%
5096%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5097
5098%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5099%% get_target_info() -> #target_info
5100%%
5101%% Returns a record containing system information for target
5102
5103get_target_info() ->
5104    controller_call(get_target_info).
5105
5106%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5107%% start_node(SlaveName, Type, Options) ->
5108%%     {ok, Slave} | {error, Reason}
5109%%
5110%% Called by test_server. See test_server:start_node/3 for details
5111
5112start_node(Name, Type, Options) ->
5113    T = 10 * ?ACCEPT_TIMEOUT * test_server:timetrap_scale_factor(),
5114    format(minor, "Attempt to start ~w node ~tp with options ~tp",
5115	   [Type, Name, Options]),
5116    case controller_call({start_node,Name,Type,Options}, T) of
5117	{{ok,Nodename}, Host, Cmd, Info, Warning} ->
5118	    format(minor,
5119		   "Successfully started node ~w on ~tp with command: ~ts",
5120		   [Nodename, Host, Cmd]),
5121	    format(major, "=node_start    ~w", [Nodename]),
5122	    case Info of
5123		[] -> ok;
5124		_ -> format(minor, Info)
5125	    end,
5126	    case Warning of
5127		[] -> ok;
5128		_ ->
5129		    format(1, Warning),
5130		    format(minor, Warning)
5131	    end,
5132	    {ok, Nodename};
5133	{fail,{Ret, Host, Cmd}}  ->
5134	    format(minor,
5135		   "Failed to start node ~tp on ~tp with command: ~ts~n"
5136		   "Reason: ~tp",
5137		   [Name, Host, Cmd, Ret]),
5138	    {fail,Ret};
5139	{Ret, undefined, undefined} ->
5140	    format(minor, "Failed to start node ~tp: ~tp", [Name,Ret]),
5141	    Ret;
5142	{Ret, Host, Cmd} ->
5143	    format(minor,
5144		   "Failed to start node ~tp on ~tp with command: ~ts~n"
5145		   "Reason: ~tp",
5146		   [Name, Host, Cmd, Ret]),
5147	    Ret
5148    end.
5149
5150%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5151%% wait_for_node(Node) -> ok | {error,timeout}
5152%%
5153%% Wait for a slave/peer node which has been started with
5154%% the option {wait,false}. This function returns when
5155%% when the new node has contacted test_server_ctrl again
5156
5157wait_for_node(Slave) ->
5158    T = 10000 * test_server:timetrap_scale_factor(),
5159    case catch controller_call({wait_for_node,Slave},T) of
5160	{'EXIT',{timeout,_}} -> {error,timeout};
5161	ok -> ok
5162    end.
5163
5164%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5165%% is_release_available(Release) -> true | false
5166%% Release -> string()
5167%%
5168%% Test if a release (such as "r10b") is available to be
5169%% started using start_node/3.
5170
5171is_release_available(Release) ->
5172    controller_call({is_release_available,Release}).
5173
5174%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5175%% stop_node(Name) -> ok | {error,Reason}
5176%%
5177%% Clean up - test_server will stop this node
5178
5179stop_node(Slave) ->
5180    controller_call({stop_node,Slave}).
5181
5182
5183%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5184%%                        DEBUGGER INTERFACE                        %%
5185%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5186
5187i() ->
5188    hformat("Pid", "Initial Call", "Current Function", "Reducts", "Msgs"),
5189    Line=lists:duplicate(27, "-"),
5190    hformat(Line, Line, Line, Line, Line),
5191    display_info(processes(), 0, 0).
5192
5193p(A,B,C) ->
5194    pinfo(ts_pid(A,B,C)).
5195p(X) when is_atom(X) ->
5196    pinfo(whereis(X));
5197p({A,B,C}) ->
5198    pinfo(ts_pid(A,B,C));
5199p(X) ->
5200    pinfo(X).
5201
5202t() ->
5203    t(wall_clock).
5204t(X) ->
5205    element(1, statistics(X)).
5206
5207pi(Item,X) ->
5208    lists:keysearch(Item,1,p(X)).
5209pi(Item,A,B,C) ->
5210    lists:keysearch(Item,1,p(A,B,C)).
5211
5212%% c:pid/3
5213ts_pid(X,Y,Z) when is_integer(X), is_integer(Y), is_integer(Z) ->
5214    list_to_pid("<" ++ integer_to_list(X) ++ "." ++
5215		integer_to_list(Y) ++ "." ++
5216		integer_to_list(Z) ++ ">").
5217
5218
5219%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5220%% display_info(Pids, Reductions, Messages) -> void
5221%% Pids = [pid(),...]
5222%% Reductions = integer()
5223%% Messaged = integer()
5224%%
5225%% Displays info, similar to c:i() about the processes in the list Pids.
5226%% Also counts the total number of reductions and msgs for the listed
5227%% processes, if called with Reductions = Messages = 0.
5228
5229display_info([Pid|T], R, M) ->
5230    case pinfo(Pid) of
5231	undefined ->
5232	    display_info(T, R, M);
5233	Info ->
5234	    Call = fetch(initial_call, Info),
5235	    Curr = case fetch(current_function, Info) of
5236		       {Mod,F,Args} when is_list(Args) ->
5237			   {Mod,F,length(Args)};
5238		       Other ->
5239			   Other
5240		   end,
5241	    Reds  = fetch(reductions, Info),
5242	    LM = fetch(message_queue_len, Info),
5243	    pformat(io_lib:format("~w", [Pid]),
5244		    io_lib:format("~tw", [Call]),
5245		    io_lib:format("~tw", [Curr]), Reds, LM),
5246	    display_info(T, R+Reds, M + LM)
5247    end;
5248display_info([], R, M) ->
5249    Line=lists:duplicate(27, "-"),
5250    hformat(Line, Line, Line, Line, Line),
5251    pformat("Total", "", "", R, M).
5252
5253hformat(A1, A2, A3, A4, A5) ->
5254    io:format("~-10s ~-27s ~-27s ~8s ~4s~n", [A1,A2,A3,A4,A5]).
5255
5256pformat(A1, A2, A3, A4, A5) ->
5257    io:format("~-10s ~-27s ~-27s ~8w ~4w~n", [A1,A2,A3,A4,A5]).
5258
5259fetch(Key, Info) ->
5260    case lists:keysearch(Key, 1, Info) of
5261	{value, {_, Val}} ->
5262	    Val;
5263	_ ->
5264	    0
5265    end.
5266
5267pinfo(P) ->
5268    Node = node(),
5269    case node(P) of
5270	Node ->
5271	    process_info(P);
5272	_ ->
5273	    rpc:call(node(P),erlang,process_info,[P])
5274    end.
5275
5276
5277%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5278%%                   Support functions for COVER                    %%
5279%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5280%%
5281%% A module is included in the cover analysis if
5282%% - it belongs to the tested application and is not listed in the
5283%%   {exclude,List} part of the App.cover file
5284%% - it does not belong to the application, but is listed in the
5285%%   {include,List} part of the App.cover file
5286%% - it does not belong to the application, but is listed in the
5287%%   {cross,[{Tag,List}]} part of the App.cover file
5288%%
5289%% The modules listed in the 'cross' part of the cover file are
5290%% modules that are heavily used by other tests than the one where
5291%% they are explicitly tested. They should then be listed as 'cross'
5292%% in the cover file for the test where they are used but do not
5293%% belong.
5294%%
5295%% After all tests are completed, the these modules can be analysed
5296%% with coverage data from all tests where they are compiled - see
5297%% cross_cover_analyse/2. The result is stored in a file called
5298%% cross_cover.html in the run.<timestamp> directory of the
5299%% test the modules belong to.
5300%%
5301%% Example:
5302%% If the module m1 belongs to system s1 but is heavily used also in
5303%% the tests for another system s2, then the cover files for the two
5304%% systems could be like this:
5305%%
5306%% s1.cover:
5307%%  {include,[m1]}.
5308%%
5309%% s2.cover:
5310%%  {include,[....]}. % modules belonging to system s2
5311%%  {cross,[{s1,[m1]}]}.
5312%%
5313%% When the tests for both s1 and s2 are completed, run
5314%% cross_cover_analyse(Level,[{s1,S1LogDir},{s2,S2LogDir}]), and
5315%% the accumulated cover data for m1 will be written to
5316%% S1LogDir/[run.<timestamp>/]cross_cover.html
5317%%
5318%% S1LogDir and S2LogDir are either the run.<timestamp> directories
5319%% for the two tests, or the parent directory of these, in which case
5320%% the latest run.<timestamp> directory will be chosen.
5321%%
5322%% Note that the m1 module will also be presented in the normal
5323%% coverage log for s1 (due to the include statement in s1.cover), but
5324%% that only includes the coverage achieved by the s1 test itself.
5325%%
5326%% The Tag in the 'cross' statement in the cover file has no other
5327%% purpose than mapping the list of modules ([m1] in the example
5328%% above) to the correct log directory where it should be included in
5329%% the cross_cover.html file (S1LogDir in the example above).
5330%% I.e. the value of the Tag has no meaning, it could be foo as well
5331%% as s1 above, as long as the same Tag is used in the cover file and
5332%% in the call to cross_cover_analyse/2.
5333
5334
5335%% Cover compilation
5336%% The compilation is executed on the target node
5337start_cover(#cover{}=CoverInfo) ->
5338    cover_compile(CoverInfo);
5339start_cover({log,CoverLogDir}=CoverInfo) ->
5340    %% Cover is controlled by the framework - here's the log
5341    put(test_server_cover_log_dir,CoverLogDir),
5342    {ok,CoverInfo}.
5343
5344cover_compile(CoverInfo) ->
5345    test_server:cover_compile(CoverInfo).
5346
5347%% Read the coverfile for an application and return a list of modules
5348%% that are members of the application but shall not be compiled
5349%% (Exclude), and a list of modules that are not members of the
5350%% application but shall be compiled (Include).
5351read_cover_file(none) ->
5352    {[],[],[]};
5353read_cover_file(CoverFile) ->
5354    case file:consult(CoverFile) of
5355	{ok,List} ->
5356	    case check_cover_file(List, [], [], []) of
5357		{ok,Exclude,Include,Cross} -> {Exclude,Include,Cross};
5358		error ->
5359		    io:fwrite("Faulty format of CoverFile ~tp\n", [CoverFile]),
5360		    {[],[],[]}
5361	    end;
5362	{error,Reason} ->
5363	    io:fwrite("Can't read CoverFile ~ts\nReason: ~tp\n",
5364		      [CoverFile,Reason]),
5365	    {[],[],[]}
5366    end.
5367
5368check_cover_file([{exclude,all}|Rest], _, Include, Cross) ->
5369    check_cover_file(Rest, all, Include, Cross);
5370check_cover_file([{exclude,Exclude}|Rest], _, Include, Cross) ->
5371    case lists:all(fun(M) -> is_atom(M) end, Exclude) of
5372	true ->
5373	    check_cover_file(Rest, Exclude, Include, Cross);
5374	false ->
5375	    error
5376    end;
5377check_cover_file([{include,Include}|Rest], Exclude, _, Cross) ->
5378    case lists:all(fun(M) -> is_atom(M) end, Include) of
5379	true ->
5380	    check_cover_file(Rest, Exclude, Include, Cross);
5381	false ->
5382	    error
5383    end;
5384check_cover_file([{cross,Cross}|Rest], Exclude, Include, _) ->
5385    case check_cross(Cross) of
5386	true ->
5387	    check_cover_file(Rest, Exclude, Include, Cross);
5388	false ->
5389	    error
5390    end;
5391check_cover_file([], Exclude, Include, Cross) ->
5392    {ok,Exclude,Include,Cross}.
5393
5394check_cross([{Tag,Modules}|Rest]) ->
5395    case lists:all(fun(M) -> is_atom(M) end, [Tag|Modules]) of
5396	true ->
5397	    check_cross(Rest);
5398	false ->
5399	    false
5400    end;
5401check_cross([]) ->
5402    true.
5403
5404
5405%% Cover analysis, per application
5406%% This analysis is executed on the target node once the test is
5407%% completed for an application. This is not the same as the cross
5408%% cover analysis, which can be executed on any node after the tests
5409%% are finshed.
5410%%
5411%% This per application analysis writes the file cover.html in the
5412%% application's run.<timestamp> directory.
5413stop_cover(#cover{}=CoverInfo, TestDir) ->
5414    cover_analyse(CoverInfo, TestDir),
5415    ok;
5416stop_cover(_CoverInfo, _TestDir) ->
5417    %% Cover is probably controlled by the framework
5418    ok.
5419
5420make_relative(AbsDir, VsDir) ->
5421    DirTokens = filename:split(AbsDir),
5422    VsTokens = filename:split(VsDir),
5423    filename:join(make_relative1(DirTokens, VsTokens)).
5424
5425make_relative1([T | DirTs], [T | VsTs]) ->
5426    make_relative1(DirTs, VsTs);
5427make_relative1(Last = [_File], []) ->
5428    Last;
5429make_relative1(Last = [_File], VsTs) ->
5430    Ups = ["../" || _ <- VsTs],
5431    Ups ++ Last;
5432make_relative1(DirTs, []) ->
5433    DirTs;
5434make_relative1(DirTs, VsTs) ->
5435    Ups = ["../" || _ <- VsTs],
5436    Ups ++ DirTs.
5437
5438
5439cover_analyse(CoverInfo, TestDir) ->
5440    write_default_cross_coverlog(TestDir),
5441
5442    {ok,CoverLog} = open_html_file(filename:join(TestDir, ?coverlog_name)),
5443    write_coverlog_header(CoverLog),
5444    #cover{app=App,
5445	   file=CoverFile,
5446	   excl=Excluded,
5447	   cross=Cross} = CoverInfo,
5448    io:fwrite(CoverLog, "<h1>Coverage for application '~w'</h1>\n", [App]),
5449    io:fwrite(CoverLog,
5450	      "<p><a href=\"~ts\">Coverdata collected over all tests</a></p>",
5451	      [?cross_coverlog_name]),
5452
5453    io:fwrite(CoverLog, "<p>CoverFile: <code>~tp</code>\n", [CoverFile]),
5454    ok = write_cross_cover_info(TestDir,Cross),
5455
5456    case length(cover:imported_modules()) of
5457	Imps when Imps > 0 ->
5458	    io:fwrite(CoverLog,
5459		      "<p>Analysis includes data from ~w imported module(s).\n",
5460		      [Imps]);
5461	_ ->
5462	    ok
5463    end,
5464
5465    io:fwrite(CoverLog, "<p>Excluded module(s): <code>~tp</code>\n", [Excluded]),
5466
5467    Coverage = test_server:cover_analyse(TestDir, CoverInfo),
5468    ok = write_binary_file(filename:join(TestDir,?raw_coverlog_name),
5469		      term_to_binary(Coverage)),
5470
5471    case lists:filter(fun({_M,{_,_,_}}) -> false;
5472			 (_) -> true
5473		      end, Coverage) of
5474	[] ->
5475	    ok;
5476	Bad ->
5477	    io:fwrite(CoverLog, "<p>Analysis failed for ~w module(s): "
5478		      "<code>~w</code>\n",
5479		      [length(Bad),[BadM || {BadM,{_,_Why}} <- Bad]])
5480    end,
5481
5482    TotPercent = write_cover_result_table(CoverLog, Coverage),
5483    ok = write_binary_file(filename:join(TestDir, ?cover_total),
5484			   term_to_binary(TotPercent)).
5485
5486%% Cover analysis - accumulated over multiple tests
5487%% This can be executed on any node after all tests are finished.
5488%% Analyse = overview | details
5489%% TagDirs = [{Tag,Dir}]
5490%%   Tag = atom(), identifier
5491%%   Dir = string(), the log directory for Tag, it can be a
5492%%         run.<timestamp> directory or the parent directory of
5493%%         such (in which case the latest run.<timestamp> directory
5494%%         is used)
5495cross_cover_analyse(Analyse, TagDirs0) ->
5496    TagDirs = get_latest_run_dirs(TagDirs0),
5497    TagMods = get_all_cross_info(TagDirs,[]),
5498    TagDirMods = add_cross_modules(TagMods,TagDirs),
5499    CoverdataFiles = get_coverdata_files(TagDirMods),
5500    lists:foreach(fun(CDF) -> cover:import(CDF) end, CoverdataFiles),
5501    io:fwrite("Cover analysing...\n", []),
5502    DetailsFun =
5503	case Analyse of
5504	    details ->
5505		fun(Dir,M) ->
5506			OutFile = filename:join(Dir,
5507						atom_to_list(M) ++
5508						".CROSS_COVER.html"),
5509			case cover:analyse_to_file(M, OutFile, [html]) of
5510			    {ok,_} ->
5511				{file,OutFile};
5512			    Error ->
5513				Error
5514			end
5515		end;
5516	    _ ->
5517		fun(_,_) -> undefined end
5518	end,
5519    Coverage = analyse_tests(TagDirMods, DetailsFun, []),
5520    cover:stop(),
5521    write_cross_cover_logs(Coverage,TagDirMods).
5522
5523write_cross_cover_info(_Dir,[]) ->
5524    ok;
5525write_cross_cover_info(Dir,Cross) ->
5526    write_binary_file(filename:join(Dir,?cross_cover_info),
5527		      term_to_binary(Cross)).
5528
5529%% For each test from which there are cross cover analysed
5530%% modules, write a cross cover log (cross_cover.html).
5531write_cross_cover_logs([{Tag,Coverage}|T],TagDirMods) ->
5532    case lists:keyfind(Tag,1,TagDirMods) of
5533	{_,Dir,Mods} when Mods=/=[] ->
5534	    ok = write_binary_file(filename:join(Dir,?raw_cross_coverlog_name),
5535			      term_to_binary(Coverage)),
5536	    CoverLogName = filename:join(Dir,?cross_coverlog_name),
5537	    {ok,CoverLog} = open_html_file(CoverLogName),
5538	    write_coverlog_header(CoverLog),
5539	    io:fwrite(CoverLog,
5540		      "<h1>Coverage results for \'~w\' from all tests</h1>\n",
5541		      [Tag]),
5542	    write_cover_result_table(CoverLog, Coverage),
5543	    io:fwrite("Written file ~tp\n", [CoverLogName]);
5544	_ ->
5545	    ok
5546    end,
5547    write_cross_cover_logs(T,TagDirMods);
5548write_cross_cover_logs([],_) ->
5549    io:fwrite("done\n", []).
5550
5551%% Get the latest run.<timestamp> directories
5552get_latest_run_dirs([{Tag,Dir}|Rest]) ->
5553    [{Tag,get_latest_run_dir(Dir)} | get_latest_run_dirs(Rest)];
5554get_latest_run_dirs([]) ->
5555    [].
5556
5557get_latest_run_dir(Dir) ->
5558    case filelib:wildcard(filename:join(Dir,"run.[1-2]*")) of
5559	[] ->
5560	    Dir;
5561	[H|T] ->
5562	    get_latest_dir(T,H)
5563    end.
5564
5565get_latest_dir([H|T],Latest) when H>Latest ->
5566    get_latest_dir(T,H);
5567get_latest_dir([_|T],Latest) ->
5568    get_latest_dir(T,Latest);
5569get_latest_dir([],Latest) ->
5570    Latest.
5571
5572get_all_cross_info([{_Tag,Dir}|Rest],Acc) ->
5573    case file:read_file(filename:join(Dir,?cross_cover_info)) of
5574	{ok,Bin} ->
5575	    TagMods = binary_to_term(Bin),
5576	    get_all_cross_info(Rest,TagMods++Acc);
5577	_ ->
5578	    get_all_cross_info(Rest,Acc)
5579    end;
5580get_all_cross_info([],Acc) ->
5581    Acc.
5582
5583%% Associate the cross cover modules with their log directories
5584add_cross_modules(TagMods,TagDirs)->
5585    do_add_cross_modules(TagMods,[{Tag,Dir,[]} || {Tag,Dir} <- TagDirs]).
5586do_add_cross_modules([{Tag,Mods1}|TagMods],TagDirMods)->
5587    NewTagDirMods =
5588	case lists:keytake(Tag,1,TagDirMods) of
5589	    {value,{Tag,Dir,Mods},Rest} ->
5590		[{Tag,Dir,lists:umerge(lists:sort(Mods1),Mods)}|Rest];
5591	    false ->
5592		TagDirMods
5593	end,
5594    do_add_cross_modules(TagMods,NewTagDirMods);
5595do_add_cross_modules([],TagDirMods) ->
5596    %% Just to get the modules in the same order as in the normal cover log
5597    [{Tag,Dir,lists:reverse(Mods)} || {Tag,Dir,Mods} <- TagDirMods].
5598
5599%% Find all exported coverdata files.
5600get_coverdata_files(TagDirMods) ->
5601    lists:flatmap(
5602      fun({_,LatestDir,_}) ->
5603	      filelib:wildcard(filename:join(LatestDir,"all.coverdata"))
5604      end,
5605      TagDirMods).
5606
5607
5608%% For each test, analyse all modules
5609%% Used for cross cover analysis.
5610analyse_tests([{Tag,LastTest,Modules}|T], DetailsFun, Acc) ->
5611    Cov = analyse_modules(LastTest, Modules, DetailsFun, []),
5612    analyse_tests(T, DetailsFun, [{Tag,Cov}|Acc]);
5613analyse_tests([], _DetailsFun, Acc) ->
5614    Acc.
5615
5616%% Analyse each module
5617%% Used for cross cover analysis.
5618analyse_modules(Dir, [M|Modules], DetailsFun, Acc) ->
5619    {ok,{M,{Cov,NotCov}}} = cover:analyse(M, module),
5620    Acc1 = [{M,{Cov,NotCov,DetailsFun(Dir,M)}}|Acc],
5621    analyse_modules(Dir, Modules, DetailsFun, Acc1);
5622analyse_modules(_Dir, [], _DetailsFun, Acc) ->
5623    Acc.
5624
5625
5626%% Support functions for writing the cover logs (both cross and normal)
5627write_coverlog_header(CoverLog) ->
5628    case catch io:put_chars(CoverLog,html_header("Coverage results")) of
5629	{'EXIT',Reason} ->
5630	    io:format("\n\nERROR: Could not write normal heading in coverlog.\n"
5631		      "CoverLog: ~tw\n"
5632		      "Reason: ~tp\n",
5633		      [CoverLog,Reason]),
5634	    io:format(CoverLog,"<html><body>\n", []);
5635	_ ->
5636	    ok
5637    end.
5638
5639
5640format_analyse(M,Cov,NotCov,undefined) ->
5641    io_lib:fwrite("<tr><td>~w</td>"
5642		  "<td align=right>~w %</td>"
5643		  "<td align=right>~w</td>"
5644		  "<td align=right>~w</td></tr>\n",
5645		  [M,pc(Cov,NotCov),Cov,NotCov]);
5646format_analyse(M,Cov,NotCov,{file,File}) ->
5647    io_lib:fwrite("<tr><td><a href=\"~ts\">~w</a></td>"
5648		  "<td align=right>~w %</td>"
5649		  "<td align=right>~w</td>"
5650		  "<td align=right>~w</td></tr>\n",
5651		  [uri_encode(filename:basename(File)),
5652		   M,pc(Cov,NotCov),Cov,NotCov]);
5653format_analyse(M,Cov,NotCov,{lines,Lines}) ->
5654    CoverOutName = atom_to_list(M)++".COVER.html",
5655    {ok,CoverOut} = open_html_file(CoverOutName),
5656    write_not_covered(CoverOut,M,Lines),
5657    ok = file:close(CoverOut),
5658    io_lib:fwrite("<tr><td><a href=\"~ts\">~w</a></td>"
5659		  "<td align=right>~w %</td>"
5660		  "<td align=right>~w</td>"
5661		  "<td align=right>~w</td></tr>\n",
5662		  [uri_encode(CoverOutName),M,pc(Cov,NotCov),Cov,NotCov]);
5663format_analyse(M,Cov,NotCov,{error,_}) ->
5664    io_lib:fwrite("<tr><td>~w</td>"
5665		  "<td align=right>~w %</td>"
5666		  "<td align=right>~w</td>"
5667		  "<td align=right>~w</td></tr>\n",
5668		  [M,pc(Cov,NotCov),Cov,NotCov]).
5669
5670
5671pc(0,0) ->
5672    0;
5673pc(Cov,NotCov) ->
5674    round(Cov/(Cov+NotCov)*100).
5675
5676
5677write_not_covered(CoverOut,M,Lines) ->
5678    io:put_chars(CoverOut,html_header("Coverage results for "++atom_to_list(M))),
5679    io:fwrite(CoverOut,
5680	      "The following lines in module ~w are not covered:\n"
5681	      "<table border=3 cellpadding=5>\n"
5682	      "<th>Line Number</th>\n",
5683	      [M]),
5684    lists:foreach(fun({{_M,Line},{0,1}}) ->
5685			  io:fwrite(CoverOut,"<tr><td>~w</td></tr>\n", [Line]);
5686		     (_) ->
5687			  ok
5688		  end,
5689		  Lines),
5690    io:put_chars(CoverOut,"</table>\n</body>\n</html>\n").
5691
5692
5693write_default_coverlog(TestDir) ->
5694    {ok,CoverLog} = open_html_file(filename:join(TestDir,?coverlog_name)),
5695    write_coverlog_header(CoverLog),
5696    io:put_chars(CoverLog,"Cover tool is not used\n</body></html>\n"),
5697    ok = file:close(CoverLog).
5698
5699write_default_cross_coverlog(TestDir) ->
5700    {ok,CrossCoverLog} =
5701	open_html_file(filename:join(TestDir,?cross_coverlog_name)),
5702    write_coverlog_header(CrossCoverLog),
5703    io:put_chars(CrossCoverLog,
5704		 ["No cross cover modules exist for this application,",
5705		  xhtml("<br>","<br />"),
5706		  "or cross cover analysis is not completed.\n"
5707		  "</body></html>\n"]),
5708    ok = file:close(CrossCoverLog).
5709
5710write_cover_result_table(CoverLog,Coverage) ->
5711    io:fwrite(CoverLog,
5712	      "<p><table border=3 cellpadding=5>\n"
5713	      "<tr><th>Module</th><th>Covered (%)</th><th>Covered (Lines)</th>"
5714	      "<th>Not covered (Lines)</th>\n",
5715	      []),
5716    {TotCov,TotNotCov} =
5717	lists:foldl(fun({M,{Cov,NotCov,Details}},{AccCov,AccNotCov}) ->
5718			    Str = format_analyse(M,Cov,NotCov,Details),
5719			    io:fwrite(CoverLog,"~ts", [Str]),
5720			    {AccCov+Cov,AccNotCov+NotCov};
5721		       ({_M,{error,_Reason}},{AccCov,AccNotCov}) ->
5722			    {AccCov,AccNotCov}
5723		    end,
5724		    {0,0},
5725		    Coverage),
5726    TotPercent = pc(TotCov,TotNotCov),
5727    io:fwrite(CoverLog,
5728	      "<tr><th align=left>Total</th><th align=right>~w %</th>"
5729	      "<th align=right>~w</th><th align=right>~w</th></tr>\n"
5730	      "</table>\n"
5731	      "</body>\n"
5732	      "</html>\n",
5733	      [TotPercent,TotCov,TotNotCov]),
5734    ok = file:close(CoverLog),
5735    TotPercent.
5736
5737
5738%%%-----------------------------------------------------------------
5739%%% Support functions for writing files
5740
5741%% HTML files are always written with utf8 encoding
5742html_header(Title) ->
5743    ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n"
5744     "<!-- autogenerated by '", atom_to_list(?MODULE), "'. -->\n"
5745     "<html>\n"
5746     "<head>\n"
5747     "<title>", Title, "</title>\n"
5748     "<meta http-equiv=\"cache-control\" content=\"no-cache\"></meta>\n"
5749     "<meta http-equiv=\"content-type\" content=\"text/html; "
5750            "charset=utf-8\"></meta>\n"
5751     "</head>\n"
5752     "<body bgcolor=\"white\" text=\"black\" "
5753     "link=\"blue\" vlink=\"purple\" alink=\"red\">\n"].
5754
5755html_header(Title, Meta) ->
5756    ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n"
5757     "<!-- autogenerated by '", atom_to_list(?MODULE), "'. -->\n"
5758     "<html>\n"
5759     "<head>\n"
5760     "<title>", Title, "</title>\n"] ++ Meta ++ ["</head>\n"].
5761
5762open_html_file(File) ->
5763    open_utf8_file(File).
5764
5765open_html_file(File,Opts) ->
5766    open_utf8_file(File,Opts).
5767
5768write_html_file(File,Content) ->
5769    write_file(File,Content,utf8).
5770
5771%% The 'major' log file, which is a pure text file is also written
5772%% with utf8 encoding
5773open_utf8_file(File) ->
5774    case file:open(File,AllOpts=[write,{encoding,utf8}]) of
5775	{error,Reason} -> {error,{Reason,{File,AllOpts}}};
5776	Result         -> Result
5777    end.
5778
5779open_utf8_file(File,Opts) ->
5780    case file:open(File,AllOpts=[{encoding,utf8}|Opts]) of
5781	{error,Reason} -> {error,{Reason,{File,AllOpts}}};
5782	Result         -> Result
5783    end.
5784
5785%% Write a file with specified encoding
5786write_file(File,Content,latin1) ->
5787    file:write_file(File,Content);
5788write_file(File,Content,utf8) ->
5789    write_binary_file(File,unicode:characters_to_binary(Content)).
5790
5791%% Write a file with only binary data
5792write_binary_file(File,Content) ->
5793    file:write_file(File,Content).
5794
5795%% Encoding of hyperlinks in HTML files
5796uri_encode(File) ->
5797    Encoding = file:native_name_encoding(),
5798    uri_encode(File,Encoding).
5799
5800uri_encode(File,Encoding) ->
5801    Components = filename:split(File),
5802    filename:join([uri_encode_comp(C,Encoding) || C <- Components]).
5803
5804%% Encode the reference to a "filename of the given encoding" so it
5805%% can be inserted in a utf8 encoded HTML file.
5806%% This does almost the same as http_uri:encode/1, except
5807%% 1. it does not convert @, : and / (in order to preserve nodename and c:/)
5808%% 2. if the file name is in latin1, it also encodes all
5809%%    characters >127 - i.e. latin1 but not ASCII.
5810uri_encode_comp([Char|Chars],Encoding) ->
5811    Reserved = sets:is_element(Char, reserved()),
5812    case (Char>127 andalso Encoding==latin1) orelse Reserved of
5813	true ->
5814	    [ $% | integer_to_list(Char, 16)] ++
5815		uri_encode_comp(Chars,Encoding);
5816	false ->
5817	    [Char | uri_encode_comp(Chars,Encoding)]
5818    end;
5819uri_encode_comp([],_) ->
5820    [].
5821
5822%% Copied from http_uri.erl, but slightly modified
5823%% (not converting @, : and /)
5824reserved() ->
5825    sets:from_list([$;, $&, $=, $+, $,, $?,
5826		    $#, $[, $], $<, $>, $\", ${, $}, $|,
5827                    $\\, $', $^, $%, $ ]).
5828
5829encoding(File) ->
5830    case epp:read_encoding(File) of
5831	none ->
5832	    epp:default_encoding();
5833	E ->
5834	    E
5835    end.
5836
5837check_repeat_testcase(Case,Result,Cases,
5838                      [{Ref,[{repeat,RepeatData0}],StartTime}|Mode0]) ->
5839    case do_update_repeat_data(Result,RepeatData0) of
5840        false ->
5841            {Cases,Mode0};
5842        RepeatData ->
5843            {[Case|Cases],[{Ref,[{repeat,RepeatData}],StartTime}|Mode0]}
5844    end;
5845check_repeat_testcase(_,_,Cases,Mode) ->
5846    {Cases,Mode}.
5847
5848do_update_repeat_data(_,{RT,N,N}) when is_integer(N) ->
5849    report_repeat_testcase(N,N),
5850    report_stop_repeat_testcase(done,{RT,N}),
5851    false;
5852do_update_repeat_data(ok,{repeat_until_ok=RT,M,N}) ->
5853    report_repeat_testcase(M,N),
5854    report_stop_repeat_testcase(RT,{RT,N}),
5855    false;
5856do_update_repeat_data(failed,{repeat_until_fail=RT,M,N}) ->
5857    report_repeat_testcase(M,N),
5858    report_stop_repeat_testcase(RT,{RT,N}),
5859    false;
5860do_update_repeat_data(_,{RT,M,N}) when is_integer(M) ->
5861    report_repeat_testcase(M,N),
5862    {RT,M+1,N};
5863do_update_repeat_data(_,{_,M,N}=RepeatData) ->
5864    report_repeat_testcase(M,N),
5865    RepeatData.
5866
5867report_stop_repeat_testcase(Reason,RepVal) ->
5868    print(minor, "~n*** Stopping test case repeat operation: ~w", [Reason]),
5869    print(1, "Stopping test case repeat operation: ~w", [RepVal]).
5870
5871report_repeat_testcase(M,forever) ->
5872    print(minor, "~n=== Repeated test case: ~w of infinity", [M]);
5873report_repeat_testcase(M,N) ->
5874    print(minor, "~n=== Repeated test case: ~w of ~w", [M,N]).
5875