aboutsummaryrefslogtreecommitdiffstats
path: root/lib/common_test/test_server/ts_lib.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/common_test/test_server/ts_lib.erl')
-rw-r--r--lib/common_test/test_server/ts_lib.erl372
1 files changed, 372 insertions, 0 deletions
diff --git a/lib/common_test/test_server/ts_lib.erl b/lib/common_test/test_server/ts_lib.erl
new file mode 100644
index 0000000000..7c3f450194
--- /dev/null
+++ b/lib/common_test/test_server/ts_lib.erl
@@ -0,0 +1,372 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(ts_lib).
+
+-include_lib("kernel/include/file.hrl").
+-include("ts.hrl").
+
+%% Avoid warning for local function error/1 clashing with autoimported BIF.
+-compile({no_auto_import,[error/1]}).
+-export([error/1, var/2, erlang_type/0,
+ erlang_type/1,
+ initial_capital/1,
+ specs/1, suites/2,
+ test_categories/2, specialized_specs/2,
+ subst_file/3, subst/2, print_data/1,
+ make_non_erlang/2,
+ maybe_atom_to_list/1, progress/4,
+ b2s/1
+ ]).
+
+error(Reason) ->
+ throw({error, Reason}).
+
+%% Returns the value for a variable
+
+var(Name, Vars) ->
+ case lists:keysearch(Name, 1, Vars) of
+ {value, {Name, Value}} ->
+ Value;
+ false ->
+ error({bad_installation, {undefined_var, Name, Vars}})
+ end.
+
+%% Returns the level of verbosity (0-X)
+verbosity(Vars) ->
+ % Check for a single verbose option.
+ case lists:member(verbose, Vars) of
+ true ->
+ 1;
+ false ->
+ case lists:keysearch(verbose, 1, Vars) of
+ {value, {verbose, Level}} ->
+ Level;
+ _ ->
+ 0
+ end
+ end.
+
+% Displays output to the console if verbosity is equal or more
+% than Level.
+progress(Vars, Level, Format, Args) ->
+ V=verbosity(Vars),
+ if
+ V>=Level ->
+ io:format(Format, Args);
+ true ->
+ ok
+ end.
+
+%% Returns: {Type, Version} where Type is otp|src
+
+erlang_type() ->
+ erlang_type(code:root_dir()).
+erlang_type(RootDir) ->
+ {_, Version} = init:script_id(),
+ RelDir = filename:join(RootDir, "releases"), % Only in installed
+ case filelib:is_file(RelDir) of
+ true -> {otp,Version}; % installed OTP
+ false -> {srctree,Version} % source code tree
+ end.
+
+%% Upcases the first letter in a string.
+
+initial_capital([C|Rest]) when $a =< C, C =< $z ->
+ [C-$a+$A|Rest];
+initial_capital(String) ->
+ String.
+
+specialized_specs(Dir,PostFix) ->
+ Specs = filelib:wildcard(filename:join([filename:dirname(Dir),
+ "*_test", "*_"++PostFix++".spec"])),
+ sort_tests([begin
+ DirPart = filename:dirname(Name),
+ AppTest = hd(lists:reverse(filename:split(DirPart))),
+ list_to_atom(string:substr(AppTest, 1, length(AppTest)-5))
+ end || Name <- Specs]).
+
+specs(Dir) ->
+ Specs = filelib:wildcard(filename:join([filename:dirname(Dir),
+ "*_test", "*.{dyn,}spec"])),
+ %% Make sure only to include the main spec for each application
+ MainSpecs =
+ lists:flatmap(fun(FullName) ->
+ [Spec,TestDir|_] =
+ lists:reverse(filename:split(FullName)),
+ [_TestSuffix|TDParts] =
+ lists:reverse(string:tokens(TestDir,[$_,$.])),
+ [_SpecSuffix|SParts] =
+ lists:reverse(string:tokens(Spec,[$_,$.])),
+ if TDParts == SParts ->
+ [filename_to_atom(FullName)];
+ true ->
+ []
+ end
+ end, Specs),
+ sort_tests(MainSpecs).
+
+test_categories(Dir, App) ->
+ Specs = filelib:wildcard(filename:join([filename:dirname(Dir),
+ App++"_test", "*.spec"])),
+ lists:flatmap(fun(FullName) ->
+ [Spec,_TestDir|_] =
+ lists:reverse(filename:split(FullName)),
+ case filename:rootname(Spec -- App) of
+ "" ->
+ [];
+ [_Sep | Cat] ->
+ [list_to_atom(Cat)]
+ end
+ end, Specs).
+
+suites(Dir, App) ->
+ Glob=filename:join([filename:dirname(Dir), App++"_test",
+ "*_SUITE.erl"]),
+ Suites=filelib:wildcard(Glob),
+ [filename_to_atom(Name) || Name <- Suites].
+
+filename_to_atom(Name) ->
+ list_to_atom(filename:rootname(filename:basename(Name))).
+
+%% Sorts a list of either log files directories or spec files.
+
+sort_tests(Tests) ->
+ Sorted = lists:usort([{suite_order(filename_to_atom(X)), X} ||
+ X <- Tests]),
+ [X || {_, X} <- Sorted].
+
+%% This defines the order in which tests should be run and be presented
+%% in index files.
+
+suite_order(emulator) -> 0;
+suite_order(test_server) -> 1;
+suite_order(kernel) -> 4;
+suite_order(stdlib) -> 6;
+suite_order(compiler) -> 8;
+suite_order(hipe) -> 9;
+suite_order(erl_interface) -> 12;
+suite_order(jinterface) -> 14;
+suite_order(sasl) -> 16;
+suite_order(tools) -> 18;
+suite_order(runtime_tools) -> 19;
+suite_order(parsetools) -> 20;
+suite_order(debugger) -> 22;
+suite_order(ic) -> 24;
+suite_order(orber) -> 26;
+suite_order(inets) -> 28;
+suite_order(asn1) -> 30;
+suite_order(os_mon) -> 32;
+suite_order(snmp) -> 38;
+suite_order(mnesia) -> 44;
+suite_order(system) -> 999; %% IMPORTANT: system SHOULD always be last!
+suite_order(_) -> 200.
+
+%% Substitute all occurrences of @var@ in the In file, using
+%% the list of variables in Vars, producing the output file Out.
+%% Returns: ok | {error, Reason}
+
+subst_file(In, Out, Vars) ->
+ case file:read_file(In) of
+ {ok, Bin} ->
+ Subst = subst(b2s(Bin), Vars, []),
+ case file:write_file(Out, unicode:characters_to_binary(Subst)) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ {error, {file_write, Reason}}
+ end;
+ Error ->
+ Error
+ end.
+
+subst(String, Vars) ->
+ subst(String, Vars, []).
+
+subst([$@, $_|Rest], Vars, Result) ->
+ subst_var([$_|Rest], Vars, Result, []);
+subst([$@, C|Rest], Vars, Result) when $A =< C, C =< $Z ->
+ subst_var([C|Rest], Vars, Result, []);
+subst([$@, C|Rest], Vars, Result) when $a =< C, C =< $z ->
+ subst_var([C|Rest], Vars, Result, []);
+subst([C|Rest], Vars, Result) ->
+ subst(Rest, Vars, [C|Result]);
+subst([], _Vars, Result) ->
+ lists:reverse(Result).
+
+subst_var([$@|Rest], Vars, Result, VarAcc) ->
+ Key = list_to_atom(lists:reverse(VarAcc)),
+ {Result1,Rest1} = do_subst_var(Key, Rest, Vars, Result, VarAcc),
+ subst(Rest1, Vars, Result1);
+
+subst_var([C|Rest], Vars, Result, VarAcc) ->
+ subst_var(Rest, Vars, Result, [C|VarAcc]);
+subst_var([], Vars, Result, VarAcc) ->
+ subst([], Vars, [VarAcc++[$@|Result]]).
+
+%% handle conditional
+do_subst_var(Cond, Rest, Vars, Result, _VarAcc) when Cond == 'IFEQ' ;
+ Cond == 'IFNEQ' ->
+ {Bool,Comment,Rest1} = do_test(Rest, Vars, Cond),
+ Rest2 = extract_clause(Bool, Rest1),
+ {lists:reverse(Comment, Result),Rest2};
+%% variable substitution
+do_subst_var(Key, Rest, Vars, Result, VarAcc) ->
+ case lists:keysearch(Key, 1, Vars) of
+ {value, {Key, Value}} ->
+ {lists:reverse(Value, Result),Rest};
+ false ->
+ {[$@|VarAcc++[$@|Result]],Rest}
+ end.
+
+%% check arguments in "@IF[N]EQ@ (Arg1, Arg2)" for equality
+do_test(Rest, Vars, Test) ->
+ {Arg1,Rest1} = get_arg(Rest, Vars, $,, []),
+ {Arg2,Rest2} = get_arg(Rest1, Vars, 41, []), % $)
+ Result = case Arg1 of
+ Arg2 when Test == 'IFEQ' -> true;
+ Arg2 when Test == 'IFNEQ' -> false;
+ _ when Test == 'IFNEQ' -> true;
+ _ -> false
+ end,
+ Comment = io_lib:format("# Result of test: ~s (~s, ~s) -> ~w",
+ [atom_to_list(Test),Arg1,Arg2,Result]),
+ {Result,Comment,Rest2}.
+
+%% extract an argument
+get_arg([$(|Rest], Vars, Stop, _) ->
+ get_arg(Rest, Vars, Stop, []);
+get_arg([Stop|Rest], Vars, Stop, Acc) ->
+ Arg = string:strip(lists:reverse(Acc)),
+ Subst = subst(Arg, Vars),
+ {Subst,Rest};
+get_arg([C|Rest], Vars, Stop, Acc) ->
+ get_arg(Rest, Vars, Stop, [C|Acc]).
+
+%% keep only the true or false conditional clause
+extract_clause(true, Rest) ->
+ extract_clause(true, Rest, []);
+extract_clause(false, Rest) ->
+ Rest1 = discard_clause(Rest), % discard true clause
+ extract_clause(false, Rest1, []).
+
+%% true clause buffered, done
+extract_clause(true, [$@,$E,$L,$S,$E,$@|Rest], Acc) ->
+ Rest1 = discard_clause(Rest), % discard false clause
+ lists:reverse(Acc, Rest1);
+%% buffering of false clause starts now
+extract_clause(false, [$@,$E,$L,$S,$E,$@|Rest], _Acc) ->
+ extract_clause(false, Rest, []);
+%% true clause buffered, done
+extract_clause(true, [$@,$E,$N,$D,$I,$F,$@|Rest], Acc) ->
+ lists:reverse(Acc, Rest);
+%% false clause buffered, done
+extract_clause(false, [$@,$E,$N,$D,$I,$F,$@|Rest], Acc) ->
+ lists:reverse(Acc, Rest);
+%% keep buffering
+extract_clause(Bool, [C|Rest], Acc) ->
+ extract_clause(Bool, Rest, [C|Acc]);
+%% parse error
+extract_clause(_, [], Acc) ->
+ lists:reverse(Acc).
+
+discard_clause([$@,$E,$L,$S,$E,$@|Rest]) ->
+ Rest;
+discard_clause([$@,$E,$N,$D,$I,$F,$@|Rest]) ->
+ Rest;
+discard_clause([_C|Rest]) ->
+ discard_clause(Rest);
+discard_clause([]) -> % parse error
+ [].
+
+
+print_data(Port) ->
+ receive
+ {Port, {data, Bytes}} ->
+ io:put_chars(Bytes),
+ print_data(Port);
+ {Port, eof} ->
+ Port ! {self(), close},
+ receive
+ {Port, closed} ->
+ true
+ end,
+ receive
+ {'EXIT', Port, _} ->
+ ok
+ after 1 -> % force context switch
+ ok
+ end
+ end.
+
+maybe_atom_to_list(To_list) when is_list(To_list) ->
+ To_list;
+maybe_atom_to_list(To_list) when is_atom(To_list)->
+ atom_to_list(To_list).
+
+
+%% Configure and run all the Makefiles in the data dir of the suite
+%% in question
+make_non_erlang(DataDir, Variables) ->
+ %% Make the stuff in all_SUITE_data if it exists
+ AllDir = filename:join(DataDir,"../all_SUITE_data"),
+ case filelib:is_dir(AllDir) of
+ true ->
+ make_non_erlang_do(AllDir,Variables);
+ false ->
+ ok
+ end,
+ make_non_erlang_do(DataDir, Variables).
+
+make_non_erlang_do(DataDir, Variables) ->
+ try
+ MakeCommand = proplists:get_value(make_command,Variables),
+
+ FirstMakefile = filename:join(DataDir,"Makefile.first"),
+ case filelib:is_regular(FirstMakefile) of
+ true ->
+ io:format("Making ~p",[FirstMakefile]),
+ ok = ts_make:make(
+ MakeCommand, DataDir, filename:basename(FirstMakefile));
+ false ->
+ ok
+ end,
+
+ MakefileSrc = filename:join(DataDir,"Makefile.src"),
+ MakefileDest = filename:join(DataDir,"Makefile"),
+ case filelib:is_regular(MakefileSrc) of
+ true ->
+ ok = ts_lib:subst_file(MakefileSrc,MakefileDest,Variables),
+ io:format("Making ~p",[MakefileDest]),
+ ok = ts_make:make([{makefile,"Makefile"},{data_dir,DataDir}
+ | Variables]);
+ false ->
+ ok
+ end
+ after
+ timer:sleep(100) %% maybe unnecessary now when we don't do set_cwd anymore
+ end.
+
+b2s(Bin) ->
+ unicode:characters_to_list(Bin,default_encoding()).
+
+default_encoding() ->
+ try epp:default_encoding()
+ catch error:undef -> latin1
+ end.