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