aboutsummaryrefslogtreecommitdiffstats
path: root/erts/test/z_SUITE.erl
diff options
context:
space:
mode:
Diffstat (limited to 'erts/test/z_SUITE.erl')
-rw-r--r--erts/test/z_SUITE.erl315
1 files changed, 315 insertions, 0 deletions
diff --git a/erts/test/z_SUITE.erl b/erts/test/z_SUITE.erl
new file mode 100644
index 0000000000..0e37af1ca2
--- /dev/null
+++ b/erts/test/z_SUITE.erl
@@ -0,0 +1,315 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. 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/1, init_per_testcase/2, fin_per_testcase/2]).
+
+-export([search_for_core_files/1, core_files/1]).
+
+-include("test_server.hrl").
+
+
+init_per_testcase(Case, Config) ->
+ Dog = ?t:timetrap(?DEFAULT_TIMEOUT),
+ [{testcase, Case}, {watchdog, Dog} |Config].
+
+fin_per_testcase(_Case, Config) ->
+ Dog = ?config(watchdog, Config),
+ ?t:timetrap_cancel(Dog),
+ ok.
+
+all(doc) -> [];
+all(suite) ->
+ [core_files].
+
+
+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 regexp:match(FRes0, Core) of
+ {match, S, E} ->
+ L = length(FRes0),
+ 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;
+ _ -> FRes0
+ end,
+ case regexp:match(FRes, "[Tt][Ee][Xx][Tt]") of
+ nomatch ->
+ case regexp:match(FRes, "[Aa][Ss][Cc][Ii][Ii]") of
+ nomatch ->
+ probably_a_core;
+ _ ->
+ not_a_core
+ end;
+ _ ->
+ not_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 regexp:match(FRes, Core) 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);
+ 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.
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-11 22:18:11 +0000