Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

334 lines (297 sloc) 8.38 kb
%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2008-2012. 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(z_SUITE).
%%
%% This suite expects to be run as the last suite of all suites.
%%
%-define(line_trace, 1).
-include_lib("kernel/include/file.hrl").
-record(core_search_conf, {search_dir,
extra_search_dir,
cerl,
file,
run_by_ts}).
-define(DEFAULT_TIMEOUT, ?t:minutes(5)).
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
init_per_testcase/2, end_per_testcase/2]).
-export([search_for_core_files/1, core_files/1]).
-include_lib("common_test/include/ct.hrl").
init_per_testcase(Case, Config) ->
Dog = ?t:timetrap(?DEFAULT_TIMEOUT),
[{testcase, Case}, {watchdog, Dog} |Config].
end_per_testcase(_Case, Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[core_files].
groups() ->
[].
init_per_suite(Config) ->
Config.
end_per_suite(_Config) ->
ok.
init_per_group(_GroupName, Config) ->
Config.
end_per_group(_GroupName, Config) ->
Config.
core_files(doc) ->
[];
core_files(suite) ->
[];
core_files(Config) when is_list(Config) ->
case os:type() of
{win32, _} ->
{skipped, "No idea searching for core-files on windows"};
{unix, darwin} ->
core_file_search(
core_search_conf(true,
os:getenv("OTP_DAILY_BUILD_TOP_DIR"),
"/cores"));
_ ->
core_file_search(
core_search_conf(true,
os:getenv("OTP_DAILY_BUILD_TOP_DIR")))
end.
search_for_core_files(Dir) ->
case os:type() of
{win32, _} ->
io:format("No idea searching for core-files on windows");
{unix, darwin} ->
core_file_search(core_search_conf(false, Dir, "/cores"));
_ ->
core_file_search(core_search_conf(false, Dir))
end.
find_cerl(false) ->
case os:getenv("ERL_TOP") of
false -> false;
ETop ->
Cerl = filename:join([ETop, "bin", "cerl"]),
case filelib:is_regular(Cerl) of
true -> Cerl;
_ -> false
end
end;
find_cerl(DBTop) ->
case catch filelib:wildcard(filename:join([DBTop,
"otp_src_R*",
"bin",
"cerl"])) of
[Cerl | _ ] ->
case filelib:is_regular(Cerl) of
true -> Cerl;
_ -> false
end;
_ ->
false
end.
is_dir(false) ->
false;
is_dir(Dir) ->
filelib:is_dir(Dir).
core_search_conf(RunByTS, DBTop) ->
core_search_conf(RunByTS, DBTop, false).
core_search_conf(RunByTS, DBTop, XDir) ->
SearchDir = case is_dir(DBTop) of
false ->
case code:which(test_server) of
non_existing ->
{ok, CWD} = file:get_cwd(),
CWD;
TS ->
filename:dirname(filename:dirname(TS))
end;
true ->
DBTop
end,
XSearchDir = case is_dir(XDir) of
false ->
false;
true ->
case SearchDir == XDir of
true -> false;
_ -> XDir
end
end,
#core_search_conf{search_dir = SearchDir,
extra_search_dir = XSearchDir,
cerl = find_cerl(DBTop),
file = os:find_executable("file"),
run_by_ts = RunByTS}.
file_inspect(#core_search_conf{file = File}, Core) ->
FRes0 = os:cmd(File ++ " " ++ Core),
FRes = case string:str(FRes0, Core) of
0 ->
FRes0;
S ->
L = length(FRes0),
E = length(Core),
case S of
1 ->
lists:sublist(FRes0, E+1, L+1);
_ ->
lists:sublist(FRes0, 1, S-1)
++
" "
++
lists:sublist(FRes0, E+1, L+1)
end
end,
case re:run(FRes, "text|ascii", [caseless,{capture,none}]) of
match ->
not_a_core;
nomatch ->
probably_a_core
end.
mk_readable(F) ->
catch file:write_file_info(F, #file_info{mode = 8#00444}).
ignore_core(C) ->
filelib:is_regular(filename:join([filename:dirname(C),
"ignore_core_files"])).
core_cand(#core_search_conf{file = false}, C, Cs) ->
%% Guess that it is a core file; make it readable by anyone and save it
mk_readable(C),
[C|Cs];
core_cand(Conf, C, Cs) ->
case file_inspect(Conf, C) of
not_a_core -> Cs;
_ ->
%% Probably a core file; make it readable by anyone and save it
mk_readable(C),
case ignore_core(C) of
true -> [{ignore, C}|Cs];
_ -> [C|Cs]
end
end.
time_fstr() ->
"(~w-~.2.0w-~.2.0w ~w.~.2.0w:~.2.0w)".
mod_time_list(F) ->
case catch filelib:last_modified(F) of
{{Y,Mo,D},{H,Mi,S}} ->
[Y,Mo,D,H,Mi,S];
_ ->
[0,0,0,0,0,0]
end.
str_strip(S) ->
string:strip(string:strip(string:strip(S), both, $\n), both, $\r).
format_core(Conf, {ignore, Core}) ->
format_core(Conf, Core, "[ignored] ");
format_core(Conf, Core) ->
format_core(Conf, Core, "").
format_core(#core_search_conf{file = false}, Core, Ignore) ->
io:format(" ~s~s " ++ time_fstr() ++ "~s~n",
[Ignore, Core] ++ mod_time_list(Core));
format_core(#core_search_conf{file = File}, Core, Ignore) ->
FRes = str_strip(os:cmd(File ++ " " ++ Core)),
case catch re:run(FRes, Core, [caseless,{capture,none}]) of
match ->
io:format(" ~s~s " ++ time_fstr() ++ "~n",
[Ignore, FRes] ++ mod_time_list(Core));
_ ->
io:format(" ~s~s: ~s " ++ time_fstr() ++ "~n",
[Ignore, Core, FRes] ++ mod_time_list(Core))
end.
core_file_search(#core_search_conf{search_dir = Base,
extra_search_dir = XBase,
cerl = Cerl,
run_by_ts = RunByTS} = Conf) ->
case Cerl of
false -> ok;
_ -> catch io:format("A cerl script that probably can be used for "
"inspection of emulator cores:~n ~s~n",
[Cerl])
end,
io:format("Searching for core-files in: ~s~s~n",
[case XBase of
false -> "";
_ -> XBase ++ " and "
end,
Base]),
Filter = fun (Core, Cores) ->
case filelib:is_regular(Core) of
true ->
case filename:basename(Core) of
"core" ->
core_cand(Conf, Core, Cores);
"core." ++ _ ->
core_cand(Conf, Core, Cores);
Bin when is_binary(Bin) -> %Icky filename; ignore
Cores;
BName ->
case lists:suffix(".core", BName) of
true -> core_cand(Conf, Core, Cores);
_ -> Cores
end
end;
_ ->
Cores
end
end,
case case XBase of
false -> [];
_ -> filelib:fold_files(XBase, "core", true, Filter, [])
end ++ filelib:fold_files(Base, "core", true, Filter, []) of
[] ->
io:format("No core-files found.~n", []),
ok;
Cores ->
io:format("Found core files:~n",[]),
lists:foreach(fun (C) -> format_core(Conf, C) end, Cores),
{ICores, FCores} = lists:foldl(fun ({ignore, IC}, {ICs, FCs}) ->
{[" "++IC|ICs], FCs};
(FC, {ICs, FCs}) ->
{ICs, [" "++FC|FCs]}
end,
{[],[]},
Cores),
ICoresComment =
"Core-files marked with [ignored] were found in directories~n"
"containing an ignore_core_files file, i.e., the testcase~n"
"writer has decided that core-files dumped there should be~n"
"ignored. This testcase won't fail on ignored core-files~n"
"found.~n",
Res = lists:flatten([case FCores of
[] ->
[];
_ ->
["Core-files found:",
lists:reverse(FCores)]
end,
case {FCores, ICores} of
{[], []} -> [];
{_, []} -> [];
{[], _} -> [];
_ -> " "
end,
case ICores of
[] -> [];
_ ->
io:format(ICoresComment, []),
["Ignored core-files found:",
lists:reverse(ICores)]
end]),
case {RunByTS, ICores, FCores} of
{true, [], []} -> ok;
{true, _, []} -> {comment, Res};
{true, _, _} -> ?t:fail(Res);
_ -> Res
end
end.
Jump to Line
Something went wrong with that request. Please try again.