1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1997-2018. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(ts_lib).
21
22-include_lib("kernel/include/file.hrl").
23-include("ts.hrl").
24
25%% Avoid warning for local function error/1 clashing with autoimported BIF.
26-compile({no_auto_import,[error/1]}).
27-export([error/1, var/2, erlang_type/0,
28	 erlang_type/1,
29	 initial_capital/1,
30	 specs/1, suites/2,
31	 test_categories/2, specialized_specs/2,
32	 subst_file/3, subst/2, print_data/1,
33	 make_non_erlang/2,
34	 maybe_atom_to_list/1, progress/4,
35	 b2s/1
36	]).
37
38error(Reason) ->
39    throw({error, Reason}).
40
41%% Returns the value for a variable
42
43var(Name, Vars) ->
44    case lists:keysearch(Name, 1, Vars) of
45	{value, {Name, Value}} ->
46	    Value;
47	false ->
48	    error({bad_installation, {undefined_var, Name, Vars}})
49    end.
50
51%% Returns the level of verbosity (0-X)
52verbosity(Vars) ->
53    % Check for a single verbose option.
54    case lists:member(verbose, Vars) of
55	true ->
56	    1;
57	false ->
58	    case lists:keysearch(verbose, 1, Vars) of
59		{value, {verbose, Level}} ->
60		    Level;
61		_ ->
62		    0
63	    end
64    end.
65
66% Displays output to the console if verbosity is equal or more
67% than Level.
68progress(Vars, Level, Format, Args) ->
69    V=verbosity(Vars),
70    if
71	V>=Level ->
72	    io:format(Format, Args);
73	true ->
74	    ok
75    end.
76
77%% Returns: {Type, Version} where Type is otp|src
78
79erlang_type() ->
80    erlang_type(code:root_dir()).
81erlang_type(RootDir) ->
82    {_, Version} = init:script_id(),
83    RelDir = filename:join(RootDir, "releases"), % Only in installed
84    case filelib:is_file(RelDir) of
85	true -> {otp,Version};			% installed OTP
86	false -> {srctree,Version}		% source code tree
87    end.
88
89%% Upcases the first letter in a string.
90
91initial_capital([C|Rest]) when $a =< C, C =< $z ->
92    [C-$a+$A|Rest];
93initial_capital(String) ->
94    String.
95
96specialized_specs(Dir,PostFix) ->
97    Specs = filelib:wildcard(filename:join([filename:dirname(Dir),
98					    "*_test", "*_"++PostFix++".spec"])),
99    sort_tests([begin
100		    DirPart = filename:dirname(Name),
101		    AppTest = hd(lists:reverse(filename:split(DirPart))),
102		    list_to_atom(string:slice(AppTest, 0, string:length(AppTest)-5))
103		end || Name <- Specs]).
104
105specs(Dir) ->
106    Specs = filelib:wildcard(filename:join([filename:dirname(Dir),
107					    "*_test", "*.{dyn,}spec"])),
108    %% Make sure only to include the main spec for each application
109    MainSpecs =
110	lists:flatmap(fun(FullName) ->
111			      [Spec,TestDir|_] =
112				  lists:reverse(filename:split(FullName)),
113			      [_TestSuffix|TDParts] =
114				  lists:reverse(string:lexemes(TestDir,[$_,$.])),
115			      [_SpecSuffix|SParts] =
116				  lists:reverse(string:lexemes(Spec,[$_,$.])),
117			      if TDParts == SParts ->
118				      [filename_to_atom(FullName)];
119				 true ->
120				      []
121			      end
122		      end, Specs),
123
124    sort_tests(filter_tests(MainSpecs)).
125
126test_categories(Dir, App) ->
127    Specs = filelib:wildcard(filename:join([filename:dirname(Dir),
128					    App++"_test", "*.spec"])),
129    lists:flatmap(fun(FullName) ->
130			  [Spec,_TestDir|_] =
131			      lists:reverse(filename:split(FullName)),
132			  case filename:rootname(Spec -- App) of
133			      "" ->
134				  [];
135			      [_Sep | Cat] ->
136				  [list_to_atom(Cat)]
137			  end
138		  end, Specs).
139
140suites(Dir, App) ->
141    Glob=filename:join([filename:dirname(Dir), App++"_test",
142			"*_SUITE.erl"]),
143    Suites=filelib:wildcard(Glob),
144    [filename_to_atom(Name) || Name <- Suites].
145
146filename_to_atom(Name) ->
147    list_to_atom(filename:rootname(filename:basename(Name))).
148
149%% Filter out tests of applications that are not accessible
150
151filter_tests(Tests) ->
152    lists:filter(
153      fun(Special) when Special == epmd;
154                        Special == emulator;
155                        Special == system ->
156              true;
157         (Test) ->
158              case application:load(filename_to_atom(Test)) of
159                  {error, {already_loaded, _}} ->
160                      true;
161                  {error,_NoSuchApplication} ->
162                      false;
163                  _ ->
164                      true
165              end
166      end, Tests).
167
168%% Sorts a list of either log files directories or spec files.
169
170sort_tests(Tests) ->
171    Sorted = lists:usort([{suite_order(filename_to_atom(X)), X} ||
172			     X <- Tests]),
173    [X || {_, X} <- Sorted].
174
175%% This defines the order in which tests should be run and be presented
176%% in index files.
177
178suite_order(emulator) -> 0;
179suite_order(test_server) -> 1;
180suite_order(kernel) -> 4;
181suite_order(stdlib) -> 6;
182suite_order(compiler) -> 8;
183suite_order(erl_interface) -> 12;
184suite_order(jinterface) -> 14;
185suite_order(sasl) -> 16;
186suite_order(tools) -> 18;
187suite_order(runtime_tools) -> 19;
188suite_order(parsetools) -> 20;
189suite_order(debugger) -> 22;
190suite_order(ic) -> 24;
191suite_order(orber) -> 26;
192suite_order(inets) -> 28;
193suite_order(asn1) -> 30;
194suite_order(os_mon) -> 32;
195suite_order(snmp) -> 38;
196suite_order(mnesia) -> 44;
197suite_order(system) -> 999; %% IMPORTANT: system SHOULD always be last!
198suite_order(_) -> 200.
199
200%% Substitute all occurrences of @var@ in the In file, using
201%% the list of variables in Vars, producing the output file Out.
202%% Returns: ok | {error, Reason}
203
204subst_file(In, Out, Vars) ->
205    case file:read_file(In) of
206	{ok, Bin} ->
207	    Subst = subst(b2s(Bin), Vars, []),
208	    case file:write_file(Out, unicode:characters_to_binary(Subst)) of
209		ok ->
210		    ok;
211		{error, Reason} ->
212		    {error, {file_write, Reason}}
213	    end;
214	Error ->
215	    Error
216    end.
217
218subst(String, Vars) ->
219    subst(String, Vars, []).
220
221subst([$@, $_|Rest], Vars, Result) ->
222    subst_var([$_|Rest], Vars, Result, []);
223subst([$@, C|Rest], Vars, Result) when $A =< C, C =< $Z ->
224    subst_var([C|Rest], Vars, Result, []);
225subst([$@, C|Rest], Vars, Result) when $a =< C, C =< $z ->
226    subst_var([C|Rest], Vars, Result, []);
227subst([C|Rest], Vars, Result) ->
228    subst(Rest, Vars, [C|Result]);
229subst([], _Vars, Result) ->
230    lists:reverse(Result).
231
232subst_var([$@|Rest], Vars, Result, VarAcc) ->
233    Key = list_to_atom(lists:reverse(VarAcc)),
234    {Result1,Rest1} = do_subst_var(Key, Rest, Vars, Result, VarAcc),
235    subst(Rest1, Vars, Result1);
236
237subst_var([C|Rest], Vars, Result, VarAcc) ->
238    subst_var(Rest, Vars, Result, [C|VarAcc]);
239subst_var([], Vars, Result, VarAcc) ->
240    subst([], Vars, [VarAcc++[$@|Result]]).
241
242%% handle conditional
243do_subst_var(Cond, Rest, Vars, Result, _VarAcc) when Cond == 'IFEQ' ;
244						     Cond == 'IFNEQ' ->
245    {Bool,Comment,Rest1} = do_test(Rest, Vars, Cond),
246    Rest2 = extract_clause(Bool, Rest1),
247    {lists:reverse(Comment, Result),Rest2};
248%% variable substitution
249do_subst_var(Key, Rest, Vars, Result, VarAcc) ->
250    case lists:keysearch(Key, 1, Vars) of
251	{value, {Key, Value}} ->
252	    {lists:reverse(Value, Result),Rest};
253	false ->
254	    {[$@|VarAcc++[$@|Result]],Rest}
255    end.
256
257%% check arguments in "@IF[N]EQ@ (Arg1, Arg2)" for equality
258do_test(Rest, Vars, Test) ->
259    {Arg1,Rest1} = get_arg(Rest, Vars, $,, []),
260    {Arg2,Rest2} = get_arg(Rest1, Vars, 41, []), % $)
261    Result = case Arg1 of
262		 Arg2 when Test == 'IFEQ'  -> true;
263		 Arg2 when Test == 'IFNEQ' -> false;
264		 _    when Test == 'IFNEQ' -> true;
265		 _                         -> false
266	     end,
267    Comment = io_lib:format("# Result of test: ~s (~s, ~s) -> ~w",
268			    [atom_to_list(Test),Arg1,Arg2,Result]),
269    {Result,Comment,Rest2}.
270
271%% extract an argument
272get_arg([$(|Rest], Vars, Stop, _) ->
273    get_arg(Rest, Vars, Stop, []);
274get_arg([Stop|Rest], Vars, Stop, Acc) ->
275    Arg = string:trim(lists:reverse(Acc),both,[$\s]),
276    Subst = subst(Arg, Vars),
277    {Subst,Rest};
278get_arg([C|Rest], Vars, Stop, Acc) ->
279    get_arg(Rest, Vars, Stop, [C|Acc]).
280
281%% keep only the true or false conditional clause
282extract_clause(true, Rest) ->
283    extract_clause(true, Rest, []);
284extract_clause(false, Rest) ->
285    Rest1 = discard_clause(Rest),		% discard true clause
286    extract_clause(false, Rest1, []).
287
288%% true clause buffered, done
289extract_clause(true, [$@,$E,$L,$S,$E,$@|Rest], Acc) ->
290    Rest1 = discard_clause(Rest),		% discard false clause
291    lists:reverse(Acc, Rest1);
292%% buffering of false clause starts now
293extract_clause(false, [$@,$E,$L,$S,$E,$@|Rest], _Acc) ->
294    extract_clause(false, Rest, []);
295%% true clause buffered, done
296extract_clause(true, [$@,$E,$N,$D,$I,$F,$@|Rest], Acc) ->
297    lists:reverse(Acc, Rest);
298%% false clause buffered, done
299extract_clause(false, [$@,$E,$N,$D,$I,$F,$@|Rest], Acc) ->
300    lists:reverse(Acc, Rest);
301%% keep buffering
302extract_clause(Bool, [C|Rest], Acc) ->
303    extract_clause(Bool, Rest, [C|Acc]);
304%% parse error
305extract_clause(_, [], Acc) ->
306    lists:reverse(Acc).
307
308discard_clause([$@,$E,$L,$S,$E,$@|Rest]) ->
309    Rest;
310discard_clause([$@,$E,$N,$D,$I,$F,$@|Rest]) ->
311    Rest;
312discard_clause([_C|Rest]) ->
313    discard_clause(Rest);
314discard_clause([]) ->				% parse error
315    [].
316
317
318print_data(Port) ->
319    receive
320	{Port, {data, Bytes}} ->
321	    io:put_chars(Bytes),
322	    print_data(Port);
323	{Port, eof} ->
324	    Port ! {self(), close},
325	    receive
326		{Port, closed} ->
327		    true
328	    end,
329	    receive
330		{'EXIT',  Port,  _} ->
331		    ok
332	    after 1 ->				% force context switch
333		    ok
334	    end
335    end.
336
337maybe_atom_to_list(To_list) when is_list(To_list) ->
338    To_list;
339maybe_atom_to_list(To_list) when is_atom(To_list)->
340    atom_to_list(To_list).
341
342
343%% Configure and run all the Makefiles in the data dir of the suite
344%% in question
345make_non_erlang(DataDir, Variables) ->
346    %% Make the stuff in all_SUITE_data if it exists
347    AllDir = filename:join(DataDir,"../all_SUITE_data"),
348    case filelib:is_dir(AllDir) of
349	true ->
350	    make_non_erlang_do(AllDir,Variables);
351	false ->
352	    ok
353    end,
354    make_non_erlang_do(DataDir, Variables).
355
356make_non_erlang_do(DataDir, Variables) ->
357    try
358	MakeCommand = proplists:get_value(make_command,Variables),
359
360	FirstMakefile = filename:join(DataDir,"Makefile.first"),
361	case filelib:is_regular(FirstMakefile) of
362	    true ->
363		io:format("Making ~p",[FirstMakefile]),
364		ok = ts_make:make(
365		       MakeCommand, DataDir, filename:basename(FirstMakefile));
366	    false ->
367		ok
368	end,
369
370	MakefileSrc = filename:join(DataDir,"Makefile.src"),
371	MakefileDest = filename:join(DataDir,"Makefile"),
372	case filelib:is_regular(MakefileSrc) of
373	    true ->
374		ok = ts_lib:subst_file(MakefileSrc,MakefileDest,Variables),
375		io:format("Making ~p",[MakefileDest]),
376		ok = ts_make:make([{makefile,"Makefile"},{data_dir,DataDir}
377				   | Variables]);
378	    false ->
379		ok
380	end
381    after
382	timer:sleep(100)  %% maybe unnecessary now when we don't do set_cwd anymore
383    end.
384
385b2s(Bin) ->
386    unicode:characters_to_list(Bin,default_encoding()).
387
388default_encoding() ->
389    try epp:default_encoding()
390    catch error:undef -> latin1
391    end.
392