diff options
Diffstat (limited to 'lib/test_server/src/ts_lib.erl')
| -rw-r--r-- | lib/test_server/src/ts_lib.erl | 372 |
1 files changed, 0 insertions, 372 deletions
diff --git a/lib/test_server/src/ts_lib.erl b/lib/test_server/src/ts_lib.erl deleted file mode 100644 index 7c3f450194..0000000000 --- a/lib/test_server/src/ts_lib.erl +++ /dev/null @@ -1,372 +0,0 @@ -%% -%% %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. |