1: %% 2: %% %CopyrightBegin% 3: %% 4: %% Copyright Ericsson AB 2008-2013. All Rights Reserved. 5: %% 6: %% The contents of this file are subject to the Erlang Public License, 7: %% Version 1.1, (the "License"); you may not use this file except in 8: %% compliance with the License. You should have received a copy of the 9: %% Erlang Public License along with this software. If not, it can be 10: %% retrieved online at http://www.erlang.org/. 11: %% 12: %% Software distributed under the License is distributed on an "AS IS" 13: %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 14: %% the License for the specific language governing rights and limitations 15: %% under the License. 16: %% 17: %% %CopyrightEnd% 18: %% 19: 20: -module(z_SUITE). 21: 22: %% 23: %% This suite expects to be run as the last suite of all suites. 24: %% 25: 26: %-define(line_trace, 1). 27: 28: -include_lib("kernel/include/file.hrl"). 29: 30: -record(core_search_conf, {search_dir, 31: extra_search_dir, 32: cerl, 33: file, 34: run_by_ts}). 35: 36: -define(DEFAULT_TIMEOUT, ?t:minutes(5)). 37: 38: -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 39: init_per_group/2,end_per_group/2, 40: init_per_testcase/2, end_per_testcase/2]). 41: 42: -export([search_for_core_files/1, core_files/1]). 43: 44: -include_lib("common_test/include/ct.hrl"). 45: 46: 47: init_per_testcase(Case, Config) -> 48: Dog = ?t:timetrap(?DEFAULT_TIMEOUT), 49: [{testcase, Case}, {watchdog, Dog} |Config]. 50: 51: end_per_testcase(_Case, Config) -> 52: Dog = ?config(watchdog, Config), 53: ?t:timetrap_cancel(Dog), 54: ok. 55: 56: suite() -> [{ct_hooks,[ts_install_cth]}]. 57: 58: all() -> 59: [core_files]. 60: 61: groups() -> 62: []. 63: 64: init_per_suite(Config) -> 65: Config. 66: 67: end_per_suite(_Config) -> 68: ok. 69: 70: init_per_group(_GroupName, Config) -> 71: Config. 72: 73: end_per_group(_GroupName, Config) -> 74: Config. 75: 76: 77: 78: core_files(doc) -> 79: []; 80: core_files(suite) -> 81: []; 82: core_files(Config) when is_list(Config) -> 83: case os:type() of 84: {win32, _} -> 85: {skipped, "No idea searching for core-files on windows"}; 86: {unix, darwin} -> 87: core_file_search( 88: core_search_conf(true, 89: os:getenv("OTP_DAILY_BUILD_TOP_DIR"), 90: "/cores")); 91: _ -> 92: core_file_search( 93: core_search_conf(true, 94: os:getenv("OTP_DAILY_BUILD_TOP_DIR"))) 95: end. 96: 97: search_for_core_files(Dir) -> 98: case os:type() of 99: {win32, _} -> 100: io:format("No idea searching for core-files on windows"); 101: {unix, darwin} -> 102: core_file_search(core_search_conf(false, Dir, "/cores")); 103: _ -> 104: core_file_search(core_search_conf(false, Dir)) 105: end. 106: 107: find_cerl(false) -> 108: case os:getenv("ERL_TOP") of 109: false -> false; 110: ETop -> 111: Cerl = filename:join([ETop, "bin", "cerl"]), 112: case filelib:is_regular(Cerl) of 113: true -> Cerl; 114: _ -> false 115: end 116: end; 117: find_cerl(DBTop) -> 118: case catch filelib:wildcard(filename:join([DBTop, 119: "otp_src_R*", 120: "bin", 121: "cerl"])) of 122: [Cerl | _ ] -> 123: case filelib:is_regular(Cerl) of 124: true -> Cerl; 125: _ -> false 126: end; 127: _ -> 128: false 129: end. 130: 131: is_dir(false) -> 132: false; 133: is_dir(Dir) -> 134: filelib:is_dir(Dir). 135: 136: core_search_conf(RunByTS, DBTop) -> 137: core_search_conf(RunByTS, DBTop, false). 138: 139: core_search_conf(RunByTS, DBTop, XDir) -> 140: SearchDir = case is_dir(DBTop) of 141: false -> 142: case code:which(test_server) of 143: non_existing -> 144: {ok, CWD} = file:get_cwd(), 145: CWD; 146: TS -> 147: filename:dirname(filename:dirname(TS)) 148: end; 149: true -> 150: DBTop 151: end, 152: XSearchDir = case is_dir(XDir) of 153: false -> 154: false; 155: true -> 156: case SearchDir == XDir of 157: true -> false; 158: _ -> XDir 159: end 160: end, 161: #core_search_conf{search_dir = SearchDir, 162: extra_search_dir = XSearchDir, 163: cerl = find_cerl(DBTop), 164: file = os:find_executable("file"), 165: run_by_ts = RunByTS}. 166: 167: file_inspect(#core_search_conf{file = File}, Core) -> 168: FRes0 = os:cmd(File ++ " " ++ Core), 169: FRes = case string:str(FRes0, Core) of 170: 0 -> 171: FRes0; 172: S -> 173: L = length(FRes0), 174: E = length(Core), 175: case S of 176: 1 -> 177: lists:sublist(FRes0, E+1, L+1); 178: _ -> 179: lists:sublist(FRes0, 1, S-1) 180: ++ 181: " " 182: ++ 183: lists:sublist(FRes0, E+1, L+1) 184: end 185: end, 186: case re:run(FRes, "text|ascii", [caseless,{capture,none}]) of 187: match -> 188: not_a_core; 189: nomatch -> 190: probably_a_core 191: end. 192: 193: mk_readable(F) -> 194: try 195: {ok, Old} = file:read_file_info(F), 196: file:write_file_info(F, Old#file_info{mode = 8#00444}) 197: catch 198: _:_ -> io:format("Failed to \"chmod\" core file ~p\n", [F]) 199: end. 200: 201: ignore_core(C) -> 202: filelib:is_regular(filename:join([filename:dirname(C), 203: "ignore_core_files"])). 204: 205: core_cand(#core_search_conf{file = false}, C, Cs) -> 206: %% Guess that it is a core file; make it readable by anyone and save it 207: mk_readable(C), 208: [C|Cs]; 209: core_cand(Conf, C, Cs) -> 210: case file_inspect(Conf, C) of 211: not_a_core -> Cs; 212: _ -> 213: %% Probably a core file; make it readable by anyone and save it 214: mk_readable(C), 215: case ignore_core(C) of 216: true -> [{ignore, C}|Cs]; 217: _ -> [C|Cs] 218: end 219: end. 220: 221: time_fstr() -> 222: "(~w-~.2.0w-~.2.0w ~w.~.2.0w:~.2.0w)". 223: mod_time_list(F) -> 224: case catch filelib:last_modified(F) of 225: {{Y,Mo,D},{H,Mi,S}} -> 226: [Y,Mo,D,H,Mi,S]; 227: _ -> 228: [0,0,0,0,0,0] 229: end. 230: 231: str_strip(S) -> 232: string:strip(string:strip(string:strip(S), both, $\n), both, $\r). 233: 234: dump_core(#core_search_conf{ cerl = false }, _) -> 235: ok; 236: dump_core(_, {ignore, _Core}) -> 237: ok; 238: dump_core(#core_search_conf{ cerl = Cerl }, Core) -> 239: Dump = case test_server:is_debug() of 240: true -> 241: os:cmd(Cerl ++ " -debug -dump " ++ Core); 242: _ -> 243: os:cmd(Cerl ++ " -dump " ++ Core) 244: end, 245: ct:log("~s~n~n~s",[Core,Dump]). 246: 247: 248: format_core(Conf, {ignore, Core}) -> 249: format_core(Conf, Core, "[ignored] "); 250: format_core(Conf, Core) -> 251: format_core(Conf, Core, ""). 252: 253: format_core(#core_search_conf{file = false}, Core, Ignore) -> 254: io:format(" ~s~s " ++ time_fstr() ++ "~s~n", 255: [Ignore, Core] ++ mod_time_list(Core)); 256: format_core(#core_search_conf{file = File}, Core, Ignore) -> 257: FRes = str_strip(os:cmd(File ++ " " ++ Core)), 258: case catch re:run(FRes, Core, [caseless,{capture,none}]) of 259: match -> 260: io:format(" ~s~s " ++ time_fstr() ++ "~n", 261: [Ignore, FRes] ++ mod_time_list(Core)); 262: _ -> 263: io:format(" ~s~s: ~s " ++ time_fstr() ++ "~n", 264: [Ignore, Core, FRes] ++ mod_time_list(Core)) 265: end. 266: 267: core_file_search(#core_search_conf{search_dir = Base, 268: extra_search_dir = XBase, 269: cerl = Cerl, 270: run_by_ts = RunByTS} = Conf) -> 271: case {Cerl,test_server:is_debug()} of 272: {false,_} -> ok; 273: {_,true} -> 274: catch io:format("A cerl script that probably can be used for " 275: "inspection of emulator cores:~n ~s -debug~n", 276: [Cerl]); 277: _ -> 278: catch io:format("A cerl script that probably can be used for " 279: "inspection of emulator cores:~n ~s~n", 280: [Cerl]) 281: end, 282: io:format("Searching for core-files in: ~s~s~n", 283: [case XBase of 284: false -> ""; 285: _ -> XBase ++ " and " 286: end, 287: Base]), 288: Filter = fun (Core, Cores) -> 289: case filelib:is_regular(Core) of 290: true -> 291: case filename:basename(Core) of 292: "core" -> 293: core_cand(Conf, Core, Cores); 294: "core." ++ _ -> 295: core_cand(Conf, Core, Cores); 296: Bin when is_binary(Bin) -> %Icky filename; ignore 297: Cores; 298: BName -> 299: case lists:suffix(".core", BName) of 300: true -> core_cand(Conf, Core, Cores); 301: _ -> Cores 302: end 303: end; 304: _ -> 305: Cores 306: end 307: end, 308: case case XBase of 309: false -> []; 310: _ -> filelib:fold_files(XBase, "core", true, Filter, []) 311: end ++ filelib:fold_files(Base, "core", true, Filter, []) of 312: [] -> 313: io:format("No core-files found.~n", []), 314: ok; 315: Cores -> 316: io:format("Found core files:~n",[]), 317: lists:foreach(fun (C) -> format_core(Conf, C) end, Cores), 318: {ICores, FCores} = lists:foldl(fun ({ignore, IC}, {ICs, FCs}) -> 319: {[" "++IC|ICs], FCs}; 320: (FC, {ICs, FCs}) -> 321: {ICs, [" "++FC|FCs]} 322: end, 323: {[],[]}, 324: Cores), 325: ICoresComment = 326: "Core-files marked with [ignored] were found in directories~n" 327: "containing an ignore_core_files file, i.e., the testcase~n" 328: "writer has decided that core-files dumped there should be~n" 329: "ignored. This testcase won't fail on ignored core-files~n" 330: "found.~n", 331: Res = lists:flatten([case FCores of 332: [] -> 333: []; 334: _ -> 335: ["Core-files found:", 336: lists:reverse(FCores)] 337: end, 338: case {FCores, ICores} of 339: {[], []} -> []; 340: {_, []} -> []; 341: {[], _} -> []; 342: _ -> " " 343: end, 344: case ICores of 345: [] -> []; 346: _ -> 347: io:format(ICoresComment, []), 348: ["Ignored core-files found:", 349: lists:reverse(ICores)] 350: end]), 351: 352: lists:foreach(fun(C) -> dump_core(Conf,C) end, Cores), 353: case {RunByTS, ICores, FCores} of 354: {true, [], []} -> ok; 355: {true, _, []} -> {comment, Res}; 356: {true, _, _} -> ?t:fail(Res); 357: _ -> Res 358: end 359: end.