aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lib/common_test/src/ct.erl18
-rw-r--r--lib/common_test/src/ct_framework.erl35
-rw-r--r--lib/common_test/src/ct_logs.erl25
-rw-r--r--lib/common_test/src/ct_master.erl13
-rw-r--r--lib/common_test/src/ct_master_logs.erl175
-rw-r--r--lib/common_test/test/ct_error_SUITE.erl137
-rw-r--r--lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_5_SUITE.erl84
-rw-r--r--lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_7_SUITE.erl4
-rw-r--r--lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_utils.erl9
-rw-r--r--lib/common_test/test/ct_master_SUITE.erl99
-rw-r--r--lib/common_test/test/ct_test_support.erl22
-rw-r--r--lib/dialyzer/src/Makefile2
-rw-r--r--lib/dialyzer/src/dialyzer_analysis_callgraph.erl6
-rw-r--r--lib/dialyzer/src/dialyzer_dataflow.erl14
-rw-r--r--lib/dialyzer/src/dialyzer_gui_wx.erl57
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/maybe_servers.erl31
-rw-r--r--lib/dialyzer/vsn.mk2
-rw-r--r--lib/diameter/examples/code/GNUmakefile2
-rw-r--r--lib/diameter/examples/code/client.erl4
-rw-r--r--lib/diameter/examples/code/client_cb.erl4
-rw-r--r--lib/diameter/examples/code/peer.erl4
-rw-r--r--lib/diameter/examples/code/redirect.erl4
-rw-r--r--lib/diameter/examples/code/redirect_cb.erl2
-rw-r--r--lib/diameter/examples/code/relay.erl4
-rw-r--r--lib/diameter/examples/code/relay_cb.erl4
-rw-r--r--lib/diameter/examples/code/server.erl4
-rw-r--r--lib/diameter/examples/code/server_cb.erl6
-rw-r--r--lib/diameter/src/base/diameter.appup.src8
-rw-r--r--lib/diameter/vsn.mk2
-rw-r--r--lib/mnesia/src/mnesia_loader.erl2
-rw-r--r--lib/runtime_tools/test/Makefile1
-rw-r--r--lib/runtime_tools/test/dyntrace_SUITE.erl224
-rw-r--r--lib/ssh/src/ssh_connection_manager.erl22
-rw-r--r--lib/ssh/test/ssh_basic_SUITE.erl30
-rw-r--r--lib/ssl/doc/src/ssl.xml23
-rw-r--r--lib/ssl/src/ssl.erl15
-rw-r--r--lib/ssl/src/ssl_connection.erl39
-rw-r--r--lib/ssl/src/ssl_handshake.erl14
-rw-r--r--lib/ssl/src/ssl_tls1.erl2
-rw-r--r--lib/test_server/src/test_server.erl593
-rw-r--r--lib/test_server/src/test_server_node.erl23
-rw-r--r--lib/test_server/src/test_server_sup.erl68
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 &copy; ", 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),