path: root/lib/test_server/src/ts_lib.erl

%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights 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,
	 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.

specs(Dir) ->
    Specs = filelib:wildcard(filename:join([filename:dirname(Dir),
					    "*_test", "*.{dyn,}spec"])),
    % Filter away all spec which end with _bench.spec
    NoBench = fun(SpecName) ->
		      case lists:reverse(SpecName) of
			  "ceps.hcneb_"++_ -> false;
			  _ -> true
		      end
	      end,

    sort_tests([filename_to_atom(Name) || Name <- Specs, NoBench(Name)]).

suites(Dir, Spec) ->
    Glob=filename:join([filename:dirname(Dir), Spec++"_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(pman) -> 21;
suite_order(debugger) -> 22;
suite_order(toolbar) -> 23;
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_session) -> 42;
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, 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, Acc) ->		
    get_arg(Rest, Vars, Stop, Acc);
get_arg([$(|Rest], Vars, Stop, _) ->		
    get_arg(Rest, Vars, Stop, []); 
get_arg([Stop|Rest], Vars, Stop, Acc) ->
    Arg = 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.