diff options
42 files changed, 1353 insertions, 484 deletions
diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index 63a8adbc63..3c6e68101d 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -146,7 +146,8 @@ run(TestDirs) -> %%% {silent_connections,Conns} | {stylesheet,CSSFile} | %%% {cover,CoverSpecFile} | {step,StepOpts} | %%% {event_handler,EventHandlers} | {include,InclDirs} | -%%% {auto_compile,Bool} | {multiply_timetraps,M} | {scale_timetraps,Bool} | +%%% {auto_compile,Bool} | {create_priv_dir,CreatePrivDir} | +%%% {multiply_timetraps,M} | {scale_timetraps,Bool} | %%% {repeat,N} | {duration,DurTime} | {until,StopTime} | %%% {force_stop,Bool} | {decrypt,DecryptKeyOrFile} | %%% {refresh_logs,LogDir} | {logopts,LogOpts} | {basic_html,Bool} | @@ -171,6 +172,7 @@ run(TestDirs) -> %%% EH = atom() | {atom(),InitArgs} | {[atom()],InitArgs} %%% InitArgs = [term()] %%% InclDirs = [string()] | string() +%%% CreatePrivDir = auto_per_run | auto_per_tc | manual_per_tc %%% M = integer() %%% N = integer() %%% DurTime = string(HHMMSS) @@ -993,13 +995,21 @@ remove_config(Callback, Config) -> %%%----------------------------------------------------------------- %%% @spec timetrap(Time) -> ok -%%% Time = {hours,Hours} | {minutes,Mins} | {seconds,Secs} | Millisecs | infinity +%%% Time = {hours,Hours} | {minutes,Mins} | {seconds,Secs} | Millisecs | infinity | Func %%% Hours = integer() %%% Mins = integer() %%% Secs = integer() %%% Millisecs = integer() | float() -%%% -%%% @doc <p>Use this function to set a new timetrap for the running test case.</p> +%%% Func = {M,F,A} | fun() +%%% M = atom() +%%% F = atom() +%%% A = list() +%%% +%%% @doc <p>Use this function to set a new timetrap for the running test case. +%%% If the argument is <code>Func</code>, the timetrap will be triggered +%%% when this function returns. <code>Func</code> may also return a new +%%% <code>Time</code> value, which in that case will be the value for the +%%% new timetrap.</p> timetrap(Time) -> test_server:timetrap_cancel(), test_server:timetrap(Time). diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 187794e78b..e4fbf95fdd 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -212,23 +212,16 @@ init_tc2(Mod,Suite,Func,SuiteInfo,MergeResult,Config) -> {auto_skip,{require_failed,Reason}}; {'EXIT',Reason} -> {auto_skip,Reason}; - {ok,FinalConfig} -> - case MergeResult of - {error,Reason} -> - %% suite0 configure finished now, report that - %% first test case actually failed - {skip,Reason}; - _ -> - case get('$test_server_framework_test') of - undefined -> - ct_suite_init(Suite, FuncSpec, FinalConfig); - Fun -> - case Fun(init_tc, FinalConfig) of - NewConfig when is_list(NewConfig) -> - {ok,NewConfig}; - Else -> - Else - end + {ok,Config1} -> + case get('$test_server_framework_test') of + undefined -> + ct_suite_init(Suite, FuncSpec, Config1); + Fun -> + case Fun(init_tc, Config1) of + NewConfig when is_list(NewConfig) -> + {ok,NewConfig}; + Else -> + Else end end end. @@ -346,16 +339,12 @@ get_suite_name(Mod, _) -> Mod. %% Check that alias names are not already in use -check_for_clashes(TCInfo, GrPathInfo, SuiteInfo) -> - {CurrGrInfo,SearchIn} = case GrPathInfo of - [] -> {[],[SuiteInfo]}; - [Curr|Path] -> {Curr,[SuiteInfo|Path]} - end, +check_for_clashes(TCInfo, [CurrGrInfo|Path], SuiteInfo) -> ReqNames = fun(Info) -> [element(2,R) || R <- Info, size(R) == 3, require == element(1,R)] end, - ExistingNames = lists:flatten([ReqNames(L) || L <- SearchIn]), + ExistingNames = lists:flatten([ReqNames(L) || L <- [SuiteInfo|Path]]), CurrGrReqNs = ReqNames(CurrGrInfo), GrClashes = [Name || Name <- CurrGrReqNs, true == lists:member(Name, ExistingNames)], diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 0cd9b5f7cb..012f947fdd 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -36,6 +36,7 @@ -export([make_last_run_index/0]). -export([make_all_suites_index/1,make_all_runs_index/1]). -export([get_ts_html_wrapper/3]). +-export([xhtml/2, locate_default_css_file/0, make_relative/1]). %% Logging stuff directly from testcase -export([tc_log/3,tc_log/4,tc_log_async/3,tc_print/3,tc_pal/3,ct_log/3, @@ -1246,18 +1247,18 @@ header1(Title, SubTitle) -> ["<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"\n", "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n", "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">\n"]), - "<!-- autogenerated by '"++atom_to_list(?MODULE)++"' -->\n", - "<head>\n", - "<title>" ++ Title ++ " " ++ SubTitle ++ "</title>\n", - "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n", - xhtml("", - ["<link rel=\"stylesheet\" href=\"",CSSFile,"\" type=\"text/css\">"]), - "</head>\n", - body_tag(), - "<center>\n", - "<h1>" ++ Title ++ "</h1>\n", - "</center>\n", - SubTitleHTML,"\n"]. + "<!-- autogenerated by '"++atom_to_list(?MODULE)++"' -->\n", + "<head>\n", + "<title>" ++ Title ++ " " ++ SubTitle ++ "</title>\n", + "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n", + xhtml("", + ["<link rel=\"stylesheet\" href=\"",CSSFile,"\" type=\"text/css\">"]), + "</head>\n", + body_tag(), + "<center>\n", + "<h1>" ++ Title ++ "</h1>\n", + "</center>\n", + SubTitleHTML,"\n"]. index_footer() -> ["</table>\n" diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index 2ea2ba106a..0d32bb0072 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -25,6 +25,7 @@ -export([run/1,run/3,run/4]). -export([run_on_node/2,run_on_node/3]). -export([run_test/1,run_test/2]). +-export([basic_html/1]). -export([abort/0,abort/1,progress/0]). @@ -277,7 +278,17 @@ abort(Node) when is_atom(Node) -> progress() -> call(progress). - +%%%----------------------------------------------------------------- +%%% @spec basic_html(Bool) -> ok +%%% Bool = true | false +%%% +%%% @doc If set to true, the ct_master logs will be written on a +%%% primitive html format, not using the Common Test CSS style +%%% sheet. +basic_html(Bool) -> + application:set_env(common_test_master, basic_html, Bool), + ok. + %%%----------------------------------------------------------------- %%% MASTER, runs on central controlling node. %%%----------------------------------------------------------------- diff --git a/lib/common_test/src/ct_master_logs.erl b/lib/common_test/src/ct_master_logs.erl index 244faace06..8fd346670f 100644 --- a/lib/common_test/src/ct_master_logs.erl +++ b/lib/common_test/src/ct_master_logs.erl @@ -23,7 +23,8 @@ %%% node.</p> -module(ct_master_logs). --export([start/2, make_all_runs_index/0, log/3, nodedir/2, stop/0]). +-export([start/2, make_all_runs_index/0, log/3, nodedir/2, + stop/0]). -record(state, {log_fd, start_time, logdir, rundir, nodedir_ix_fd, nodes, nodedirs=[]}). @@ -32,6 +33,7 @@ -define(all_runs_name, "master_runs.html"). -define(nodedir_index_name, "index.html"). -define(details_file_name,"details.info"). +-define(css_default, "ct_default.css"). -define(table_color,"lightblue"). %%%-------------------------------------------------------------------- @@ -87,6 +89,40 @@ init(Parent,LogDir,Nodes) -> RunDirAbs = filename:join(LogDir,RunDir), file:make_dir(RunDirAbs), write_details_file(RunDirAbs,{node(),Nodes}), + + case basic_html() of + true -> + put(basic_html, true); + BasicHtml -> + put(basic_html, BasicHtml), + %% copy stylesheet to log dir (both top dir and test run + %% dir) so logs are independent of Common Test installation + CTPath = code:lib_dir(common_test), + CSSFileSrc = filename:join(filename:join(CTPath, "priv"), + ?css_default), + CSSFileDestTop = filename:join(LogDir, ?css_default), + CSSFileDestRun = filename:join(RunDirAbs, ?css_default), + case file:copy(CSSFileSrc, CSSFileDestTop) of + {error,Reason0} -> + io:format(user, "ERROR! "++ + "CSS file ~p could not be copied to ~p. "++ + "Reason: ~p~n", + [CSSFileSrc,CSSFileDestTop,Reason0]), + exit({css_file_error,CSSFileDestTop}); + _ -> + case file:copy(CSSFileSrc, CSSFileDestRun) of + {error,Reason1} -> + io:format(user, "ERROR! "++ + "CSS file ~p could not be copied to ~p. "++ + "Reason: ~p~n", + [CSSFileSrc,CSSFileDestRun,Reason1]), + exit({css_file_error,CSSFileDestRun}); + _ -> + ok + end + end + end, + make_all_runs_index(LogDir), CtLogFd = open_ct_master_log(RunDirAbs), NodeStr = @@ -164,8 +200,9 @@ open_ct_master_log(Dir) -> "</style>\n", []), io:format(Fd, - "<br><h2>Progress Log</h2>\n" - "<pre>\n",[]), + xhtml("<br><h2>Progress Log</h2>\n<pre>\n", + "<br /><h2>Progress Log</h2>\n<pre>\n"), + []), Fd. close_ct_master_log(Fd) -> @@ -178,18 +215,10 @@ config_table(Vars) -> config_table_header() -> ["<h2>Configuration</h2>\n", - "<table border=\"3\" cellpadding=\"5\" bgcolor=\"",?table_color, - "\"\n", + xhtml(["<table border=\"3\" cellpadding=\"5\" " + "bgcolor=\"",?table_color,"\"\n"], "<table>\n"), "<tr><th>Key</th><th>Value</th></tr>\n"]. -%% -%% keep for possible later use -%% -%%config_table1([{Key,Value}|Vars]) -> -%% ["<tr><td>", atom_to_list(Key), "</td>\n", -%% "<td><pre>",io_lib:format("~p",[Value]),"</pre></td></tr>\n" | -%% config_table1(Vars)]; - config_table1([]) -> ["</table>\n"]. @@ -210,10 +239,10 @@ open_nodedir_index(Dir,StartTime) -> print_nodedir(Node,RunDir,Fd) -> Index = filename:join(RunDir,"index.html"), io:format(Fd, - ["<TR>\n" - "<TD ALIGN=center>",atom_to_list(Node),"</TD>\n", - "<TD ALIGN=left><A HREF=\"",Index,"\">",Index,"</A></TD>\n", - "</TR>\n"],[]), + ["<tr>\n" + "<td align=center>",atom_to_list(Node),"</td>\n", + "<td align=left><a href=\"",Index,"\">",Index,"</a></td>\n", + "</tr>\n"],[]), ok. close_nodedir_index(Fd) -> @@ -222,12 +251,12 @@ close_nodedir_index(Fd) -> nodedir_index_header(StartTime) -> [header("Log Files " ++ format_time(StartTime)) | - ["<CENTER>\n", - "<P><A HREF=\"",?ct_master_log_name,"\">Common Test Master Log</A></P>", - "<TABLE border=\"3\" cellpadding=\"5\" ", - "BGCOLOR=\"",?table_color,"\">\n", - "<th><B>Node</B></th>\n", - "<th><B>Log</B></th>\n", + ["<center>\n", + "<p><a href=\"",?ct_master_log_name,"\">Common Test Master Log</a></p>", + xhtml(["<table border=\"3\" cellpadding=\"5\" " + "bgcolor=\"",?table_color,"\">\n"], "<table>\n"), + "<th><b>Node</b></th>\n", + "<th><b>Log</b></th>\n", "\n"]]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -279,20 +308,20 @@ runentry(Dir) -> {"unknown",""} end, Index = filename:join(Dir,?nodedir_index_name), - ["<TR>\n" - "<TD ALIGN=center><A HREF=\"",Index,"\">",timestamp(Dir),"</A></TD>\n", - "<TD ALIGN=center>",MasterStr,"</TD>\n", - "<TD ALIGN=center>",NodesStr,"</TD>\n", - "</TR>\n"]. + ["<tr>\n" + "<td align=center><a href=\"",Index,"\">",timestamp(Dir),"</a></td>\n", + "<td align=center>",MasterStr,"</td>\n", + "<td align=center>",NodesStr,"</td>\n", + "</tr>\n"]. all_runs_header() -> [header("Master Test Runs") | - ["<CENTER>\n", - "<TABLE border=\"3\" cellpadding=\"5\" " - "BGCOLOR=\"",?table_color,"\">\n" - "<th><B>History</B></th>\n" - "<th><B>Master Host</B></th>\n" - "<th><B>Test Nodes</B></th>\n" + ["<center>\n", + xhtml(["<table border=\"3\" cellpadding=\"5\" " + "bgcolor=\"",?table_color,"\">\n"], "<table>\n"), + "<th><b>History</b></th>\n" + "<th><b>Master Host</b></th>\n" + "<th><b>Test Nodes</b></th>\n" "\n"]]. timestamp(Dir) -> @@ -318,44 +347,46 @@ read_details_file(Dir) -> %%%-------------------------------------------------------------------- header(Title) -> - ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" - "<!-- autogenerated by '"++atom_to_list(?MODULE)++"'. -->\n" - "<HTML>\n", - "<HEAD>\n", - - "<TITLE>" ++ Title ++ "</TITLE>\n", - "<META HTTP-EQUIV=\"CACHE-CONTROL\" CONTENT=\"NO-CACHE\">\n", - - "</HEAD>\n", - + CSSFile = xhtml(fun() -> "" end, + fun() -> make_relative(locate_default_css_file()) end), + [xhtml(["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n", + "<html>\n"], + ["<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"\n", + "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n", + "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">\n"]), + "<!-- autogenerated by '"++atom_to_list(?MODULE)++"' -->\n", + "<head>\n", + "<title>" ++ Title ++ "</title>\n", + "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n", + xhtml("", + ["<link rel=\"stylesheet\" href=\"",CSSFile,"\" type=\"text/css\">"]), + "</head>\n", body_tag(), - - "<!-- ---- DOCUMENT TITLE ---- -->\n", - - "<CENTER>\n", - "<H1>" ++ Title ++ "</H1>\n", - "</CENTER>\n", - - "<!-- ---- CONTENT ---- -->\n"]. + "<center>\n", + "<h1>" ++ Title ++ "</h1>\n", + "</center>\n"]. index_footer() -> - ["</TABLE>\n" - "</CENTER>\n" | footer()]. + ["</table>\n" + "</center>\n" | footer()]. footer() -> - ["<P><CENTER>\n" - "<HR>\n" - "<P><FONT SIZE=-1>\n" + ["<center>\n", + xhtml("<br><hr>\n", "<br />\n"), + xhtml("<p><font size=\"-1\">\n", "<div class=\"copyright\">"), "Copyright © ", year(), - " <A HREF=\"http://erlang.ericsson.se\">Open Telecom Platform</A><BR>\n" - "Updated: <!date>", current_time(), "<!/date><BR>\n" - "</FONT>\n" - "</CENTER>\n" + " <a href=\"http://www.erlang.org\">Open Telecom Platform</a>", + xhtml("<br>\n", "<br />\n"), + "Updated: <!date>", current_time(), "<!/date>", + xhtml("<br>\n", "<br />\n"), + xhtml("</font></p>\n", "</div>\n"), + "</center>\n" "</body>\n"]. body_tag() -> - "<body bgcolor=\"#FFFFFF\" text=\"#000000\" link=\"#0000FF\"" - "vlink=\"#800080\" alink=\"#FF0000\">\n". + xhtml("<body bgcolor=\"#FFFFFF\" text=\"#000000\" link=\"#0000FF\" " + "vlink=\"#800080\" alink=\"#FF0000\">\n", + "<body>\n"). current_time() -> format_time(calendar:local_time()). @@ -404,6 +435,23 @@ log_timestamp(Now) -> lists:flatten(io_lib:format("~2.2.0w:~2.2.0w:~2.2.0w", [H,M,S])). +basic_html() -> + case application:get_env(common_test_master, basic_html) of + {ok,true} -> + true; + _ -> + false + end. + +xhtml(HTML, XHTML) -> + ct_logs:xhtml(HTML, XHTML). + +locate_default_css_file() -> + ct_logs:locate_default_css_file(). + +make_relative(Dir) -> + ct_logs:make_relative(Dir). + force_write_file(Name,Contents) -> force_delete(Name), file:write_file(Name,Contents). @@ -452,3 +500,4 @@ cast(Msg) -> _Pid -> ?MODULE ! Msg end. + diff --git a/lib/common_test/test/ct_error_SUITE.erl b/lib/common_test/test/ct_error_SUITE.erl index 79ed51bc28..8c56d9ffde 100644 --- a/lib/common_test/test/ct_error_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE.erl @@ -848,77 +848,124 @@ test_events(timetrap_parallel) -> test_events(timetrap_fun) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,start_info,{4,4,17}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{4,4,24}}, + {?eh,tc_start,{timetrap_4_SUITE,init_per_suite}}, {?eh,tc_done,{timetrap_4_SUITE,init_per_suite,ok}}, {?eh,tc_start,{timetrap_4_SUITE,tc0}}, - {?eh,tc_done, - {timetrap_4_SUITE,tc0,{failed,{timetrap_timeout,1000}}}}, + {?eh,tc_done,{timetrap_4_SUITE,tc0, + {failed,{timetrap_timeout,{'$approx',1000}}}}}, + {?eh,test_stats,{0,1,{0,0}}}, {?eh,tc_start,{timetrap_4_SUITE,tc1}}, - {?eh,tc_done, - {timetrap_4_SUITE,tc1,{failed,{timetrap_timeout,2000}}}}, + {?eh,tc_done,{timetrap_4_SUITE,tc1, + {failed,{timetrap_timeout,{'$approx',2000}}}}}, + {?eh,test_stats,{0,2,{0,0}}}, {?eh,tc_start,{timetrap_4_SUITE,tc2}}, - {?eh,tc_done, - {timetrap_4_SUITE,tc2,{failed,{timetrap_timeout,500}}}}, + {?eh,tc_done,{timetrap_4_SUITE,tc2, + {failed,{timetrap_timeout,{'$approx',500}}}}}, + {?eh,test_stats,{0,3,{0,0}}}, {?eh,tc_start,{timetrap_4_SUITE,tc3}}, - {?eh,tc_done, - {timetrap_4_SUITE,tc3,{failed,{timetrap_timeout,1000}}}}, + {?eh,tc_done,{timetrap_4_SUITE,tc3, + {failed,{timetrap_timeout,{'$approx',1000}}}}}, {?eh,test_stats,{0,4,{0,0}}}, + {?eh,tc_start,{timetrap_4_SUITE,end_per_suite}}, {?eh,tc_done,{timetrap_4_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{timetrap_5_SUITE,init_per_suite}}, {?eh,tc_done,{timetrap_5_SUITE,init_per_suite,ok}}, {?eh,tc_start,{timetrap_5_SUITE,tc0}}, - {?eh,tc_done, - {timetrap_5_SUITE,tc0,{failed,{timetrap_timeout,1000}}}}, + {?eh,tc_done,{timetrap_5_SUITE,tc0, + {failed,{timetrap_timeout,{'$approx',1000}}}}}, {?eh,test_stats,{0,5,{0,0}}}, {?eh,tc_start,{timetrap_5_SUITE,tc1}}, - {?eh,tc_done, - {timetrap_5_SUITE,tc1,{skipped,{timetrap_error,kaboom}}}}, + {?eh,tc_done,{undefined,undefined,{user_timetrap_error, + {kaboom,'_'}}}}, + {?eh,test_stats,{0,6,{0,0}}}, {?eh,tc_start,{timetrap_5_SUITE,tc2}}, - {?eh,tc_done, - {timetrap_5_SUITE,tc2,{skipped,{timetrap_error,kaboom}}}}, + {?eh,tc_done,{undefined,undefined,{user_timetrap_error, + {kaboom,'_'}}}}, + {?eh,test_stats,{0,7,{0,0}}}, {?eh,tc_start,{timetrap_5_SUITE,tc3}}, - {?eh,tc_done, - {timetrap_5_SUITE,tc3, - {skipped,{invalid_time_format,{timetrap_utils,timetrap_val,[5000]}}}}}, + {?eh,tc_done,{timetrap_5_SUITE,tc3, + {failed,{timetrap_timeout,{'$approx',2000}}}}}, + {?eh,test_stats,{0,8,{0,0}}}, {?eh,tc_start,{timetrap_5_SUITE,tc4}}, - {?eh,tc_done, - {timetrap_5_SUITE,tc4,{skipped,{invalid_time_format,'_'}}}}, - {?eh,test_stats,{0,5,{0,4}}}, + {?eh,tc_done,{timetrap_5_SUITE,tc4, + {failed,{timetrap_timeout,{'$approx',500}}}}}, + {?eh,test_stats,{0,9,{0,0}}}, {?eh,tc_start,{timetrap_5_SUITE,tc5}}, - {?eh,tc_done, - {timetrap_5_SUITE,tc5,{failed,{timetrap_timeout,1000}}}}, + {?eh,tc_done,{timetrap_5_SUITE,tc5, + {failed,{timetrap_timeout,{'$approx',1000}}}}}, + {?eh,test_stats,{0,10,{0,0}}}, {?eh,tc_start,{timetrap_5_SUITE,tc6}}, - {?eh,tc_done, - {timetrap_5_SUITE,tc6,{failed,{timetrap_timeout,1000}}}}, + {?eh,tc_done,{timetrap_5_SUITE,tc6, + {failed,{timetrap_timeout,{'$approx',41000}}}}}, + {?eh,test_stats,{0,11,{0,0}}}, {?eh,tc_start,{timetrap_5_SUITE,tc7}}, - {?eh,tc_done, - {timetrap_5_SUITE,tc7,{failed,{timetrap_timeout,1000}}}}, - {?eh,test_stats,{0,8,{0,4}}}, + {?eh,tc_done,{timetrap_5_SUITE,tc7, + {failed,{timetrap_timeout,{'$approx',3000}}}}}, + {?eh,test_stats,{0,12,{0,0}}}, + {?eh,tc_start,{timetrap_5_SUITE,tc8}}, + {?eh,tc_done,{timetrap_5_SUITE,tc8, + {failed,{timetrap_timeout,{'$approx',7000}}}}}, + {?eh,test_stats,{0,13,{0,0}}}, + {?eh,tc_start,{timetrap_5_SUITE,tc9}}, + {?eh,tc_done,{timetrap_5_SUITE,tc9, + {failed,{timetrap_timeout,{'$approx',2000}}}}}, + {?eh,test_stats,{0,14,{0,0}}}, + {?eh,tc_start,{timetrap_5_SUITE,tc10}}, + {?eh,tc_done,{timetrap_5_SUITE,tc10, + {failed,{timetrap_timeout,{'$approx',1500}}}}}, + {?eh,test_stats,{0,15,{0,0}}}, + {?eh,tc_start,{timetrap_5_SUITE,tc11}}, + {?eh,tc_done,{timetrap_5_SUITE,tc11, + {failed,{timetrap_timeout,{'$approx',1500}}}}}, + {?eh,test_stats,{0,16,{0,0}}}, + {?eh,tc_start,{timetrap_5_SUITE,tc12}}, + {?eh,tc_done,{timetrap_5_SUITE,tc12, + {failed,{timetrap_timeout,{'$approx',1000}}}}}, + {?eh,test_stats,{0,17,{0,0}}}, + {?eh,tc_start,{timetrap_5_SUITE,tc13}}, + {?eh,tc_done,{timetrap_5_SUITE,tc13, + {failed,{timetrap_timeout,{'$approx',500}}}}}, + {?eh,test_stats,{0,18,{0,0}}}, + {?eh,tc_start,{timetrap_5_SUITE,tc14}}, + {?eh,tc_done,{timetrap_5_SUITE,tc14, + {failed,{timetrap_timeout,{'$approx',1000}}}}}, + {?eh,test_stats,{0,19,{0,0}}}, + {?eh,tc_start,{timetrap_5_SUITE,end_per_suite}}, {?eh,tc_done,{timetrap_5_SUITE,end_per_suite,ok}}, {?eh,tc_start,{timetrap_6_SUITE,init_per_suite}}, - {?eh,tc_done, - {timetrap_6_SUITE,init_per_suite,{skipped,{timetrap_error,kaboom}}}}, - {?eh,tc_auto_skip, - {timetrap_6_SUITE,tc0,{timetrap_error,kaboom}}}, - {?eh,test_stats,{0,8,{0,5}}}, - {?eh,tc_auto_skip, - {timetrap_6_SUITE,end_per_suite,{timetrap_error,kaboom}}}, - + {?eh,tc_done,{undefined,undefined,{user_timetrap_error, + {kaboom,'_'}}}}, + {?eh,tc_auto_skip,{timetrap_6_SUITE,tc0, + {failed,{timetrap_6_SUITE,init_per_suite, + {user_timetrap_error,{kaboom,'_'}}}}}}, + {?eh,test_stats,{0,19,{0,1}}}, + {?eh,tc_auto_skip,{timetrap_6_SUITE,end_per_suite, + {failed,{timetrap_6_SUITE,init_per_suite, + {user_timetrap_error,{kaboom,'_'}}}}}}, + + {?eh,tc_start,{timetrap_7_SUITE,init_per_suite}}, {?eh,tc_done,{timetrap_7_SUITE,init_per_suite,ok}}, {?eh,tc_start,{timetrap_7_SUITE,tc0}}, - {?eh,tc_done, - {timetrap_7_SUITE,tc0,{failed,{timetrap_timeout,1000}}}}, + {?eh,tc_done,{timetrap_7_SUITE,tc0, + {failed,{timetrap_timeout,{'$approx',7000}}}}}, + {?eh,test_stats,{0,20,{0,1}}}, {?eh,tc_start,{timetrap_7_SUITE,tc1}}, - {?eh,tc_done, - {timetrap_7_SUITE,tc1,{failed,{timetrap_timeout,2000}}}}, + {?eh,tc_done,{timetrap_7_SUITE,tc1, + {failed,{timetrap_timeout,{'$approx',2000}}}}}, + {?eh,test_stats,{0,21,{0,1}}}, {?eh,tc_start,{timetrap_7_SUITE,tc2}}, - {?eh,tc_done, - {timetrap_7_SUITE,tc2,{failed,{timetrap_timeout,500}}}}, + {?eh,tc_done,{timetrap_7_SUITE,tc2, + {failed,{timetrap_timeout,{'$approx',500}}}}}, + {?eh,test_stats,{0,22,{0,1}}}, {?eh,tc_start,{timetrap_7_SUITE,tc3}}, - {?eh,tc_done, - {timetrap_7_SUITE,tc3,{failed,{timetrap_timeout,1000}}}}, - {?eh,test_stats,{0,12,{0,5}}}, + {?eh,tc_done,{timetrap_7_SUITE,tc3, + {failed,{timetrap_timeout,{'$approx',7000}}}}}, + {?eh,test_stats,{0,23,{0,1}}}, + {?eh,tc_start,{timetrap_7_SUITE,end_per_suite}}, {?eh,tc_done,{timetrap_7_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_5_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_5_SUITE.erl index c5d4b5062e..58042c04fc 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_5_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_5_SUITE.erl @@ -108,7 +108,8 @@ groups() -> %% Reason = term() %%-------------------------------------------------------------------- all() -> - [tc0,tc1,tc2,tc3,tc4,tc5,tc6,tc7]. + [tc0,tc1,tc2,tc3,tc4,tc5,tc6,tc7,tc8,tc9, + tc10,tc11,tc12,tc13,tc14]. tc0(_) -> ct:comment(io_lib:format("TO after ~w sec", [?TO])), @@ -126,30 +127,89 @@ tc2(_) -> exit(this_should_not_execute). tc3() -> - [{timetrap,{timetrap_utils,timetrap_err_mfa,[]}}]. -tc3(_) -> - exit(this_should_not_execute). + [{timetrap,{timetrap_utils,timetrap_val,[{seconds,2}]}}]. +tc3(_) -> + ct:comment("TO after ~2 sec"), + ct:sleep({seconds,10}), + ok. tc4() -> - [{timetrap,fun() -> timetrap_utils:timetrap_err_fun() end}]. -tc4(_) -> - exit(this_should_not_execute). + [{timetrap,fun() -> 500 end}]. +tc4(_) -> + ct:comment("TO after 500 ms"), + ct:sleep({seconds,10}), + ok. tc5() -> + [{timetrap,{timetrap_utils,timetrap_timeout,[1000,ok]}}]. +tc5(_) -> + ct:comment("TO after ~1 sec"), + ct:sleep({seconds,10}), + ok. + +tc6() -> [{timetrap,{timetrap_utils,timetrap_timeout,[{seconds,40}, {seconds,1}]}}]. -tc5(_) -> +tc6(_) -> ct:comment("TO after 40+1 sec"), ct:sleep({seconds,42}), ok. -tc6() -> +tc7() -> + [{timetrap,{timetrap_utils,timetrap_timeout,[1000,2000]}}]. +tc7(_) -> + ct:comment("TO after ~3 sec"), + ct:sleep({seconds,10}), + ok. + +tc8() -> [{timetrap,fun() -> ct:sleep(6000), 1000 end}]. -tc6(_) -> +tc8(_) -> ct:comment("TO after 6+1 sec"), - ct:sleep({seconds,10}). + ct:sleep({seconds,10}), + ok. -tc7(_) -> +tc9() -> + [{timetrap,{timetrap_utils,timetrap_timeout, + [500,fun() -> {seconds,2} end]}}]. +tc9(_) -> + ct:comment("TO after ~2 sec (2.5 sec in reality)"), + ct:sleep({seconds,10}), + ok. + +tc10() -> + [{timetrap,500}]. +tc10(_) -> + ct:timetrap({timetrap_utils,timetrap_val,[1500]}), + ct:comment("TO after ~1.5 sec"), + ct:sleep({seconds,10}), + ok. + +tc11() -> + [{timetrap,2000}]. +tc11(_) -> + ct:timetrap(fun() -> 1500 end), + ct:comment("TO after ~1.5 sec"), + ct:sleep({seconds,10}), + ok. + +tc12() -> + [{timetrap,500}]. +tc12(_) -> + ct:timetrap({timetrap_utils,timetrap_timeout,[1000,ok]}), + ct:comment("TO after ~1 sec"), + ct:sleep({seconds,10}), + ok. + +tc13() -> + [{timetrap,2000}]. +tc13(_) -> + ct:timetrap(fun() -> ct:sleep(500), ok end), + ct:comment("TO after ~500 ms"), + ct:sleep({seconds,10}), + ok. + +tc14(_) -> ct:comment(io_lib:format("TO after ~w sec", [?TO])), ct:sleep({seconds,5}), ok. diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_7_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_7_SUITE.erl index b25b7770a7..62de959458 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_7_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_7_SUITE.erl @@ -114,7 +114,7 @@ all() -> tc0(_) -> ct:comment(io_lib:format("TO after ~w+~w sec", [?HANG,?TO])), - ct:sleep({seconds,5}), + ct:sleep({seconds,10}), ok. tc1() -> @@ -133,5 +133,5 @@ tc2(_) -> tc3(_) -> ct:comment(io_lib:format("TO after ~w+~w sec", [?HANG,?TO])), - ct:sleep({seconds,5}), + ct:sleep({seconds,10}), ok. diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_utils.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_utils.erl index fcde6cd701..016014b03a 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_utils.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_utils.erl @@ -20,24 +20,15 @@ -module(timetrap_utils). -export([timetrap_val/1, - timetrap_err_fun/0, - timetrap_err_mfa/0, timetrap_exit/1, timetrap_timeout/2]). timetrap_val(Val) -> Val. -timetrap_err_fun() -> - fun() -> 5000 end. - -timetrap_err_mfa() -> - {?MODULE,timetrap_val,[5000]}. - timetrap_exit(Reason) -> exit(Reason). timetrap_timeout(Sleep, Val) -> ct:sleep(Sleep), Val. - diff --git a/lib/common_test/test/ct_master_SUITE.erl b/lib/common_test/test/ct_master_SUITE.erl index 1471cc1e0c..d8cb6318c1 100644 --- a/lib/common_test/test/ct_master_SUITE.erl +++ b/lib/common_test/test/ct_master_SUITE.erl @@ -98,7 +98,7 @@ end_per_group(_GroupName, Config) -> %%-------------------------------------------------------------------- %% TEST CASES %%-------------------------------------------------------------------- -ct_master_test(Config) when is_list(Config)-> +ct_master_test(Config) when is_list(Config) -> NodeNames = proplists:get_value(node_names, Config), DataDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), @@ -106,19 +106,14 @@ ct_master_test(Config) when is_list(Config)-> FileName = filename:join(PrivDir, "ct_master_spec.spec"), Suites = [master_SUITE], TSFile = make_spec(DataDir, FileName, NodeNames, Suites, Config), + ERPid = ct_test_support:start_event_receiver(Config), - spawn(ct@ancalagon, - fun() -> - dbg:tracer(),dbg:p(all,c), - dbg:tpl(erlang, spawn_link, 4,x), - receive ok -> ok end - end), - [{TSFile, ok}] = run_test(ct_master_test, FileName, Config), + [{TSFile,ok}] = run_test(ct_master_test, FileName, Config), Events = ct_test_support:get_events(ERPid, Config), - ct_test_support:log_events(groups_suite_1, + ct_test_support:log_events(ct_master_test, reformat(Events, ?eh), PrivDir, []), @@ -134,48 +129,59 @@ ct_master_test(Config) when is_list(Config)-> %%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- -make_spec(DataDir, FileName, NodeNames, Suites, Config)-> - {ok, HostName} = inet:gethostname(), +make_spec(DataDir, FileName, NodeNames, Suites, Config) -> + {ok,HostName} = inet:gethostname(), - N = lists:map(fun(NodeName)-> + N = lists:map(fun(NodeName) -> {node, NodeName, list_to_atom(atom_to_list(NodeName)++"@"++HostName)} end, NodeNames), - C = lists:map(fun(NodeName)-> - Rnd = random:uniform(2), - if Rnd == 1-> - {config, NodeName, filename:join(DataDir, "master/config.txt")}; - true-> - {userconfig, NodeName, {ct_config_xml, filename:join(DataDir, "master/config.xml")}} - end - end, - NodeNames), - - NS = lists:map(fun(NodeName)-> - {init, NodeName, [ - {node_start, [{startup_functions, []}, {monitor_master, true}]}, - {eval, {erlang, nodes, []}} - ] - } - end, - NodeNames), - + C = lists:map( + fun(NodeName) -> + Rnd = random:uniform(2), + if Rnd == 1-> + {config,NodeName,filename:join(DataDir, + "master/config.txt")}; + true -> + {userconfig,NodeName, + {ct_config_xml,filename:join(DataDir, + "master/config.xml")}} + end + end, + NodeNames), + + CM = [{config,master,filename:join(DataDir,"master/config.txt")}], + + NS = lists:map( + fun(NodeName) -> + {init,NodeName,[ + {node_start,[{startup_functions,[]}, + {monitor_master,true}]}, + {eval,{erlang,nodes,[]}} + ] + } + end, + NodeNames), + S = [{suites, NodeNames, filename:join(DataDir, "master"), Suites}], - + PrivDir = ?config(priv_dir, Config), - LD = lists:map(fun(NodeName)-> - {logdir, NodeName, get_log_dir(os:type(),PrivDir, NodeName)} - end, - NodeNames) ++ [{logdir, master, PrivDir}], + + LD = lists:map( + fun(NodeName) -> + {logdir,NodeName,get_log_dir(os:type(),PrivDir, NodeName)} + end, + NodeNames) ++ [{logdir,master,PrivDir}], + EvHArgs = [{cbm,ct_test_support},{trace_level,?config(trace_level,Config)}], EH = [{event_handler,master,[?eh],EvHArgs}], - + Include = [{include,filename:join([DataDir,"master/include"])}], + + ct_test_support:write_testspec(N++Include++EH++C++CM++S++LD++NS, FileName). - ct_test_support:write_testspec(N++Include++EH++C++S++LD++NS, FileName). - -get_log_dir({win32,_}, _PrivDir, NodeName)-> +get_log_dir({win32,_}, _PrivDir, NodeName) -> case filelib:is_dir(?TEMP_DIR) of false -> file:make_dir(?TEMP_DIR); @@ -188,8 +194,15 @@ get_log_dir(_,PrivDir,NodeName) -> file:make_dir(LogDir), LogDir. -run_test(_Name, FileName, Config)-> - [{FileName, ok}] = ct_test_support:run(ct_master, run, [FileName], Config). +run_test(_Name, FileName, Config) -> + %% run the test twice, using different html versions + [{FileName,ok}] = ct_test_support:run({ct_master,run,[FileName]}, + [{ct_master,basic_html,[true]}], + Config), + timer:sleep(5000), + [{FileName,ok}] = ct_test_support:run({ct_master,run,[FileName]}, + [{ct_master,basic_html,[false]}], + Config). reformat(Events, EH) -> ct_test_support:reformat(Events, EH). @@ -220,5 +233,5 @@ add_host(NodeName) -> {ok, HostName} = inet:gethostname(), list_to_atom(atom_to_list(NodeName)++"@"++HostName). -expected_events(_)-> +expected_events(_) -> []. diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index 6df02d12b7..62c167d78b 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -29,7 +29,7 @@ -export([init_per_suite/1, init_per_suite/2, end_per_suite/1, init_per_testcase/2, end_per_testcase/2, write_testspec/2, write_testspec/3, - run/2, run/4, get_opts/1, wait_for_ct_stop/1]). + run/2, run/3, run/4, get_opts/1, wait_for_ct_stop/1]). -export([handle_event/2, start_event_receiver/1, get_events/2, verify_events/3, reformat/2, log_events/4, @@ -223,7 +223,7 @@ get_opts(Config) -> %%%----------------------------------------------------------------- %%% -run(Opts, Config) -> +run(Opts, Config) when is_list(Opts) -> CTNode = proplists:get_value(ct_node, Config), Level = proplists:get_value(trace_level, Config), %% use ct interface @@ -256,9 +256,19 @@ run(Opts, Config) -> end. run(M, F, A, Config) -> + run({M,F,A}, [], Config). + +run({M,F,A}, InitCalls, Config) -> CTNode = proplists:get_value(ct_node, Config), Level = proplists:get_value(trace_level, Config), - test_server:format(Level, "~nCalling ~w:~w(~p) on ~p~n", + lists:foreach( + fun({IM,IF,IA}) -> + test_server:format(Level, "~nInit call ~w:~w(~p) on ~p...~n", + [IM, IF, IA, CTNode]), + Result = rpc:call(CTNode, IM, IF, IA), + test_server:format(Level, "~n...with result: ~p~n", [Result]) + end, InitCalls), + test_server:format(Level, "~nStarting test with ~w:~w(~p) on ~p~n", [M, F, A, CTNode]), rpc:call(CTNode, M, F, A). @@ -1001,6 +1011,12 @@ result_match({SkipOrFail,{ErrorInd,{Why,'_'}}}, result_match({SkipOrFail,{ErrorInd,{EMod,EFunc,{Why,'_'}}}}, {SkipOrFail,{ErrorInd,{EMod,EFunc,{Why,_Stack}}}}) -> true; +result_match({failed,{timetrap_timeout,{'$approx',Num}}}, + {failed,{timetrap_timeout,Value}}) -> + if Value >= trunc(Num-0.01*Num), + Value =< trunc(Num+0.01*Num) -> true; + true -> false + end; result_match(Result, Result) -> true; result_match(_, _) -> diff --git a/lib/dialyzer/src/Makefile b/lib/dialyzer/src/Makefile index 810f86dc21..97c5469d39 100644 --- a/lib/dialyzer/src/Makefile +++ b/lib/dialyzer/src/Makefile @@ -86,7 +86,7 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) ifeq ($(NATIVE_LIBS_ENABLED),yes) ERL_COMPILE_FLAGS += +native endif -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_unused_import +warn_untyped_record +warn_missing_spec +ERL_COMPILE_FLAGS += +warn_exported_vars +warn_unused_import +warn_untyped_record +warn_missing_spec +warnings_as_errors # ---------------------------------------------------- # Targets diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index 5be870d78f..b6dbfdfacf 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -463,8 +463,10 @@ default_includes(Dir) -> rcv_and_send_ext_types(Parent) -> Self = self(), Self ! {Self, done}, - ExtTypes = rcv_ext_types(Self, []), - Parent ! {Self, ext_types, ExtTypes}, + case rcv_ext_types(Self, []) of + [] -> ok; + ExtTypes -> Parent ! {Self, ext_types, ExtTypes} + end, ok. rcv_ext_types(Self, ExtTypes) -> diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index aba13278ff..d1dd7e1c34 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -761,7 +761,13 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], true -> AccArgTypes; false -> [t_sup(X, Y) || {X, Y} <- lists:zip(NewArgTypes, AccArgTypes)] end, - NewAccRet = t_sup(AccRet, t_inf(RetWithoutLocal, LocalRet, opaque)), + TotalRet = + case t_is_none(LocalRet) andalso t_is_unit(RetWithoutLocal) of + true -> RetWithoutLocal; + false -> t_inf(RetWithoutLocal, LocalRet, opaque) + end, + NewAccRet = t_sup(AccRet, TotalRet), + ?debug("NewAccRet: ~s\n", [t_to_string(NewAccRet)]), handle_apply_or_call(Left, Args, ArgTypes, Map, Tree, State3, NewAccArgTypes, NewAccRet); handle_apply_or_call([], Args, _ArgTypes, Map, _Tree, State, @@ -3109,6 +3115,7 @@ init_fun_tab([Fun|Left], Dict, TreeMap, Callgraph, Plt, Opaques) -> NewDict = dict:store(Fun, FunEntry, Dict), init_fun_tab(Left, NewDict, TreeMap, Callgraph, Plt, Opaques); init_fun_tab([], Dict, _TreeMap, _Callgraph, _Plt, _Opaques) -> + ?debug("DICT:~p\n",[dict:to_list(Dict)]), Dict. state__update_fun_env(Tree, Map, #state{envs = Envs} = State) -> @@ -3140,7 +3147,9 @@ state__fun_type(Fun, #state{fun_tab = FunTab}) -> if is_integer(Fun) -> Fun; true -> get_label(Fun) end, - case dict:find(Label, FunTab) of + Entry = dict:find(Label, FunTab), + ?debug("FunType ~p:~p\n",[Label, Entry]), + case Entry of {ok, {not_handled, {A, R}}} -> t_fun(A, R); {ok, {A, R}} -> @@ -3248,6 +3257,7 @@ state__fun_info(Fun, #state{callgraph = CG, fun_tab = FunTab, plt = PLT}) -> {not_handled, {_Args, Ret}} -> Ret; {_Args, Ret} -> Ret end, + ?debug("LocalRet: ~s\n", [t_to_string(LocalRet)]), {Fun, Sig, Contract, LocalRet}. state__find_apply_return(Tree, #state{callgraph = Callgraph} = State) -> diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl index 9ff32bd8b1..8f470dd650 100644 --- a/lib/dialyzer/src/dialyzer_gui_wx.erl +++ b/lib/dialyzer/src/dialyzer_gui_wx.erl @@ -40,39 +40,38 @@ %%------------------------------------------------------------------------ --type wx_object() :: any(). %% XXX: should be imported from wx - --record(menu, {file :: wx_object(), - warnings :: wx_object(), - plt :: wx_object(), - options :: wx_object(), - help :: wx_object()}). - --record(gui_state, {add :: wx_object(), - add_dir :: wx_object(), - add_rec :: wx_object(), - chosen_box :: wx_object(), +-record(menu, {file :: wx:wx_object(), + warnings :: wx:wx_object(), + plt :: wx:wx_object(), + options :: wx:wx_object(), + help :: wx:wx_object()}). +-type menu() :: #menu{}. + +-record(gui_state, {add :: wx:wx_object(), + add_dir :: wx:wx_object(), + add_rec :: wx:wx_object(), + chosen_box :: wx:wx_object(), analysis_pid :: pid(), - del_file :: wx_object(), + del_file :: wx:wx_object(), doc_plt :: dialyzer_plt:plt(), - clear_chosen :: wx_object(), - clear_log :: wx_object(), - explain_warn :: wx_object(), - clear_warn :: wx_object(), + clear_chosen :: wx:wx_object(), + clear_log :: wx:wx_object(), + explain_warn :: wx:wx_object(), + clear_warn :: wx:wx_object(), init_plt :: dialyzer_plt:plt(), - dir_entry :: wx_object(), - file_box :: wx_object(), + dir_entry :: wx:wx_object(), + file_box :: wx:wx_object(), files_to_analyze :: ordset(string()), - gui :: wx_object(), - log :: wx_object(), - menu :: #menu{}, - mode :: wx_object(), + gui :: wx:wx_object(), + log :: wx:wx_object(), + menu :: menu(), + mode :: wx:wx_object(), options :: #options{}, - run :: wx_object(), - stop :: wx_object(), - frame :: wx_object(), - warnings_box :: wx_object(), - explanation_box :: wx_object(), + run :: wx:wx_object(), + stop :: wx:wx_object(), + frame :: wx:wx_object(), + warnings_box :: wx:wx_object(), + explanation_box :: wx:wx_object(), wantedWarnings :: list(), rawWarnings :: list(), backend_pid :: pid(), @@ -824,7 +823,7 @@ build_analysis_record(#gui_state{mode = Mode, menu = Menu, options = Options, 1 -> src_code end, InitPlt = - case wxMenu:isChecked(Menu#menu.plt,?menuID_PLT_INIT_EMPTY) of + case wxMenu:isChecked(Menu#menu.plt, ?menuID_PLT_INIT_EMPTY) of true -> dialyzer_plt:new(); false -> InitPlt0 end, diff --git a/lib/dialyzer/test/small_SUITE_data/src/maybe_servers.erl b/lib/dialyzer/test/small_SUITE_data/src/maybe_servers.erl new file mode 100644 index 0000000000..237f43b1a6 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/maybe_servers.erl @@ -0,0 +1,31 @@ +-module(maybe_servers). + +-export([maybe_server/2, mirror_maybe_server/2]). + +maybe_server(O, I) -> + case O of + no -> + maybe_loop(fun(_) -> fin end, I); + yes -> + maybe_loop(fun(X) -> {ok, X} end, I) + end. + +maybe_loop(F, X)-> + case F(X) of + {ok, Y} -> maybe_loop(F, Y); + fin -> exit(n) + end. + +mirror_maybe_loop(F, X)-> + case F(X) of + {ok, Y} -> mirror_maybe_loop(F, Y); + fin -> exit(n) + end. + +mirror_maybe_server(O, I) -> + case O of + no -> + mirror_maybe_loop(fun(_) -> fin end, I); + yes -> + mirror_maybe_loop(fun(X) -> {ok, X} end, I) + end. diff --git a/lib/dialyzer/vsn.mk b/lib/dialyzer/vsn.mk index 622e51b859..edafcc4afb 100644 --- a/lib/dialyzer/vsn.mk +++ b/lib/dialyzer/vsn.mk @@ -1 +1 @@ -DIALYZER_VSN = 2.5 +DIALYZER_VSN = 2.5.1 diff --git a/lib/diameter/examples/code/GNUmakefile b/lib/diameter/examples/code/GNUmakefile index a0669119d2..98e36a99e3 100644 --- a/lib/diameter/examples/code/GNUmakefile +++ b/lib/diameter/examples/code/GNUmakefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2010-2011. All Rights Reserved. +# Copyright Ericsson AB 2010-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 diff --git a/lib/diameter/examples/code/client.erl b/lib/diameter/examples/code/client.erl index 9e65f98de0..bfe71b0e56 100644 --- a/lib/diameter/examples/code/client.erl +++ b/lib/diameter/examples/code/client.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -38,7 +38,7 @@ -module(client). -include_lib("diameter/include/diameter.hrl"). --include_lib("diameter/src/app/diameter_gen_base_rfc3588.hrl"). +-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). -export([start/1, %% start a service connect/2, %% add a connecting transport diff --git a/lib/diameter/examples/code/client_cb.erl b/lib/diameter/examples/code/client_cb.erl index 524a8f94a1..ee3dcb2fec 100644 --- a/lib/diameter/examples/code/client_cb.erl +++ b/lib/diameter/examples/code/client_cb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -20,7 +20,7 @@ -module(client_cb). -include_lib("diameter/include/diameter.hrl"). --include_lib("diameter/src/app/diameter_gen_base_rfc3588.hrl"). +-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). %% diameter callbacks -export([peer_up/3, diff --git a/lib/diameter/examples/code/peer.erl b/lib/diameter/examples/code/peer.erl index 89203e15c3..b07cd32b98 100644 --- a/lib/diameter/examples/code/peer.erl +++ b/lib/diameter/examples/code/peer.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -25,7 +25,7 @@ -module(peer). -include_lib("diameter/include/diameter.hrl"). --include_lib("diameter/src/app/diameter_gen_base_rfc3588.hrl"). +-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). -export([start/2, listen/2, diff --git a/lib/diameter/examples/code/redirect.erl b/lib/diameter/examples/code/redirect.erl index b54701243f..d4d94ab23a 100644 --- a/lib/diameter/examples/code/redirect.erl +++ b/lib/diameter/examples/code/redirect.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -20,7 +20,7 @@ -module(redirect). -include_lib("diameter/include/diameter.hrl"). --include_lib("diameter/src/app/diameter_gen_base_rfc3588.hrl"). +-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). -export([start/1, listen/2, diff --git a/lib/diameter/examples/code/redirect_cb.erl b/lib/diameter/examples/code/redirect_cb.erl index ea7ad38749..da31add70d 100644 --- a/lib/diameter/examples/code/redirect_cb.erl +++ b/lib/diameter/examples/code/redirect_cb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 diff --git a/lib/diameter/examples/code/relay.erl b/lib/diameter/examples/code/relay.erl index deecb1cfc0..d3438f83f3 100644 --- a/lib/diameter/examples/code/relay.erl +++ b/lib/diameter/examples/code/relay.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -32,7 +32,7 @@ -module(relay). -include_lib("diameter/include/diameter.hrl"). --include_lib("diameter/src/app/diameter_gen_base_rfc3588.hrl"). +-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). -export([start/1, listen/2, diff --git a/lib/diameter/examples/code/relay_cb.erl b/lib/diameter/examples/code/relay_cb.erl index 9ed6517d5c..9f9cd8d5ae 100644 --- a/lib/diameter/examples/code/relay_cb.erl +++ b/lib/diameter/examples/code/relay_cb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -20,7 +20,7 @@ -module(relay_cb). -include_lib("diameter/include/diameter.hrl"). --include_lib("diameter/src/app/diameter_gen_base_rfc3588.hrl"). +-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). %% diameter callbacks -export([peer_up/3, diff --git a/lib/diameter/examples/code/server.erl b/lib/diameter/examples/code/server.erl index ebb408e501..3959461cec 100644 --- a/lib/diameter/examples/code/server.erl +++ b/lib/diameter/examples/code/server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -35,7 +35,7 @@ -module(server). -include_lib("diameter/include/diameter.hrl"). --include_lib("diameter/src/app/diameter_gen_base_rfc3588.hrl"). +-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). -export([start/1, %% start a service listen/2, %% add a listening transport diff --git a/lib/diameter/examples/code/server_cb.erl b/lib/diameter/examples/code/server_cb.erl index 43b8e24b5c..0f6eb32ed6 100644 --- a/lib/diameter/examples/code/server_cb.erl +++ b/lib/diameter/examples/code/server_cb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -24,7 +24,7 @@ -module(server_cb). -include_lib("diameter/include/diameter.hrl"). --include_lib("diameter/src/app/diameter_gen_base_rfc3588.hrl"). +-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). %% diameter callbacks -export([peer_up/3, @@ -76,7 +76,7 @@ handle_request(#diameter_packet{msg = Req, errors = []}, _SvcName, {_, Caps}) %% ... or one that wasn't. 3xxx errors are answered by diameter itself %% but these are 5xxx errors for which we must contruct a reply. %% diameter will set Result-Code and Failed-AVP's. -handle_request(#diameter_packet{msg = Req} = Pkt, _SvcName, {_, Caps}) +handle_request(#diameter_packet{msg = Req}, _SvcName, {_, Caps}) when is_record(Req, diameter_base_RAR) -> #diameter_caps{origin_host = {OH,_}, origin_realm = {OR,_}} diff --git a/lib/diameter/src/base/diameter.appup.src b/lib/diameter/src/base/diameter.appup.src index b1c94d4cc8..2ebdad598f 100644 --- a/lib/diameter/src/base/diameter.appup.src +++ b/lib/diameter/src/base/diameter.appup.src @@ -21,10 +21,14 @@ {"%VSN%", [ {"0.9", [{restart_application, diameter}]}, - {"0.10", [{restart_application, diameter}]} + {"0.10", [{restart_application, diameter}]}, + {"1.0", [{update, diameter_service}, + {update, diameter_watchdog}]} ], [ {"0.9", [{restart_application, diameter}]}, - {"0.10", [{restart_application, diameter}]} + {"0.10", [{restart_application, diameter}]}, + {"1.0", [{update, diameter_watchdog}, + {update, diameter_service}]} ] }. diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index 0c240798cc..f6dc786417 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.0 +DIAMETER_VSN = 1.1 PRE_VSN = APP_VSN = "$(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN)" diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index e443b54016..4ba400fbbf 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -57,7 +57,7 @@ disc_load_table(Tab, Reason) -> do_get_disc_copy2(Tab, _Reason, Storage, _Type) when Storage == unknown -> verbose("Local table copy of ~p has recently been deleted, ignored.~n", [Tab]), - {loaded, ok}; %% ? + {not_loaded, storage_unknown}; do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == disc_copies -> %% NOW we create the actual table Repair = mnesia_monitor:get_env(auto_repair), diff --git a/lib/runtime_tools/test/Makefile b/lib/runtime_tools/test/Makefile index cfaf420d65..3e50ba02ca 100644 --- a/lib/runtime_tools/test/Makefile +++ b/lib/runtime_tools/test/Makefile @@ -3,6 +3,7 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES = \ + dyntrace_SUITE \ runtime_tools_SUITE \ inviso_testmodule1_foo \ inviso_SUITE \ diff --git a/lib/runtime_tools/test/dyntrace_SUITE.erl b/lib/runtime_tools/test/dyntrace_SUITE.erl new file mode 100644 index 0000000000..0e4f369ed0 --- /dev/null +++ b/lib/runtime_tools/test/dyntrace_SUITE.erl @@ -0,0 +1,224 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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(dyntrace_SUITE). +-include_lib("test_server/include/test_server.hrl"). + +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2]). +-export([init_per_testcase/2, end_per_testcase/2]). + +%% Test cases +-export([smoke/1,process/1]). + +%% Default timetrap timeout (set in init_per_testcase) +-define(default_timeout, ?t:minutes(1)). + +init_per_testcase(_Case, Config) -> + Dog = test_server:timetrap(?default_timeout), + [{watchdog,Dog}|Config]. + +end_per_testcase(_Case, Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + case erlang:system_info(dynamic_trace) of + none -> + {skip,"No dynamic trace in this run-time system"}; + dtrace -> + [{group,smoke}]; + systemtap -> + {skip,"SystemTap tests currently not supported"} + end. + +groups() -> + [{smoke,[sequence],[smoke,{group,rest}]}, + {rest,[], + [process]}]. + +init_per_suite(Config) -> + N = "beam" ++ + case erlang:system_info(debug_compiled) of + false -> ""; + true -> ".debug" + end ++ + case erlang:system_info(smp_support) of + false -> ""; + true -> ".smp" + end, + [{emu_name,N}|Config]. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +smoke(Config) -> + Emu = ?t:lookup_config(emu_name, Config), + BinEmu = list_to_binary(Emu), + case erlang:system_info(dynamic_trace) of + dtrace -> + Probes = os:cmd("sudo /usr/sbin/dtrace -l -m" ++ Emu), + io:put_chars(Probes), + [_|Lines] = re:split(Probes, "\n", [trim]), + [{_,_} = binary:match(L, BinEmu) || L <- Lines], + ok + end, + + %% Test that the framework for running dtrace/systemtap works + %% by executing an empty script. + {ok,[]} = dyntrace("", fun() -> ok end), + ok. + + +process(_Config) -> + Script = [{probe,"process-spawn"}, + {action,[{printf,["spawn %s %s\n",{arg,0},{arg,1}]}]}, + {probe,"process-scheduled"}, + {action,[{printf,["in %s\n",{arg,0}]}]}, + {probe,"process-unscheduled"}, + {action,[{printf,["out %s\n",{arg,0}]}]}, + {probe,"process-hibernate"}, + {action,[{printf,["hibernate %s %s\n",{arg,0},{arg,1}]}]}, + {probe,"process-exit"}, + {action,[{printf,["exit %s %s\n",{arg,0},{arg,1}]}]} + ], + F = fun() -> + {Pid,Ref} = spawn_monitor(fun my_process/0), + Pid ! hibernate, + Pid ! quit, + receive + {'DOWN',Ref,process,Pid,{terminated,Pid}} -> + ok + end, + Pid + end, + {Pid,Output0} = dyntrace(Script, F), + Output1 = [termify_line(L) || L <- Output0], + PidStr = pid_to_list(Pid), + Output = [L || L <- Output1, element(2, L) =:= PidStr], + Reason = "{terminated,"++PidStr++"}", + io:format("~p\n", [Output]), + [{spawn,PidStr,"erlang:apply/2"}, + {in,PidStr}, + {hibernate,PidStr,"erlang:apply/2"}, + {out,PidStr}, + {in,PidStr}, + {exit,PidStr,Reason}, + {out,PidStr}] = Output, + ok. + +termify_line(L) -> + [H|T] = re:split(L, " ", [{return,list}]), + list_to_tuple([list_to_atom(H)|T]). + +my_process() -> + receive + hibernate -> + erlang:hibernate(erlang, apply, [fun my_process/0,[]]); + quit -> + exit({terminated,self()}) + end. + +%%% +%%% Utility functions. +%%% + +dyntrace(Script0, Action) -> + Sudo = os:find_executable(sudo), + {Termination,Pid} = termination_probe(), + Script1 = Script0++Termination, + Script = translate_script(Script1), + io:format("~s\n", [Script]), + SrcFile = "test-dyntrace.d", + ok = file:write_file(SrcFile, Script), + Args = ["/usr/sbin/dtrace", "-q","-s",SrcFile], + Port = open_port({spawn_executable,Sudo}, + [{args,Args},stream,in,stderr_to_stdout,eof]), + receive + {Port,{data,Sofar}} -> + Res = Action(), + Pid ! quit, + {Res,get_data(Port, Sofar)} + end. + +get_data(Port, Sofar) -> + receive + {Port,{data,Bytes}} -> + get_data(Port, [Sofar|Bytes]); + {Port,eof} -> + port_close(Port), + [$\n|T] = lists:flatten(Sofar), + re:split(T, "\n", [{return,list},trim]) + end. + +termination_probe() -> + Pid = spawn(fun() -> + receive + _ -> + exit(done) + end + end), + S = [{'BEGIN',[{printf,["\n"]}]}, + {probe,"process-exit"}, + {pred,{'==',{arg,0},Pid}}, + {action,[{exit,[0]}]}], + {S,Pid}. + +translate_script(Script) -> + [dtrace_op(Op) || Op <- Script]. + +dtrace_op({probe,Function}) -> + OsPid = os:getpid(), + ["erlang",OsPid,":::",Function,$\n]; +dtrace_op({pred,Pred}) -> + ["/",dtrace_op(Pred),"/\n"]; +dtrace_op({action,List}) -> + ["{ ",action_list(List)," }\n\n"]; +dtrace_op({'BEGIN',List}) -> + ["BEGIN { ",action_list(List)," }\n\n"]; +dtrace_op({'==',Op1,Op2}) -> + [dtrace_op(Op1)," == ",dtrace_op(Op2)]; +dtrace_op({arg,N}) -> + ["copyinstr(arg",integer_to_list(N),")"]; +dtrace_op({Func,List}) when is_atom(Func), is_list(List) -> + [atom_to_list(Func),"(",comma_sep_ops(List),")"]; +dtrace_op(Pid) when is_pid(Pid) -> + ["\"",pid_to_list(Pid),"\""]; +dtrace_op(Str) when is_integer(hd(Str)) -> + io_lib:format("~p", [Str]); +dtrace_op(Int) when is_integer(Int) -> + integer_to_list(Int). + +comma_sep_ops([A,B|T]) -> + [dtrace_op(A),","|comma_sep_ops([B|T])]; +comma_sep_ops([H]) -> + dtrace_op(H); +comma_sep_ops([]) -> []. + +action_list([H|T]) -> + [dtrace_op(H),";"|action_list(T)]; +action_list([]) -> []. diff --git a/lib/ssh/src/ssh_connection_manager.erl b/lib/ssh/src/ssh_connection_manager.erl index 406a042d72..e993f597a5 100644 --- a/lib/ssh/src/ssh_connection_manager.erl +++ b/lib/ssh/src/ssh_connection_manager.erl @@ -144,27 +144,21 @@ adjust_window(ConnectionManager, Channel, Bytes) -> cast(ConnectionManager, {adjust_window, Channel, Bytes}). close(ConnectionManager, ChannelId) -> - try call(ConnectionManager, {close, ChannelId}) of - ok -> + case call(ConnectionManager, {close, ChannelId}) of + ok -> ok; - {error, channel_closed} -> - ok - catch - exit:{noproc, _} -> + {error, channel_closed} -> ok - end. + end. stop(ConnectionManager) -> - try call(ConnectionManager, stop) of + case call(ConnectionManager, stop) of ok -> ok; {error, channel_closed} -> ok - catch - exit:{noproc, _} -> - ok end. - + send(ConnectionManager, ChannelId, Type, Data, Timeout) -> call(ConnectionManager, {data, ChannelId, Type, Data}, Timeout). @@ -591,7 +585,9 @@ call(Pid, Msg, Timeout) -> catch exit:{timeout, _} -> {error, timeout}; - exit:{normal, _} -> + exit:{normal} -> + {error, channel_closed}; + exit:{{shutdown, _}, _} -> {error, channel_closed}; exit:{noproc,_} -> {error, channel_closed} diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 012367a6df..d66214d415 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -110,7 +110,8 @@ all() -> {group, rsa_pass_key}, {group, internal_error}, daemon_already_started, - server_password_option, server_userpassword_option]. + server_password_option, server_userpassword_option, + close]. groups() -> [{dsa_key, [], [exec, exec_compressed, shell, known_hosts]}, @@ -507,7 +508,34 @@ internal_error(Config) when is_list(Config) -> {user_dir, UserDir}, {user_interaction, false}]). +%%-------------------------------------------------------------------- +close(doc) -> + ["Simulate that we try to close an already closed connection"]; + +close(suite) -> + []; + +close(Config) when is_list(Config) -> + SystemDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + + {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {user_dir, UserDir}, + {user_passwords, [{"vego", "morot"}]}, + {failfun, fun ssh_test_lib:failfun/2}]), + {ok, CM} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user_dir, UserDir}, + {user, "vego"}, + {password, "morot"}, + {user_interaction, false}]), + exit(CM, {shutdown, normal}), + ok = ssh:close(CM). + + + %%-------------------------------------------------------------------- %% Internal functions %%-------------------------------------------------------------------- diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 4910a6f1b8..62a79e15eb 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -122,6 +122,9 @@ <p> <c>hash() = md5 | sha </c></p> + <p><c>prf_random() = client_random | server_random + </c></p> + </section> <section> @@ -561,6 +564,26 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | </func> <func> + <name>prf(Socket, Secret, Label, Seed, WantedLength) -> {ok, binary()} | {error, reason()}</name> + <fsummary>Use a sessions pseudo random function to generate key material.</fsummary> + <type> + <v>Socket = sslsocket()</v> + <v>Secret = binary() | master_secret</v> + <v>Label = binary()</v> + <v>Seed = [binary() | prf_random()]</v> + <v>WantedLength = non_neg_integer()</v> + </type> + <desc> + <p>Use the pseudo random function (PRF) of a TLS session to generate + additional key material. It either takes user generated values for + <c>Secret</c> and <c>Seed</c> or atoms directing it use a specific + value from the session security parameters.</p> + <p>This function can only be used with TLS connections, <c>{error, undefined}</c> + is returned for SSLv3 connections.</p> + </desc> + </func> + + <func> <name>renegotiate(Socket) -> ok | {error, Reason}</name> <fsummary> Initiates a new handshake.</fsummary> <type> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index d0693445e0..1048583eca 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -30,7 +30,7 @@ controlling_process/2, listen/2, pid/1, peername/1, peercert/1, recv/2, recv/3, send/2, getopts/2, setopts/2, sockname/1, versions/0, session_info/1, format_error/1, - renegotiate/1]). + renegotiate/1, prf/5]). -deprecated({pid, 1, next_major_release}). @@ -67,7 +67,7 @@ -type ssl_imp() :: new | old. -type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom()}}. - +-type prf_random() :: client_random | server_random. %%-------------------------------------------------------------------- -spec start() -> ok | {error, reason()}. @@ -414,6 +414,17 @@ versions() -> renegotiate(#sslsocket{pid = Pid, fd = new_ssl}) -> ssl_connection:renegotiation(Pid). +%%-------------------------------------------------------------------- +-spec prf(#sslsocket{}, binary() | 'master_secret', binary(), + binary() | prf_random(), non_neg_integer()) -> + {ok, binary()} | {error, reason()}. +%% +%% Description: use a ssl sessions TLS PRF to generate key material +%%-------------------------------------------------------------------- +prf(#sslsocket{pid = Pid, fd = new_ssl}, + Secret, Label, Seed, WantedLength) -> + ssl_connection:prf(Pid, Secret, Label, Seed, WantedLength). + %%--------------------------------------------------------------- -spec format_error({error, term()}) -> list(). %% diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 28dd0c85d0..59133dccf0 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -40,7 +40,8 @@ -export([send/2, recv/3, connect/7, ssl_accept/6, handshake/2, socket_control/3, close/1, shutdown/2, new_user/2, get_opts/2, set_opts/2, info/1, session_info/1, - peer_certificate/1, sockname/1, peername/1, renegotiation/1]). + peer_certificate/1, sockname/1, peername/1, renegotiation/1, + prf/5]). %% Called by ssl_connection_sup -export([start_link/7]). @@ -273,6 +274,16 @@ peer_certificate(ConnectionPid) -> renegotiation(ConnectionPid) -> sync_send_all_state_event(ConnectionPid, renegotiate). +%%-------------------------------------------------------------------- +-spec prf(pid(), binary() | 'master_secret', binary(), + binary() | ssl:prf_secret(), non_neg_integer()) -> + {ok, binary()} | {error, reason()} | {'EXIT', term()}. +%% +%% Description: use a ssl sessions TLS PRF to generate key material +%%-------------------------------------------------------------------- +prf(ConnectionPid, Secret, Label, Seed, WantedLength) -> + sync_send_all_state_event(ConnectionPid, {prf, Secret, Label, Seed, WantedLength}). + %%==================================================================== %% ssl_connection_sup API %%==================================================================== @@ -868,6 +879,32 @@ handle_sync_event(renegotiate, From, connection, State) -> handle_sync_event(renegotiate, _, StateName, State) -> {reply, {error, already_renegotiating}, StateName, State, get_timeout(State)}; +handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName, + #state{connection_states = ConnectionStates, + negotiated_version = Version} = State) -> + ConnectionState = + ssl_record:current_connection_state(ConnectionStates, read), + SecParams = ConnectionState#connection_state.security_parameters, + #security_parameters{master_secret = MasterSecret, + client_random = ClientRandom, + server_random = ServerRandom} = SecParams, + Reply = try + SecretToUse = case Secret of + _ when is_binary(Secret) -> Secret; + master_secret -> MasterSecret + end, + SeedToUse = lists:reverse( + lists:foldl(fun(X, Acc) when is_binary(X) -> [X|Acc]; + (client_random, Acc) -> [ClientRandom|Acc]; + (server_random, Acc) -> [ServerRandom|Acc] + end, [], Seed)), + ssl_handshake:prf(Version, SecretToUse, Label, SeedToUse, WantedLength) + catch + exit:_ -> {error, badarg}; + error:Reason -> {error, Reason} + end, + {reply, Reply, StateName, State, get_timeout(State)}; + handle_sync_event(info, _, StateName, #state{negotiated_version = Version, session = #session{cipher_suite = Suite}} = State) -> diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 542033e6ce..ef60cac6df 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -37,7 +37,7 @@ finished/4, verify_connection/5, get_tls_handshake/2, decode_client_key/3, server_hello_done/0, encode_handshake/2, init_hashes/0, update_hashes/2, - decrypt_premaster_secret/2]). + decrypt_premaster_secret/2, prf/5]). -export([dec_hello_extensions/2]). @@ -543,6 +543,18 @@ server_key_exchange_hash(dhe_dss, Value) -> crypto:sha(Value). %%-------------------------------------------------------------------- +-spec prf(tls_version(), binary(), binary(), binary(), non_neg_integer()) -> + {ok, binary()} | {error, undefined}. +%% +%% Description: use the TLS PRF to generate key material +%%-------------------------------------------------------------------- +prf({3,0}, _, _, _, _) -> + {error, undefined}; +prf({3,N}, Secret, Label, Seed, WantedLength) + when N == 1; N == 2 -> + {ok, ssl_tls1:prf(Secret, Label, Seed, WantedLength)}. + +%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- get_tls_handshake_aux(<<?BYTE(Type), ?UINT24(Length), diff --git a/lib/ssl/src/ssl_tls1.erl b/lib/ssl/src/ssl_tls1.erl index 5f9850c386..7351f34b61 100644 --- a/lib/ssl/src/ssl_tls1.erl +++ b/lib/ssl/src/ssl_tls1.erl @@ -29,7 +29,7 @@ -include("ssl_record.hrl"). -export([master_secret/3, finished/3, certificate_verify/2, mac_hash/7, - setup_keys/6, suites/0]). + setup_keys/6, suites/0, prf/4]). %%==================================================================== %% Internal application API diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index d7ce432786..96d2e2b80e 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -628,7 +628,7 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> end), group_leader(OldGLeader, self()), put(test_server_detected_fail, []), - run_test_case_msgloop(Ref, Pid, false, false, "", undefined). + run_test_case_msgloop(Ref, Pid, false, false, "", undefined, starting). %% Ugly bug (pre R5A): %% If this process (group leader of the test case) terminates before @@ -639,19 +639,37 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> %% A test case is known to have failed if it returns {'EXIT', _} tuple, %% or sends a message {failed, File, Line} to it's group_leader %% -run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> +run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, + Comment, CurrConf, Status) -> %% NOTE: Keep job_proxy_msgloop/0 up to date when changes %% are made in this function! {Timeout,ReturnValue} = case Terminate of {true, ReturnVal} -> + %% stop any timetrap timers for the test case + %% that have been started by this process + timetrap_cancel_all(Pid, false), {20, ReturnVal}; false -> {infinity, should_never_appear} end, receive + {test_case_initialized,Pid} -> + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,running); + Abort = {abort_current_testcase,_,_} when Status == starting -> + %% we're in init phase, must must postpone this operation + %% until test case execution is in progress (or FW:init_tc + %% gets killed) + self() ! Abort, + erlang:yield(), + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {abort_current_testcase,Reason,From} -> - Line = get_loc(Pid), + Line = case is_process_alive(Pid) of + true -> get_loc(Pid); + false -> unknown + end, Mon = erlang:monitor(process, Pid), exit(Pid,{testcase_aborted,Reason,Line}), erlang:yield(), @@ -665,76 +683,94 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> exit(Pid, kill), %% here's the only place we know Reason, so we save %% it as a comment, potentially replacing user data - Error = lists:flatten(io_lib:format("Aborted: ~p",[Reason])), + Error = lists:flatten(io_lib:format("Aborted: ~p", + [Reason])), Error1 = lists:flatten([string:strip(S,left) || - S <- string:tokens(Error,[$\n])]), + S <- string:tokens(Error, + [$\n])]), if length(Error1) > 63 -> string:substr(Error1,1,60) ++ "..."; true -> Error1 end end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,NewComment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + NewComment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}} when is_list(Format) -> Msg = (catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}} when is_atom(Format) -> Msg = (catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,Bytes}} -> run_test_case_msgloop_io( ReplyAs,CaptureStdout,Bytes,From,put_chars), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,unicode,io_lib,Func,[Format,Args]}} when is_list(Format) -> Msg = unicode_to_latin1(catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,latin1,io_lib,Func,[Format,Args]}} when is_list(Format) -> Msg = (catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,unicode,io_lib,Func,[Format,Args]}} when is_atom(Format) -> Msg = unicode_to_latin1(catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,latin1,io_lib,Func,[Format,Args]}} when is_atom(Format) -> Msg = (catch io_lib:Func(Format,Args)), run_test_case_msgloop_io(ReplyAs,CaptureStdout,Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,unicode,Bytes}} -> run_test_case_msgloop_io( ReplyAs,CaptureStdout,unicode_to_latin1(Bytes),From,put_chars), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {io_request,From,ReplyAs,{put_chars,latin1,Bytes}} -> run_test_case_msgloop_io( ReplyAs,CaptureStdout,Bytes,From,put_chars), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); IoReq when element(1, IoReq) == io_request -> %% something else, just pass it on group_leader() ! IoReq, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {structured_io,ClientPid,Msg} -> output(Msg, ClientPid), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {capture,NewCapture} -> - run_test_case_msgloop(Ref,Pid,NewCapture,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,NewCapture,Terminate, + Comment,CurrConf,Status); {sync_apply,From,MFA} -> sync_local_or_remote_apply(false,From,MFA), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {sync_apply_proxy,Proxy,From,MFA} -> sync_local_or_remote_apply(Proxy,From,MFA), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {printout,Detail,Format,Args} -> print(Detail,Format,Args), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {comment,NewComment} -> NewComment1 = test_server_ctrl:to_string(NewComment), NewComment2 = test_server_sup:framework_call(format_comment, @@ -747,13 +783,16 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> Other -> Other end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate1,NewComment2,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate1, + NewComment2,CurrConf,Status); {read_comment,From} -> From ! {self(),read_comment,Comment}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {set_curr_conf,From,NewCurrConf} -> From ! {self(),set_curr_conf,ok}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,NewCurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,NewCurrConf,Status); {make_priv_dir,From} when CurrConf == undefined -> From ! {self(),make_priv_dir,{error,no_priv_dir_in_config}}; {make_priv_dir,From} -> @@ -772,10 +811,12 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> end end, From ! {self(),make_priv_dir,Result}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} -> RetVal = {Time/1000000,Value,mod_loc(Loc),Opts,Comment}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment,undefined); + run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal}, + Comment,undefined,Status); {'EXIT',Pid,Reason} -> case Reason of {timetrap_timeout,TVal,Loc} -> @@ -786,36 +827,42 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, {framework_error,{timetrap,TVal}}, unknown,self()), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, - Comment,undefined); + run_test_case_msgloop(Ref,Pid,CaptureStdout, + Terminate,Comment, + undefined,Status); Loc1 -> %% call end_per_testcase on a separate process, - %% only so that the user has a chance to clean up - %% after init_per_testcase, even after a timetrap timeout + %% only so that the user has a chance to + %% clean up after init_per_testcase, even after + %% a timetrap timeout NewCurrConf = case CurrConf of {{Mod,Func},Conf} -> EndConfPid = - call_end_conf(Mod,Func,Pid, - {timetrap_timeout,TVal}, - Loc1,[{tc_status, - {failed, - timetrap_timeout}}|Conf], - TVal), + call_end_conf( + Mod,Func,Pid, + {timetrap_timeout,TVal}, + Loc1,[{tc_status, + {failed, + timetrap_timeout}}|Conf], + TVal), {EndConfPid,{Mod,Func},Conf}; _ -> {Mod,Func} = get_mf(Loc1), - %% The framework functions mustn't execute on this - %% group leader process or io will cause deadlock, - %% so we spawn a dedicated process for the operation - %% and let the group leader go back to handle io. + %% The framework functions mustn't + %% execute on this group leader process + %% or io will cause deadlock, so we + %% spawn a dedicated process for the + %% operation and let the group leader + %% go back to handle io. spawn_fw_call(Mod,Func,CurrConf,Pid, {timetrap_timeout,TVal}, Loc1,self()), undefined end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, - Comment,NewCurrConf) + run_test_case_msgloop(Ref,Pid,CaptureStdout, + Terminate,Comment, + NewCurrConf,Status) end; {timetrap_timeout,TVal,Loc,InitOrEnd} -> case mod_loc(Loc) of @@ -830,7 +877,17 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> {timetrap_timeout,TVal}, Loc1,self()) end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); + {testcase_aborted,ErrorMsg={user_timetrap_error,_},AbortLoc} -> + %% user timetrap function caused exit + %% during start of test case + {Mod,Func} = get_mf(mod_loc(AbortLoc)), + spawn_fw_call(Mod,Func,CurrConf,Pid, + ErrorMsg,unknown,self()), + run_test_case_msgloop(Ref,Pid,CaptureStdout, + Terminate,Comment, + undefined,Status); {testcase_aborted,AbortReason,AbortLoc} -> ErrorMsg = {testcase_aborted,AbortReason}, case mod_loc(AbortLoc) of @@ -839,33 +896,41 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, {framework_error,ErrorMsg}, unknown,self()), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, - Comment,undefined); + run_test_case_msgloop(Ref,Pid,CaptureStdout, + Terminate,Comment, + undefined,Status); Loc1 -> - %% call end_per_testcase on a separate process, only so - %% that the user has a chance to clean up after init_per_testcase, - %% even after abortion + %% call end_per_testcase on a separate process, + %% only so that the user has a chance to clean up + %% after init_per_testcase, even after abortion NewCurrConf = case CurrConf of {{Mod,Func},Conf} -> - TVal = case lists:keysearch(default_timeout,1,Conf) of - {value,{default_timeout,Tmo}} -> Tmo; - _ -> ?DEFAULT_TIMETRAP_SECS*1000 - end, + TVal = + case lists:keysearch(default_timeout, + 1, + Conf) of + {value,{default_timeout,Tmo}} -> + Tmo; + _ -> + ?DEFAULT_TIMETRAP_SECS*1000 + end, EndConfPid = - call_end_conf(Mod,Func,Pid,ErrorMsg, - Loc1, - [{tc_status,{failed,ErrorMsg}}|Conf], - TVal), + call_end_conf( + Mod,Func,Pid, + ErrorMsg,Loc1, + [{tc_status, + {failed,ErrorMsg}}|Conf],TVal), {EndConfPid,{Mod,Func},Conf}; _ -> {Mod,Func} = get_mf(Loc1), - spawn_fw_call(Mod,Func,CurrConf,Pid,ErrorMsg, - Loc1,self()), + spawn_fw_call(Mod,Func,CurrConf,Pid, + ErrorMsg,Loc1,self()), undefined end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, - Comment,NewCurrConf) + run_test_case_msgloop(Ref,Pid,CaptureStdout, + Terminate,Comment, + NewCurrConf,Status) end; killed -> %% result of an exit(TestCase,kill) call, which is the @@ -878,11 +943,14 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> spawn_fw_call(Mod,Func,CurrConf,Pid, testcase_aborted_or_killed, unknown,self()), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); {fw_error,{FwMod,FwFunc,FwError}} -> - spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,{framework_error,FwError}, + spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, + {framework_error,FwError}, unknown,self()), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); _Other -> %% the testcase has terminated because of Reason (e.g. an exit %% because a linked process failed) @@ -890,17 +958,22 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> {MF,_} -> MF; _ -> {undefined,undefined} end, - spawn_fw_call(Mod,Func,CurrConf,Pid,Reason,unknown,self()), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf) + spawn_fw_call(Mod,Func,CurrConf,Pid, + Reason,unknown,self()), + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status) end; {EndConfPid,{call_end_conf,Data,_Result}} -> case CurrConf of {EndConfPid,{Mod,Func},_Conf} -> {_Mod,_Func,TCPid,TCExitReason,Loc} = Data, - spawn_fw_call(Mod,Func,CurrConf,TCPid,TCExitReason,Loc,self()), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,undefined); + spawn_fw_call(Mod,Func,CurrConf,TCPid, + TCExitReason,Loc,self()), + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,undefined,Status); _ -> - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf) + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status) end; {_FwCallPid,fw_notify_done,{T,Value,Loc,Opts,AddToComment}} -> %% the framework has been notified, we're finished @@ -920,7 +993,8 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> end, {T,Value,Loc,Opts,Comment1} end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment,undefined); + run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal}, + Comment,undefined,Status); {'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} -> %% a framework function failed CB = os:getenv("TEST_SERVER_FRAMEWORK"), @@ -931,20 +1005,63 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> {list_to_atom(CB),Func} end, RetVal = {died,{framework_error,Loc,Error},Loc,"Framework error"}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal},Comment,undefined); + run_test_case_msgloop(Ref,Pid,CaptureStdout,{true,RetVal}, + Comment,undefined,Status); {failed,File,Line} -> put(test_server_detected_fail, [{File, Line}| get(test_server_detected_fail)]), - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); + + {user_timetrap,Pid,_TrapTime,StartTime,E={user_timetrap_error,_},_} -> + case update_user_timetraps(Pid, StartTime) of + proceed -> + self() ! {abort_current_testcase,E,Pid}; + ignore -> + ok + end, + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); + {user_timetrap,Pid,TrapTime,StartTime,ElapsedTime,Scale} -> + %% a user timetrap is triggered, ignore it if new + %% timetrap has been started since + case update_user_timetraps(Pid, StartTime) of + proceed -> + TotalTime = if is_integer(TrapTime) -> + TrapTime + ElapsedTime; + true -> + TrapTime + end, + timetrap(TrapTime, TotalTime, Pid, Scale); + ignore -> + ok + end, + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); + {timetrap_cancel_one,Handle,_From} -> + timetrap_cancel_one(Handle, false), + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); + {timetrap_cancel_all,TCPid,_From} -> + timetrap_cancel_all(TCPid, false), + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); + {get_timetrap_info,TCPid,From} -> + Info = get_timetrap_info(TCPid, false), + From ! {self(),get_timetrap_info,Info}, + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); _Other when not is_tuple(_Other) -> %% ignore anything not generated by test server - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf); + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status); _Other when element(1, _Other) /= 'EXIT', element(1, _Other) /= started, element(1, _Other) /= finished, element(1, _Other) /= print -> %% ignore anything not generated by test server - run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf) + run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, + Comment,CurrConf,Status) after Timeout -> ReturnValue end. @@ -1176,10 +1293,11 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, TimetrapData, LogOpts, TCCallback) -> put(test_server_multiply_timetraps, TimetrapData), put(test_server_logopts, LogOpts), - + FWInitResult = test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0], + {ok,Args0}), + group_leader() ! {test_case_initialized,self()}, {{Time,Value},Loc,Opts} = - case test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0], - {ok,Args0}) of + case FWInitResult of {ok,Args} -> run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback); Error = {error,_Reason} -> @@ -2020,26 +2138,56 @@ timetrap_scale_factor() -> %% %% Creates a time trap, that will kill the calling process if the %% trap is not cancelled with timetrap_cancel/1, within Timeout milliseconds. -timetrap(Timeout0) -> - Timeout = time_ms(Timeout0), - cancel_default_timetrap(), - case get(test_server_multiply_timetraps) of - undefined -> timetrap1(Timeout, true); - {undefined,false} -> timetrap1(Timeout, false); - {undefined,_} -> timetrap1(Timeout, true); - {infinity,_} -> infinity; - {_Int,_Scale} when Timeout == infinity -> infinity; - {Int,Scale} -> timetrap1(Timeout*Int, Scale) - end. +timetrap(Timeout) -> + MultAndScale = + case get(test_server_multiply_timetraps) of + undefined -> {fun(T) -> T end, true}; + {undefined,false} -> {fun(T) -> T end, false}; + {undefined,_} -> {fun(T) -> T end, true}; + {infinity,_} -> {fun(_) -> infinity end, false}; + {Int,Scale} -> {fun(infinity) -> infinity; + (T) -> T*Int end, Scale} + end, + timetrap(Timeout, Timeout, self(), MultAndScale). + +%% when the function is called from different process than +%% the test case, the test_server_multiply_timetraps data +%% is unknown and must be passed as argument +timetrap(Timeout, TCPid, MultAndScale) -> + timetrap(Timeout, Timeout, TCPid, MultAndScale). + +timetrap(Timeout0, TimeToReport0, TCPid, MultAndScale = {Multiplier,Scale}) -> + %% the time_ms call will either convert Timeout to ms or spawn a + %% user timetrap which sends the result to the IO server process + Timeout = time_ms(Timeout0, TCPid, MultAndScale), + Timeout1 = Multiplier(Timeout), + TimeToReport = if Timeout0 == TimeToReport0 -> + Timeout1; + true -> + %% only convert to ms, don't start a + %% user timetrap + time_ms_check(TimeToReport0) + end, + cancel_default_timetrap(self() == TCPid), + Handle = case Timeout1 of + infinity -> + infinity; + _ -> + spawn_link(test_server_sup,timetrap,[Timeout1,TimeToReport, + Scale,TCPid]) + end, + + %% ERROR! This sets dict on IO process instead of testcase process + %% if Timeout is return value from previous user timetrap!! -timetrap1(Timeout, Scale) -> - TCPid = self(), - Ref = spawn_link(test_server_sup,timetrap,[Timeout,Scale,TCPid]), case get(test_server_timetraps) of - undefined -> put(test_server_timetraps,[{Ref,TCPid,{Timeout,Scale}}]); - List -> put(test_server_timetraps,[{Ref,TCPid,{Timeout,Scale}}|List]) + undefined -> + put(test_server_timetraps,[{Handle,TCPid,{TimeToReport,Scale}}]); + List -> + List1 = lists:delete({infinity,TCPid,{infinity,false}}, List), + put(test_server_timetraps,[{Handle,TCPid,{TimeToReport,Scale}}|List1]) end, - Ref. + Handle. ensure_timetrap(Config) -> case get(test_server_timetraps) of @@ -2064,7 +2212,10 @@ ensure_timetrap(Config) -> put(test_server_default_timetrap, timetrap(seconds(DTmo))) end. -cancel_default_timetrap() -> +%% executing on IO process, no default timetrap ever set here +cancel_default_timetrap(false) -> + ok; +cancel_default_timetrap(true) -> case get(test_server_default_timetrap) of undefined -> ok; @@ -2082,75 +2233,175 @@ cancel_default_timetrap() -> error end. - -time_ms({hours,N}) -> hours(N); -time_ms({minutes,N}) -> minutes(N); -time_ms({seconds,N}) -> seconds(N); -time_ms({Other,_N}) -> +time_ms({hours,N}, _, _) -> hours(N); +time_ms({minutes,N}, _, _) -> minutes(N); +time_ms({seconds,N}, _, _) -> seconds(N); +time_ms({Other,_N}, _, _) -> format("=== ERROR: Invalid time specification: ~p. " "Should be seconds, minutes, or hours.~n", [Other]), exit({invalid_time_format,Other}); -time_ms(Ms) when is_integer(Ms) -> Ms; -time_ms(infinity) -> infinity; -time_ms(Fun) when is_function(Fun) -> - time_ms_apply(Fun); -time_ms({M,F,A}=MFA) when is_atom(M), is_atom(F), is_list(A) -> - time_ms_apply(MFA); -time_ms(Other) -> exit({invalid_time_format,Other}). - -time_ms_apply(Func) -> - time_ms_apply(Func, [5000,30000,60000,infinity]). - -time_ms_apply(Func, TOs) -> - Apply = fun() -> - case Func of - {M,F,A} -> - exit({self(),apply(M, F, A)}); - Fun -> - exit({self(),Fun()}) - end - end, - Pid = spawn(Apply), - Ref = monitor(process, Pid), - time_ms_wait(Func, Pid, Ref, TOs). - -time_ms_wait(Func, Pid, Ref, [TO|TOs]) -> - receive - {'DOWN',Ref,process,Pid,{Pid,Result}} -> - time_ms_check(Result); - {'DOWN',Ref,process,Pid,Error} -> - exit({timetrap_error,Error}) - after - TO -> - format("=== WARNING: No return from timetrap function ~p~n", [Func]), - time_ms_wait(Func, Pid, Ref, TOs) - end; -%% this clause will never execute if 'infinity' is in TOs list, that's ok! -time_ms_wait(Func, Pid, Ref, []) -> - demonitor(Ref), - exit(Pid, kill), - exit({timetrap_error,{no_return_from_timetrap_function,Func}}). +time_ms(Ms, _, _) when is_integer(Ms) -> Ms; +time_ms(infinity, _, _) -> infinity; +time_ms(Fun, TCPid, MultAndScale) when is_function(Fun) -> + time_ms_apply(Fun, TCPid, MultAndScale); +time_ms({M,F,A}=MFA, TCPid, MultAndScale) when is_atom(M), is_atom(F), is_list(A) -> + time_ms_apply(MFA, TCPid, MultAndScale); +time_ms(Other, _, _) -> exit({invalid_time_format,Other}). time_ms_check(MFA = {M,F,A}) when is_atom(M), is_atom(F), is_list(A) -> - exit({invalid_time_format,MFA}); + MFA; time_ms_check(Fun) when is_function(Fun) -> - exit({invalid_time_format,Fun}); + Fun; time_ms_check(Other) -> - time_ms(Other). + time_ms(Other, undefined, undefined). + +time_ms_apply(Func, TCPid, MultAndScale) -> + {_,GL} = process_info(TCPid, group_leader), + WhoAmI = self(), % either TC or IO server + T0 = now(), + UserTTSup = + spawn(fun() -> + user_timetrap_supervisor(Func, WhoAmI, TCPid, + GL, T0, MultAndScale) + end), + receive + {UserTTSup,infinity} -> + %% remember the user timetrap so that it can be cancelled + save_user_timetrap(TCPid, UserTTSup, T0), + %% we need to make sure the user timetrap function + %% gets time to execute and return + timetrap(infinity, TCPid, MultAndScale) + after 5000 -> + exit(UserTTSup, kill), + if WhoAmI /= GL -> + exit({user_timetrap_error,time_ms_apply}); + true -> + format("=== ERROR: User timetrap execution failed!", []), + ignore + end + end. + +user_timetrap_supervisor(Func, Spawner, TCPid, GL, T0, MultAndScale) -> + process_flag(trap_exit, true), + Spawner ! {self(),infinity}, + MonRef = monitor(process, TCPid), + UserTTSup = self(), + group_leader(GL, UserTTSup), + UserTT = spawn_link(fun() -> call_user_timetrap(Func, UserTTSup) end), + receive + {UserTT,Result} -> + demonitor(MonRef, [flush]), + Elapsed = trunc(timer:now_diff(now(), T0) / 1000), + try time_ms_check(Result) of + TimeVal -> + %% this is the new timetrap value to set (return value + %% from a fun or an MFA) + GL ! {user_timetrap,TCPid,TimeVal,T0,Elapsed,MultAndScale} + catch _:_ -> + %% when other than a legal timetrap value is returned + %% which will be the normal case for user timetraps + GL ! {user_timetrap,TCPid,0,T0,Elapsed,MultAndScale} + end; + {'EXIT',UserTT,Error} when Error /= normal -> + demonitor(MonRef, [flush]), + GL ! {user_timetrap,TCPid,0,T0,{user_timetrap_error,Error}, + MultAndScale}; + {'DOWN',MonRef,_,_,_} -> + demonitor(MonRef, [flush]), + exit(UserTT, kill) + end. + +call_user_timetrap(Func, Sup) when is_function(Func) -> + try Func() of + Result -> + Sup ! {self(),Result} + catch _:Error -> + exit({Error,erlang:get_stacktrace()}) + end; +call_user_timetrap({M,F,A}, Sup) -> + try apply(M,F,A) of + Result -> + Sup ! {self(),Result} + catch _:Error -> + exit({Error,erlang:get_stacktrace()}) + end. + +save_user_timetrap(TCPid, UserTTSup, StartTime) -> + %% save pid of user timetrap supervisor process so that + %% it may be stopped even before the timetrap func has returned + NewUserTT = {TCPid,{UserTTSup,StartTime}}, + case get(test_server_user_timetrap) of + undefined -> + put(test_server_user_timetrap, [NewUserTT]); + UserTTSups -> + case proplists:get_value(TCPid, UserTTSups) of + undefined -> + put(test_server_user_timetrap, + [NewUserTT | UserTTSups]); + PrevTTSup -> + %% remove prev user timetrap + remove_user_timetrap(PrevTTSup), + put(test_server_user_timetrap, + [NewUserTT | proplists:delete(TCPid, + UserTTSups)]) + end + end. + +update_user_timetraps(TCPid, StartTime) -> + %% called when a user timetrap is triggered + case get(test_server_user_timetrap) of + undefined -> + proceed; + UserTTs -> + case proplists:get_value(TCPid, UserTTs) of + {_UserTTSup,StartTime} -> % same timetrap + put(test_server_user_timetrap, + proplists:delete(TCPid, UserTTs)), + proceed; + {OtherUserTTSup,OtherStartTime} -> + case timer:now_diff(OtherStartTime, StartTime) of + Diff when Diff >= 0 -> + ignore; + _ -> + exit(OtherUserTTSup, kill), + put(test_server_user_timetrap, + proplists:delete(TCPid, UserTTs)), + proceed + end; + undefined -> + proceed + end + end. + +remove_user_timetrap(TTSup) -> + exit(TTSup, kill). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% timetrap_cancel(Handle) -> ok %% Handle = term() %% %% Cancels a time trap. -timetrap_cancel(infinity) -> - ok; timetrap_cancel(Handle) -> + timetrap_cancel_one(Handle, true). + +timetrap_cancel_one(infinity, _SendToServer) -> + ok; +timetrap_cancel_one(Handle, SendToServer) -> case get(test_server_timetraps) of - undefined -> ok; - [{Handle,_,_}] -> erase(test_server_timetraps); - Timers -> put(test_server_timetraps, - lists:keydelete(Handle, 1, Timers)) + undefined -> + ok; + [{Handle,_,_}] -> + erase(test_server_timetraps); + Timers -> + case lists:keysearch(Handle, 1, Timers) of + {value,_} -> + put(test_server_timetraps, + lists:keydelete(Handle, 1, Timers)); + false when SendToServer == true -> + group_leader() ! {timetrap_cancel_one,Handle,self()}; + false -> + ok + end end, test_server_sup:timetrap_cancel(Handle). @@ -2159,31 +2410,59 @@ timetrap_cancel(Handle) -> %% %% Cancels timetrap for current test case. timetrap_cancel() -> + timetrap_cancel_all(self(), true). + +timetrap_cancel_all(TCPid, SendToServer) -> case get(test_server_timetraps) of undefined -> ok; Timers -> - case lists:keysearch(self(), 2, Timers) of - {value,{Handle,_,_}} -> - timetrap_cancel(Handle); - _ -> + [timetrap_cancel_one(Handle, false) || + {Handle,Pid,_} <- Timers, Pid == TCPid] + end, + case get(test_server_user_timetrap) of + undefined -> + ok; + UserTTs -> + case proplists:get_value(TCPid, UserTTs) of + {UserTTSup,_StartTime} -> + remove_user_timetrap(UserTTSup), + put(test_server_user_timetrap, + proplists:delete(TCPid, UserTTs)); + undefined -> ok end - end. + end, + if SendToServer == true -> + group_leader() ! {timetrap_cancel_all,TCPid,self()}; + true -> + ok + end, + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% get_timetrap_info() -> {Timeout,Scale} | undefined %% %% Read timetrap info for current test case get_timetrap_info() -> + get_timetrap_info(self(), true). + +get_timetrap_info(TCPid, SendToServer) -> case get(test_server_timetraps) of undefined -> undefined; Timers -> - case lists:keysearch(self(), 2, Timers) of - {value,{_,_,Info}} -> - Info; - _ -> + case [Info || {Handle,Pid,Info} <- Timers, + Pid == TCPid, Handle /= infinity] of + [I|_] -> + I; + [] when SendToServer == true -> + MsgLooper = group_leader(), + MsgLooper ! {get_timetrap_info,TCPid,self()}, + receive + {MsgLooper,get_timetrap_info,I} -> I + end; + [] -> undefined end end. diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl index 1fd40d1dd9..2cc4facc32 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/test_server/src/test_server_node.erl @@ -943,12 +943,23 @@ find_rel_suse_1(Rel, RootWc) -> end. find_rel_suse_2(Rel, RootWc) -> - Wc = RootWc ++ "_" ++ Rel, - case filelib:wildcard(Wc) of - [] -> - []; - [R|_] -> - [filename:join([R,"bin","erl"])] + RelDir = filename:dirname(RootWc), + Pat = filename:basename(RootWc ++ "_" ++ Rel) ++ ".*", + case file:list_dir(RelDir) of + {ok,Dirs} -> + case lists:filter(fun(Dir) -> + case re:run(Dir, Pat) of + nomatch -> false; + _ -> true + end + end, Dirs) of + [] -> + []; + [R|_] -> + [filename:join([RelDir,R,"bin","erl"])] + end; + _ -> + [] end. %% suse_release() -> VersionString | none. diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 875f45eea6..68d6198bb7 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -21,7 +21,8 @@ %%% Purpose: Test server support functions. %%%------------------------------------------------------------------- -module(test_server_sup). --export([timetrap/2, timetrap/3, timetrap_cancel/1, capture_get/1, messages_get/1, +-export([timetrap/2, timetrap/3, timetrap/4, + timetrap_cancel/1, capture_get/1, messages_get/1, timecall/3, call_crash/5, app_test/2, check_new_crash_dumps/0, cleanup_crash_dumps/0, crash_dump_dir/0, tar_crash_dumps/0, get_username/0, get_os_family/0, @@ -44,9 +45,12 @@ %% delays during the test (e.g. if cover is running). timetrap(Timeout0, Pid) -> - timetrap(Timeout0, true, Pid). + timetrap(Timeout0, Timeout0, true, Pid). timetrap(Timeout0, Scale, Pid) -> + timetrap(Timeout0, Timeout0, Scale, Pid). + +timetrap(Timeout0, ReportTVal, Scale, Pid) -> process_flag(priority, max), Timeout = if not Scale -> Timeout0; true -> test_server:timetrap_scale_factor() * Timeout0 @@ -54,28 +58,36 @@ timetrap(Timeout0, Scale, Pid) -> TruncTO = trunc(Timeout), receive after TruncTO -> - MFLs = test_server:get_loc(Pid), - Mon = erlang:monitor(process, Pid), - Trap = - case get(test_server_init_or_end_conf) of - undefined -> - {timetrap_timeout,TruncTO,MFLs}; - InitOrEnd -> - {timetrap_timeout,TruncTO,MFLs,InitOrEnd} - end, - exit(Pid, Trap), - receive - {'DOWN', Mon, process, Pid, _} -> + case is_process_alive(Pid) of + true -> + TimeToReport = if Timeout0 == ReportTVal -> TruncTO; + true -> ReportTVal end, + MFLs = test_server:get_loc(Pid), + Mon = erlang:monitor(process, Pid), + Trap = + case get(test_server_init_or_end_conf) of + undefined -> + {timetrap_timeout,TimeToReport,MFLs}; + InitOrEnd -> + {timetrap_timeout,TimeToReport,MFLs,InitOrEnd} + end, + exit(Pid, Trap), + receive + {'DOWN', Mon, process, Pid, _} -> + ok + after 10000 -> + %% Pid is probably trapping exits, hit it harder... + catch error_logger:warning_msg( + "Testcase process ~p not " + "responding to timetrap " + "timeout:~n" + " ~p.~n" + "Killing testcase...~n", + [Pid, Trap]), + exit(Pid, kill) + end; + false -> ok - after 10000 -> - %% Pid is probably trapping exits, hit it harder... - catch error_logger:warning_msg("Testcase process ~p not " - "responding to timetrap " - "timeout:~n" - " ~p.~n" - "Killing testcase...~n", - [Pid, Trap]), - exit(Pid, kill) end end. @@ -88,8 +100,12 @@ timetrap_cancel(Handle) -> unlink(Handle), MonRef = erlang:monitor(process, Handle), exit(Handle, kill), - receive {'DOWN',MonRef,_,_,_} -> ok after 2000 -> ok end. - + receive {'DOWN',MonRef,_,_,_} -> ok + after + 2000 -> + erlang:demonitor(MonRef, [flush]), + ok + end. capture_get(Msgs) -> receive @@ -99,7 +115,6 @@ capture_get(Msgs) -> lists:reverse(Msgs) end. - messages_get(Msgs) -> receive Msg -> @@ -108,7 +123,6 @@ messages_get(Msgs) -> lists:reverse(Msgs) end. - timecall(M, F, A) -> Befor = erlang:now(), Val = apply(M, F, A), |