aboutsummaryrefslogtreecommitdiffstats
path: root/lib/test_server
diff options
context:
space:
mode:
Diffstat (limited to 'lib/test_server')
-rw-r--r--lib/test_server/doc/src/notes.xml144
-rw-r--r--lib/test_server/doc/src/ts.xml2
-rw-r--r--lib/test_server/include/test_server.hrl5
-rw-r--r--lib/test_server/include/test_server_line.hrl3
-rw-r--r--lib/test_server/src/Makefile1
-rw-r--r--lib/test_server/src/test_server.app.src1
-rw-r--r--lib/test_server/src/test_server.erl579
-rw-r--r--lib/test_server/src/test_server_ctrl.erl139
-rw-r--r--lib/test_server/src/test_server_line.erl387
-rw-r--r--lib/test_server/src/test_server_sup.erl23
-rw-r--r--lib/test_server/src/ts.config2
-rw-r--r--lib/test_server/src/ts_erl_config.erl5
-rw-r--r--lib/test_server/src/ts_install_cth.erl17
-rw-r--r--lib/test_server/test/Makefile2
-rw-r--r--lib/test_server/test/test_server_SUITE.erl6
-rw-r--r--lib/test_server/vsn.mk2
16 files changed, 664 insertions, 654 deletions
diff --git a/lib/test_server/doc/src/notes.xml b/lib/test_server/doc/src/notes.xml
index 50923b1b03..beeff55ffe 100644
--- a/lib/test_server/doc/src/notes.xml
+++ b/lib/test_server/doc/src/notes.xml
@@ -32,6 +32,150 @@
<file>notes.xml</file>
</header>
+<section><title>Test_Server 3.4.5</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ An error in how comments are colored in the test suite
+ overview html log file has been corrected. As result, a
+ new framework callback function, format_comment/1, has
+ been introduced.</p>
+ <p>
+ Own Id: OTP-9237</p>
+ </item>
+ <item>
+ <p>
+ Test Server did not release SASL TTY handlers
+ (sasl_report_tty_h and error_logger_tty_h) properly after
+ each test run. This error has been fixed.</p>
+ <p>
+ Own Id: OTP-9311</p>
+ </item>
+ <item>
+ <p>
+ Automatically generated init- and end-configuration
+ functions for test case groups caused incorrect execution
+ order of test cases. This has been corrected.</p>
+ <p>
+ Own Id: OTP-9369</p>
+ </item>
+ <item>
+ <p>
+ If ct:log/2 was called with bad arguments, this could
+ cause the Common Test IO handling process to crash. This
+ fault has been corrected.</p>
+ <p>
+ Own Id: OTP-9371 Aux Id: OTP-8933 </p>
+ </item>
+ <item>
+ <p>
+ A bug has been fixed that made Test Server call the
+ end_tc/3 framework function with an incorrect module name
+ as first argument.</p>
+ <p>
+ Own Id: OTP-9379 Aux Id: seq11863 </p>
+ </item>
+ <item>
+ <p>
+ If end_per_testcase caused a timetrap timeout, the actual
+ test case status was discarded and the test case logged
+ as successful (even if the case had actually failed
+ before the call to end_per_testcase). This fault has been
+ fixed.</p>
+ <p>
+ Own Id: OTP-9397</p>
+ </item>
+ <item>
+ <p>
+ If a timetrap timeout occured during execution of of a
+ function in a lib module (i.e. a function called directly
+ or indirectly from a test case), the Suite argument in
+ the end_tc/3 framework callback function would not
+ correctly contain the name of the test suite, but the lib
+ module. (This would only happen if the lib module was
+ compiled with ct.hrl included). This error has been
+ solved.</p>
+ <p>
+ Own Id: OTP-9398</p>
+ </item>
+ <item>
+ <p>
+ Add a proplist() type</p>
+ <p>
+ Recently I was adding specs to an API and found that
+ there is no canonical proplist() type defined. (Thanks to
+ Ryan Zezeski)</p>
+ <p>
+ Own Id: OTP-9499</p>
+ </item>
+ <item>
+ <p> XML files have been corrected. </p>
+ <p>
+ Own Id: OTP-9550 Aux Id: OTP-9541 </p>
+ </item>
+ <item>
+ <p>
+ If a test suite would start with a test case group
+ defined without the init_per_group/2 and end_per_group/2
+ function, init_per_suite/1 would not execute initially
+ and logging of the test run would fail. This error has
+ been fixed.</p>
+ <p>
+ Own Id: OTP-9584</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ A new option, 'logopts', has been introduced, to make it
+ possible to modify some aspects of the logging behaviour
+ in Common Test (or Test Server). For example, whenever an
+ io printout is made, test_server adds newline (\n) to the
+ end of the output string. This may not always be a
+ preferred action and can therefore be disabled by means
+ of "ct_run ... -logopts no_nl" (or ct:run_test([...,
+ {logopts,[no_nl]}])). A new framework callback function,
+ get_logopts/0, has been introduced (see the ct_framework
+ module for details).</p>
+ <p>
+ Own Id: OTP-9372 Aux Id: OTP-9396 </p>
+ </item>
+ <item>
+ <p>
+ A new option, 'logopts', has been introduced, to make it
+ possible to modify some aspects of the logging behaviour
+ in Common Test (or Test Server). For example, if the html
+ version of the test suite source code should not be
+ generated during the test run (and consequently be
+ unavailable in the log file system), the feature may be
+ disabled by means of "ct_run ... -logopts no_src" (or
+ ct:run_test([..., {logopts,[no_src]}])). A new framework
+ callback function, get_logopts/0, has been introduced
+ (see the ct_framework module for details).</p>
+ <p>
+ Own Id: OTP-9396 Aux Id: seq11869, OTP-9372 </p>
+ </item>
+ <item>
+ <p>
+ It is now possible to use a tuple {M,F,A}, or a fun, as
+ timetrap specification in the suite info function or test
+ case info functions. The function must return a valid
+ timeout value, as documented in the common_test man page
+ and in the User's Guide.</p>
+ <p>
+ Own Id: OTP-9501 Aux Id: seq11894 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Test_Server 3.4.4</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/test_server/doc/src/ts.xml b/lib/test_server/doc/src/ts.xml
index 496ad3667a..f9b48d8372 100644
--- a/lib/test_server/doc/src/ts.xml
+++ b/lib/test_server/doc/src/ts.xml
@@ -77,7 +77,7 @@
</p>
<p><c>ts:install/0</c> is used if the target platform is the
same as the controller host, i.e. if you run on "local target"
- and no options are needed. Then running <c>ts:install/0</c><c>ts</c>
+ and no options are needed. Then running <c>ts:install/0</c> <c>ts</c>
will run an autoconf script for your current
environment and set up the necessary variables needed by the
test suites.
diff --git a/lib/test_server/include/test_server.hrl b/lib/test_server/include/test_server.hrl
index 4b96d84ace..36e7e1f83d 100644
--- a/lib/test_server/include/test_server.hrl
+++ b/lib/test_server/include/test_server.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2011. 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,11 +20,10 @@
-ifdef(line_trace).
-line_trace(true).
-define(line,
- put(test_server_loc,{?MODULE,?LINE}),
io:format(lists:concat([?MODULE,",",integer_to_list(?LINE),": ~p"]),
[erlang:now()]),).
-else.
--define(line,put(test_server_loc,{?MODULE,?LINE}),).
+-define(line,).
-endif.
-define(t,test_server).
-define(config,test_server:lookup_config).
diff --git a/lib/test_server/include/test_server_line.hrl b/lib/test_server/include/test_server_line.hrl
index 60ef860883..3c309d3ee5 100644
--- a/lib/test_server/include/test_server_line.hrl
+++ b/lib/test_server/include/test_server_line.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2011. 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
@@ -16,5 +16,4 @@
%%
%% %CopyrightEnd%
%%
--compile({parse_transform,test_server_line}).
diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile
index 63a585d526..4bc51873c2 100644
--- a/lib/test_server/src/Makefile
+++ b/lib/test_server/src/Makefile
@@ -43,7 +43,6 @@ MODULES= test_server_ctrl \
test_server_node \
test_server \
test_server_sup \
- test_server_line \
test_server_h \
erl2html2 \
vxworks_client
diff --git a/lib/test_server/src/test_server.app.src b/lib/test_server/src/test_server.app.src
index af2d4dc2cb..7e87583a7b 100644
--- a/lib/test_server/src/test_server.app.src
+++ b/lib/test_server/src/test_server.app.src
@@ -24,7 +24,6 @@
test_server_ctrl,
test_server,
test_server_h,
- test_server_line,
test_server_node,
test_server_sup
]},
diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl
index 591329b361..49f97686a0 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/test_server/src/test_server.erl
@@ -612,6 +612,7 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
print(minor, "Current directory is ~p\n", [Cwd]),
print_timestamp(minor,"Started at "),
TCCallback = get(test_server_testcase_callback),
+ LogOpts = get(test_server_logopts),
Ref = make_ref(),
OldGLeader = group_leader(),
%% Set ourself to group leader for the spawned process
@@ -621,7 +622,7 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
fun() ->
run_test_case_eval(Mod, Func, Args, Name, Ref,
RunInit, TimetrapData,
- TCCallback)
+ LogOpts, TCCallback)
end),
group_leader(OldGLeader, self()),
put(test_server_detected_fail, []),
@@ -733,15 +734,23 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
print(Detail,Format,Args),
run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
{comment,NewComment} ->
+ NewComment1 = test_server_ctrl:to_string(NewComment),
+ NewComment2 = test_server_sup:framework_call(format_comment,
+ [NewComment1],
+ NewComment1),
Terminate1 =
case Terminate of
{true,{Time,Value,Loc,Opts,_OldComment}} ->
- {true,{Time,Value,mod_loc(Loc),Opts,NewComment}};
+ {true,{Time,Value,mod_loc(Loc),Opts,NewComment2}};
Other ->
Other
end,
- run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate1,NewComment,CurrConf);
- {set_curr_conf,NewCurrConf} ->
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate1,NewComment2,CurrConf);
+ {read_comment,From} ->
+ From ! {self(),read_comment,Comment},
+ run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
+ {set_curr_conf,From,NewCurrConf} ->
+ From ! {self(),set_curr_conf,ok},
run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,NewCurrConf);
{'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} ->
RetVal = {Time/1000000,Value,mod_loc(Loc),Opts,Comment},
@@ -753,13 +762,12 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
case mod_loc(Loc) of
{FwMod,FwFunc,framework} ->
%% timout during framework call
- spawn_fw_call(FwMod,FwFunc,Pid,
+ spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
{framework_error,{timetrap,TVal}},
unknown,self(),Comment),
run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
Comment,undefined);
Loc1 ->
- {Mod,Func} = get_mf(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
@@ -775,11 +783,13 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
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.
- spawn_fw_call(Mod,Func,Pid,{timetrap_timeout,TVal},
+ spawn_fw_call(Mod,Func,CurrConf,Pid,
+ {timetrap_timeout,TVal},
Loc1,self(),Comment),
undefined
end,
@@ -790,12 +800,13 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
case mod_loc(Loc) of
{FwMod,FwFunc,framework} ->
%% timout during framework call
- spawn_fw_call(FwMod,FwFunc,Pid,
+ spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
{framework_error,{timetrap,TVal}},
unknown,self(),Comment);
Loc1 ->
{Mod,_Func} = get_mf(Loc1),
- spawn_fw_call(Mod,InitOrEnd,Pid,{timetrap_timeout,TVal},
+ spawn_fw_call(Mod,InitOrEnd,CurrConf,Pid,
+ {timetrap_timeout,TVal},
Loc1,self(),Comment)
end,
run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
@@ -804,13 +815,12 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
case mod_loc(AbortLoc) of
{FwMod,FwFunc,framework} ->
%% abort during framework call
- spawn_fw_call(FwMod,FwFunc,Pid,
+ spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
{framework_error,ErrorMsg},
unknown,self(),Comment),
run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
Comment,undefined);
Loc1 ->
- {Mod,Func} = get_mf(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
@@ -828,7 +838,8 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
TVal),
{EndConfPid,{Mod,Func},Conf};
_ ->
- spawn_fw_call(Mod,Func,Pid,ErrorMsg,
+ {Mod,Func} = get_mf(Loc1),
+ spawn_fw_call(Mod,Func,CurrConf,Pid,ErrorMsg,
Loc1,self(),Comment),
undefined
end,
@@ -839,17 +850,18 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
%% result of an exit(TestCase,kill) call, which is the
%% only way to abort a testcase process that traps exits
%% (see abort_current_testcase)
- spawn_fw_call(undefined,undefined,Pid,testcase_aborted_or_killed,
+ spawn_fw_call(undefined,undefined,CurrConf,Pid,
+ testcase_aborted_or_killed,
unknown,self(),Comment),
run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
{fw_error,{FwMod,FwFunc,FwError}} ->
- spawn_fw_call(FwMod,FwFunc,Pid,{framework_error,FwError},
+ spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,{framework_error,FwError},
unknown,self(),Comment),
run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
_Other ->
%% the testcase has terminated because of Reason (e.g. an exit
%% because a linked process failed)
- spawn_fw_call(undefined,undefined,Pid,Reason,
+ spawn_fw_call(undefined,undefined,CurrConf,Pid,Reason,
unknown,self(),Comment),
run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf)
end;
@@ -857,7 +869,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
case CurrConf of
{EndConfPid,{Mod,Func},_Conf} ->
{_Mod,_Func,TCPid,TCExitReason,Loc} = Data,
- spawn_fw_call(Mod,Func,TCPid,TCExitReason,Loc,self(),Comment),
+ spawn_fw_call(Mod,Func,CurrConf,TCPid,TCExitReason,Loc,self(),Comment),
run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,undefined);
_ ->
run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf)
@@ -928,7 +940,7 @@ call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) ->
ok
end,
Supervisor ! {self(),end_conf}
- end,
+ end,
Pid = spawn_link(EndConfApply),
receive
{Pid,end_conf} ->
@@ -941,50 +953,72 @@ call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) ->
end,
spawn_link(EndConfProc).
-spawn_fw_call(Mod,{init_per_testcase,Func},Pid,{timetrap_timeout,TVal}=Why,
+spawn_fw_call(Mod,{init_per_testcase,Func},_,Pid,{timetrap_timeout,TVal}=Why,
Loc,SendTo,Comment) ->
FwCall =
fun() ->
- Skip = {skip,{failed,{Mod,init_per_testcase,Why}}},
- %% if init_per_testcase fails, the test case
- %% should be skipped
- case catch do_end_tc_call(Mod,Func,{Pid,Skip,[[]]},Why) of
- {'EXIT',FwEndTCErr} ->
- exit({fw_notify_done,end_tc,FwEndTCErr});
- _ ->
- ok
- end,
- %% finished, report back
- SendTo ! {self(),fw_notify_done,
- {TVal/1000,Skip,Loc,[],Comment}}
+ Skip = {skip,{failed,{Mod,init_per_testcase,Why}}},
+ %% if init_per_testcase fails, the test case
+ %% should be skipped
+ case catch do_end_tc_call(Mod,Func, Loc, {Pid,Skip,[[]]}, Why) of
+ {'EXIT',FwEndTCErr} ->
+ exit({fw_notify_done,end_tc,FwEndTCErr});
+ _ ->
+ ok
+ end,
+ %% finished, report back
+ SendTo ! {self(),fw_notify_done,
+ {TVal/1000,Skip,Loc,[],Comment}}
end,
spawn_link(FwCall);
-spawn_fw_call(Mod,{end_per_testcase,Func},Pid,{timetrap_timeout,TVal}=Why,
- Loc,SendTo,_Comment) ->
+spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid,
+ {timetrap_timeout,TVal}=Why,_Loc,SendTo,Comment) ->
+ %%! This is a temporary fix that keeps Test Server alive during
+ %%! execution of a parallel test case group, when sometimes
+ %%! this clause gets called with EndConf == undefined. See OTP-9594
+ %%! for more info.
+ EndConf1 = if EndConf == undefined ->
+ [{tc_status,{failed,{Mod,end_per_testcase,Why}}}];
+ true ->
+ EndConf
+ end,
FwCall =
fun() ->
- Conf = [{tc_status,ok}],
- %% if end_per_testcase fails, the test case should be
- %% reported successful with a warning printed as comment
- case catch do_end_tc_call(Mod,Func,{Pid,
- {failed,{Mod,end_per_testcase,Why}},
- [Conf]}, Why) of
- {'EXIT',FwEndTCErr} ->
- exit({fw_notify_done,end_tc,FwEndTCErr});
- _ ->
- ok
- end,
- %% finished, report back
- SendTo ! {self(),fw_notify_done,
- {TVal/1000,{error,{Mod,end_per_testcase,Why}},Loc,[],
- ["<font color=\"red\">"
- "WARNING: end_per_testcase timed out!"
- "</font>"]}}
+ {RetVal,Report} =
+ case proplists:get_value(tc_status, EndConf1) of
+ undefined ->
+ E = {failed,{Mod,end_per_testcase,Why}},
+ {E,E};
+ E = {failed,Reason} ->
+ {E,{error,Reason}};
+ Result ->
+ E = {failed,{Mod,end_per_testcase,Why}},
+ {Result,E}
+ end,
+ FailLoc = proplists:get_value(tc_fail_loc, EndConf1),
+ case catch do_end_tc_call(Mod,Func, FailLoc,
+ {Pid,Report,[EndConf1]}, Why) of
+ {'EXIT',FwEndTCErr} ->
+ exit({fw_notify_done,end_tc,FwEndTCErr});
+ _ ->
+ ok
+ end,
+ %% if end_per_testcase fails a warning should be
+ %% printed as comment
+ Comment1 = if Comment == "" -> "";
+ true -> Comment ++ "<br>"
+ end,
+ %% finished, report back
+ SendTo ! {self(),fw_notify_done,
+ {TVal/1000,RetVal,FailLoc,[],
+ [Comment1,"<font color=\"red\">"
+ "WARNING: end_per_testcase timed out!"
+ "</font>"]}}
end,
spawn_link(FwCall);
-spawn_fw_call(FwMod,FwFunc,_Pid,{framework_error,FwError},_,SendTo,_Comment) ->
+spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo,_Comment) ->
FwCall =
fun() ->
test_server_sup:framework_call(report, [framework_error,
@@ -999,7 +1033,7 @@ spawn_fw_call(FwMod,FwFunc,_Pid,{framework_error,FwError},_,SendTo,_Comment) ->
end,
spawn_link(FwCall);
-spawn_fw_call(Mod,Func,Pid,Error,Loc,SendTo,Comment) ->
+spawn_fw_call(Mod,Func,_,Pid,Error,Loc,SendTo,Comment) ->
FwCall =
fun() ->
case catch fw_error_notify(Mod,Func,[],
@@ -1011,7 +1045,8 @@ spawn_fw_call(Mod,Func,Pid,Error,Loc,SendTo,Comment) ->
ok
end,
Conf = [{tc_status,{failed,timetrap_timeout}}],
- case catch do_end_tc_call(Mod,Func,{Pid,Error,[Conf]},Error) of
+ case catch do_end_tc_call(Mod,Func, Loc,
+ {Pid,Error,[Conf]},Error) of
{'EXIT',FwEndTCErr} ->
exit({fw_notify_done,end_tc,FwEndTCErr});
_ ->
@@ -1072,8 +1107,9 @@ job_proxy_msgloop() ->
%% or sends a message {failed, File, Line} to it's group_leader
run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit,
- TimetrapData, TCCallback) ->
- put(test_server_multiply_timetraps,TimetrapData),
+ TimetrapData, LogOpts, TCCallback) ->
+ put(test_server_multiply_timetraps, TimetrapData),
+ put(test_server_logopts, LogOpts),
{{Time,Value},Loc,Opts} =
case test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0],
@@ -1081,22 +1117,26 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit,
{ok,Args} ->
run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback);
Error = {error,_Reason} ->
- NewResult = do_end_tc_call(Mod,Func,{Error,Args0},
+ Where = {Mod,Func},
+ NewResult = do_end_tc_call(Mod,Func, Where, {Error,Args0},
{skip,{failed,Error}}),
- {{0,NewResult},{Mod,Func},[]};
+ {{0,NewResult},Where,[]};
{fail,Reason} ->
Conf = [{tc_status,{failed,Reason}} | hd(Args0)],
+ Where = {Mod,Func},
fw_error_notify(Mod, Func, Conf, Reason),
- NewResult = do_end_tc_call(Mod,Func, {{error,Reason},[Conf]},
+ NewResult = do_end_tc_call(Mod,Func, Where, {{error,Reason},[Conf]},
{fail,Reason}),
- {{0,NewResult},{Mod,Func},[]};
+ {{0,NewResult},Where,[]};
Skip = {skip,_Reason} ->
- NewResult = do_end_tc_call(Mod,Func,{Skip,Args0},Skip),
- {{0,NewResult},{Mod,Func},[]};
+ Where = {Mod,Func},
+ NewResult = do_end_tc_call(Mod,Func, Where, {Skip,Args0}, Skip),
+ {{0,NewResult},Where,[]};
{auto_skip,Reason} ->
- NewResult = do_end_tc_call(Mod, Func, {{skip,Reason},Args0},
+ Where = {Mod,Func},
+ NewResult = do_end_tc_call(Mod,Func, Where, {{skip,Reason},Args0},
{skip,{fw_auto_skip,Reason}}),
- {{0,NewResult},{Mod,Func},[]}
+ {{0,NewResult},Where,[]}
end,
exit({Ref,Time,Value,Loc,Opts}).
@@ -1110,18 +1150,19 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) ->
Skip = {skip,Reason} ->
Line = get_loc(),
Conf = [{tc_status,{skipped,Reason}}],
- NewRes = do_end_tc_call(Mod,Func,{Skip,[Conf]}, Skip),
+ NewRes = do_end_tc_call(Mod,Func, Line, {Skip,[Conf]}, Skip),
{{0,NewRes},Line,[]};
{skip_and_save,Reason,SaveCfg} ->
Line = get_loc(),
Conf = [{tc_status,{skipped,Reason}},{save_config,SaveCfg}],
- NewRes = do_end_tc_call(Mod, Func, {{skip,Reason},[Conf]},
- {skip, Reason}),
+ NewRes = do_end_tc_call(Mod,Func, Line, {{skip,Reason},[Conf]},
+ {skip,Reason}),
{{0,NewRes},Line,[]};
FailTC = {fail,Reason} -> % user fails the testcase
EndConf = [{tc_status,{failed,Reason}} | hd(Args)],
fw_error_notify(Mod, Func, EndConf, Reason),
- NewRes = do_end_tc_call(Mod, Func, {{error,Reason},[EndConf]},
+ NewRes = do_end_tc_call(Mod,Func, {Mod,Func},
+ {{error,Reason},[EndConf]},
FailTC),
{{0,NewRes},{Mod,Func},[]};
{ok,NewConf} ->
@@ -1129,47 +1170,61 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) ->
%% call user callback function if defined
NewConf1 = user_callback(TCCallback, Mod, Func, init, NewConf),
%% save current state in controller loop
- group_leader() ! {set_curr_conf,{{Mod,Func},NewConf1}},
+ sync_send(group_leader(),set_curr_conf,{{Mod,Func},NewConf1},
+ 5000, fun() -> exit(no_answer_from_group_leader) end),
put(test_server_loc, {Mod,Func}),
%% execute the test case
{{T,Return},Loc} = {ts_tc(Mod, Func, [NewConf1]),get_loc()},
{EndConf,TSReturn,FWReturn} =
case Return of
{E,TCError} when E=='EXIT' ; E==failed ->
+ ModLoc = mod_loc(Loc),
fw_error_notify(Mod, Func, NewConf1,
- TCError, mod_loc(Loc)),
- {[{tc_status,{failed,TCError}}|NewConf1],
+ TCError, ModLoc),
+ {[{tc_status,{failed,TCError}},
+ {tc_fail_loc,ModLoc}|NewConf1],
Return,{error,TCError}};
SaveCfg={save_config,_} ->
{[{tc_status,ok},SaveCfg|NewConf1],Return,ok};
{skip_and_save,Why,SaveCfg} ->
Skip = {skip,Why},
- {[{tc_status,{skipped,Why}},{save_config,SaveCfg}|NewConf1],
+ {[{tc_status,{skipped,Why}},
+ {save_config,SaveCfg}|NewConf1],
Skip,Skip};
{skip,Why} ->
{[{tc_status,{skipped,Why}}|NewConf1],Return,Return};
_ ->
{[{tc_status,ok}|NewConf1],Return,ok}
end,
- %% clear current state in controller loop
- group_leader() ! {set_curr_conf,undefined},
%% call user callback function if defined
EndConf1 = user_callback(TCCallback, Mod, Func, 'end', EndConf),
+ %% update current state in controller loop
+ sync_send(group_leader(),set_curr_conf,EndConf1,
+ 5000, fun() -> exit(no_answer_from_group_leader) end),
{FWReturn1,TSReturn1,EndConf2} =
case end_per_testcase(Mod, Func, EndConf1) of
SaveCfg1={save_config,_} ->
{FWReturn,TSReturn,[SaveCfg1|lists:keydelete(save_config,1,
EndConf1)]};
- {fail,ReasonToFail} -> % user has failed the testcase
+ {fail,ReasonToFail} ->
+ %% user has failed the testcase
fw_error_notify(Mod, Func, EndConf1, ReasonToFail),
{{error,ReasonToFail},{failed,ReasonToFail},EndConf1};
- {failed,{_,end_per_testcase,_}} = Failure -> % unexpected termination
+ {failed,{_,end_per_testcase,_}} = Failure when FWReturn == ok ->
+ %% unexpected termination in end_per_testcase
+ %% report this as the result to the framework
{Failure,TSReturn,EndConf1};
_ ->
+ %% test case result should be reported to framework
+ %% no matter the status of end_per_testcase
{FWReturn,TSReturn,EndConf1}
end,
+ %% clear current state in controller loop
+ sync_send(group_leader(),set_curr_conf,undefined,
+ 5000, fun() -> exit(no_answer_from_group_leader) end),
put(test_server_init_or_end_conf,undefined),
- case do_end_tc_call(Mod, Func, {FWReturn1,[EndConf2]}, TSReturn1) of
+ case do_end_tc_call(Mod,Func, Loc,
+ {FWReturn1,[EndConf2]}, TSReturn1) of
{failed,Reason} = NewReturn ->
fw_error_notify(Mod,Func,EndConf2, Reason),
{{T,NewReturn},{Mod,Func},[]};
@@ -1193,18 +1248,43 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) ->
%% call user callback function if defined
Return1 = user_callback(TCCallback, Mod, Func, 'end', Return),
{Return2,Opts} = process_return_val([Return1], Mod, Func,
- Args1, Loc, Return1),
+ Args1, {Mod,Func}, Return1),
{{T,Return2},Loc,Opts}
end.
-do_end_tc_call(M,F,Res,Return) ->
+do_end_tc_call(M,F, Loc, Res, Return) ->
+ FwMod = os:getenv("TEST_SERVER_FRAMEWORK"),
+ {Mod,Func} =
+ if FwMod == M ; FwMod == "undefined"; FwMod == false ->
+ {M,F};
+ is_list(Loc) and (length(Loc)>1) ->
+ %% If failure in other module (M) than suite, try locate
+ %% suite name in Loc list and call end_tc with Suite:TestCase
+ %% instead of M:F.
+ GetSuite = fun(S,TC) ->
+ case lists:reverse(atom_to_list(S)) of
+ [$E,$T,$I,$U,$S,$_|_] -> [{S,TC}];
+ _ -> []
+ end
+ end,
+ case lists:flatmap(fun({S,TC,_}) -> GetSuite(S,TC);
+ ({{S,TC},_}) -> GetSuite(S,TC);
+ ({S,TC}) -> GetSuite(S,TC);
+ (_) -> []
+ end, Loc) of
+ [] ->
+ {M,F};
+ [FoundSuite|_] ->
+ FoundSuite
+ end;
+ true ->
+ {M,F}
+ end,
+
Ref = make_ref(),
- case os:getenv("TEST_SERVER_FRAMEWORK") of
- FW when FW == "ct_framework";
- FW == "undefined";
- FW == false ->
+ if FwMod == "ct_framework" ; FwMod == "undefined"; FwMod == false ->
case test_server_sup:framework_call(
- end_tc, [?pl2a(M),F,Res, Return], ok) of
+ end_tc, [?pl2a(Mod),Func,Res, Return], ok) of
{fail,FWReason} ->
{failed,FWReason};
ok ->
@@ -1217,9 +1297,9 @@ do_end_tc_call(M,F,Res,Return) ->
NewReturn ->
NewReturn
end;
- Other ->
- case test_server_sup:framework_call(
- end_tc, [Other,F,Res], Ref) of
+ true ->
+ case test_server_sup:framework_call(FwMod, end_tc,
+ [?pl2a(Mod),Func,Res], Ref) of
{fail,FWReason} ->
{failed,FWReason};
_Else ->
@@ -1242,7 +1322,7 @@ process_return_val([Return], M,F,A, Loc, Final) when is_list(Return) ->
true -> % must be return value from end conf case
process_return_val1(Return, M,F,A, Loc, Final, []);
false -> % must be Config value from init conf case
- case do_end_tc_call(M,F,{ok,A}, Return) of
+ case do_end_tc_call(M, F, Loc, {ok,A}, Return) of
{failed, FWReason} = Failed ->
fw_error_notify(M,F,A, FWReason),
{Failed, []};
@@ -1259,8 +1339,9 @@ process_return_val1([Failed={E,TCError}|_], M,F,A=[Args], Loc, _, SaveOpts)
when E=='EXIT';
E==failed ->
fw_error_notify(M,F,A, TCError, mod_loc(Loc)),
- case do_end_tc_call(M,F,{{error,TCError},
- [[{tc_status,{failed,TCError}}|Args]]}, Failed) of
+ case do_end_tc_call(M,F, Loc, {{error,TCError},
+ [[{tc_status,{failed,TCError}}|Args]]},
+ Failed) of
{failed,FWReason} ->
{{failed,FWReason},SaveOpts};
NewReturn ->
@@ -1277,8 +1358,8 @@ process_return_val1([RetVal={Tag,_}|Opts], M,F,A, Loc, _, SaveOpts) when Tag==sk
process_return_val1(Opts, M,F,A, Loc, RetVal, SaveOpts);
process_return_val1([_|Opts], M,F,A, Loc, Final, SaveOpts) ->
process_return_val1(Opts, M,F,A, Loc, Final, SaveOpts);
-process_return_val1([], M,F,A, _Loc, Final, SaveOpts) ->
- case do_end_tc_call(M,F,{Final,A}, Final) of
+process_return_val1([], M,F,A, Loc, Final, SaveOpts) ->
+ case do_end_tc_call(M,F, Loc, {Final,A}, Final) of
{failed,FWReason} ->
{{failed,FWReason},SaveOpts};
NewReturn ->
@@ -1307,57 +1388,62 @@ init_per_testcase(Mod, Func, Args) ->
false -> code:load_file(Mod);
_ -> ok
end,
- %% init_per_testcase defined, returns new configuration
- case erlang:function_exported(Mod,init_per_testcase,2) of
+ case erlang:function_exported(Mod, init_per_testcase, 2) of
true ->
- case catch my_apply(Mod, init_per_testcase, [Func|Args]) of
- {'$test_server_ok',{Skip,Reason}} when Skip==skip;
- Skip==skipped ->
- {skip,Reason};
- {'$test_server_ok',Res={skip_and_save,_,_}} ->
- Res;
- {'$test_server_ok',NewConf} when is_list(NewConf) ->
- case lists:filter(fun(T) when is_tuple(T) -> false;
- (_) -> true end, NewConf) of
- [] ->
- {ok,NewConf};
- Bad ->
- group_leader() ! {printout,12,
- "ERROR! init_per_testcase has returned "
- "bad elements in Config: ~p\n",[Bad]},
- {skip,{failed,{Mod,init_per_testcase,bad_return}}}
- end;
- {'$test_server_ok',Res={fail,_Reason}} ->
- Res;
- {'$test_server_ok',_Other} ->
- group_leader() ! {printout,12,
- "ERROR! init_per_testcase did not return "
- "a Config list.\n",[]},
- {skip,{failed,{Mod,init_per_testcase,bad_return}}};
- {'EXIT',Reason} ->
- Line = get_loc(),
- FormattedLoc = test_server_sup:format_loc(mod_loc(Line)),
- group_leader() ! {printout,12,
- "ERROR! init_per_testcase crashed!\n"
- "\tLocation: ~s\n\tReason: ~p\n",
- [FormattedLoc,Reason]},
- {skip,{failed,{Mod,init_per_testcase,Reason}}};
- Other ->
- Line = get_loc(),
- FormattedLoc = test_server_sup:format_loc(mod_loc(Line)),
- group_leader() ! {printout,12,
- "ERROR! init_per_testcase thrown!\n"
- "\tLocation: ~s\n\tReason: ~p\n",
- [FormattedLoc, Other]},
- {skip,{failed,{Mod,init_per_testcase,Other}}}
- end;
+ do_init_per_testcase(Mod, [Func|Args]);
false ->
-%% Optional init_per_testcase not defined
-%% keep quiet.
+ %% Optional init_per_testcase is not defined -- keep quiet.
[Config] = Args,
{ok, Config}
end.
+do_init_per_testcase(Mod, Args) ->
+ try apply(Mod, init_per_testcase, Args) of
+ {Skip,Reason} when Skip =:= skip; Skip =:= skipped ->
+ {skip,Reason};
+ {skip_and_save,_,_}=Res ->
+ Res;
+ NewConf when is_list(NewConf) ->
+ case lists:filter(fun(T) when is_tuple(T) -> false;
+ (_) -> true end, NewConf) of
+ [] ->
+ {ok,NewConf};
+ Bad ->
+ group_leader() ! {printout,12,
+ "ERROR! init_per_testcase has returned "
+ "bad elements in Config: ~p\n",[Bad]},
+ {skip,{failed,{Mod,init_per_testcase,bad_return}}}
+ end;
+ {fail,_Reason}=Res ->
+ Res;
+ _Other ->
+ group_leader() ! {printout,12,
+ "ERROR! init_per_testcase did not return "
+ "a Config list.\n",[]},
+ {skip,{failed,{Mod,init_per_testcase,bad_return}}}
+ catch
+ throw:Other ->
+ set_loc(erlang:get_stacktrace()),
+ Line = get_loc(),
+ FormattedLoc = test_server_sup:format_loc(mod_loc(Line)),
+ group_leader() ! {printout,12,
+ "ERROR! init_per_testcase thrown!\n"
+ "\tLocation: ~s\n\tReason: ~p\n",
+ [FormattedLoc, Other]},
+ {skip,{failed,{Mod,init_per_testcase,Other}}};
+ _:Reason0 ->
+ Stk = erlang:get_stacktrace(),
+ Reason = {Reason0,Stk},
+ set_loc(Stk),
+ Line = get_loc(),
+ FormattedLoc = test_server_sup:format_loc(mod_loc(Line)),
+ group_leader() ! {printout,12,
+ "ERROR! init_per_testcase crashed!\n"
+ "\tLocation: ~s\n\tReason: ~p\n",
+ [FormattedLoc,Reason]},
+ {skip,{failed,{Mod,init_per_testcase,Reason}}}
+ end.
+
end_per_testcase(Mod, Func, Conf) ->
case erlang:function_exported(Mod,end_per_testcase,2) of
true ->
@@ -1375,57 +1461,87 @@ end_per_testcase(Mod, Func, Conf) ->
do_end_per_testcase(Mod,EndFunc,Func,Conf) ->
put(test_server_init_or_end_conf,{EndFunc,Func}),
put(test_server_loc, {Mod,{EndFunc,Func}}),
- case catch my_apply(Mod, EndFunc, [Func,Conf]) of
- {'$test_server_ok',SaveCfg={save_config,_}} ->
+ try Mod:EndFunc(Func, Conf) of
+ {save_config,_}=SaveCfg ->
SaveCfg;
- {'$test_server_ok',{fail,_}=Fail} ->
+ {fail,_}=Fail ->
Fail;
- {'$test_server_ok',_} ->
- ok;
- {'EXIT',Reason} = Why ->
- comment(io_lib:format("<font color=\"red\">"
- "WARNING: ~w crashed!"
- "</font>\n",[EndFunc])),
+ _ ->
+ ok
+ catch
+ throw:Other ->
+ Comment0 = case read_comment() of
+ "" -> "";
+ Cmt -> Cmt ++ "<br>"
+ end,
+ set_loc(erlang:get_stacktrace()),
+ comment(io_lib:format("~s<font color=\"red\">"
+ "WARNING: ~w thrown!"
+ "</font>\n",[Comment0,EndFunc])),
group_leader() ! {printout,12,
- "WARNING: ~w crashed!\n"
+ "WARNING: ~w thrown!\n"
"Reason: ~p\n"
"Line: ~s\n",
- [EndFunc, Reason,
+ [EndFunc, Other,
test_server_sup:format_loc(
mod_loc(get_loc()))]},
- {failed,{Mod,end_per_testcase,Why}};
- Other ->
- comment(io_lib:format("<font color=\"red\">"
- "WARNING: ~w thrown!"
- "</font>\n",[EndFunc])),
+ {failed,{Mod,end_per_testcase,Other}};
+ Class:Reason ->
+ Stk = erlang:get_stacktrace(),
+ set_loc(Stk),
+ Why = case Class of
+ exit -> {'EXIT',Reason};
+ error -> {'EXIT',{Reason,Stk}}
+ end,
+ Comment0 = case read_comment() of
+ "" -> "";
+ Cmt -> Cmt ++ "<br>"
+ end,
+ comment(io_lib:format("~s<font color=\"red\">"
+ "WARNING: ~w crashed!"
+ "</font>\n",[Comment0,EndFunc])),
group_leader() ! {printout,12,
- "WARNING: ~w thrown!\n"
+ "WARNING: ~w crashed!\n"
"Reason: ~p\n"
"Line: ~s\n",
- [EndFunc, Other,
+ [EndFunc, Reason,
test_server_sup:format_loc(
mod_loc(get_loc()))]},
- {failed,{Mod,end_per_testcase,Other}}
+ {failed,{Mod,end_per_testcase,Why}}
end.
get_loc() ->
- case catch test_server_line:get_lines() of
- [] ->
- get(test_server_loc);
- {'EXIT',_} ->
- get(test_server_loc);
- Loc ->
- Loc
- end.
+ get(test_server_loc).
get_loc(Pid) ->
- {dictionary,Dict} = process_info(Pid, dictionary),
- lists:foreach(fun({Key,Val}) -> put(Key,Val) end,Dict),
+ [{current_stacktrace,Stk0},{dictionary,Dict}] =
+ process_info(Pid, [current_stacktrace,dictionary]),
+ lists:foreach(fun({Key,Val}) -> put(Key, Val) end, Dict),
+ Stk = [rewrite_loc_item(Loc) || Loc <- Stk0],
+ put(test_server_loc, Stk),
get_loc().
-get_mf([{M,F,_}|_]) -> {M,F};
-get_mf([{M,F}|_]) -> {M,F};
-get_mf(_) -> {undefined,undefined}.
+%% find the latest known Suite:Testcase
+get_mf(MFs) ->
+ get_mf(MFs, {undefined,undefined}).
+
+get_mf([MF|MFs], Found) when is_tuple(MF) ->
+ ModFunc = {Mod,_} = case MF of
+ {M,F,_} -> {M,F};
+ MF -> MF
+ end,
+ case is_suite(Mod) of
+ true -> ModFunc;
+ false -> get_mf(MFs, ModFunc)
+ end;
+get_mf(_, Found) ->
+ Found.
+
+is_suite(Mod) ->
+ case lists:reverse(atom_to_list(Mod)) of
+ "ETIUS" ++ _ -> true;
+ _ -> false
+ end.
mod_loc(Loc) ->
%% handle diff line num versions
@@ -1498,16 +1614,22 @@ lookup_config(Key,Config) ->
%% timer:tc/3
ts_tc(M, F, A) ->
Before = erlang:now(),
- Val = (catch my_apply(M, F, A)),
+ Result = try
+ apply(M, F, A)
+ catch
+ Type:Reason ->
+ Stk = erlang:get_stacktrace(),
+ set_loc(Stk),
+ case Type of
+ throw ->
+ {failed,{thrown,Reason}};
+ error ->
+ {'EXIT',{Reason,Stk}};
+ exit ->
+ {'EXIT',Reason}
+ end
+ end,
After = erlang:now(),
- Result = case Val of
- {'$test_server_ok', R} ->
- R; % test case ok
- {'EXIT',_Reason} = R ->
- R; % test case crashed
- Other ->
- {failed, {thrown,Other}} % test case was thrown
- end,
Elapsed =
(element(1,After)*1000000000000
+element(2,After)*1000000+element(3,After)) -
@@ -1515,8 +1637,12 @@ ts_tc(M, F, A) ->
+element(2,Before)*1000000+element(3,Before)),
{Elapsed, Result}.
-my_apply(M, F, A) ->
- {'$test_server_ok',apply(M, F, A)}.
+set_loc(Stk) ->
+ Loc = [rewrite_loc_item(I) || {_,_,_,_}=I <- Stk],
+ put(test_server_loc, Loc).
+
+rewrite_loc_item({M,F,_,Loc}) ->
+ {M,F,proplists:get_value(line, Loc, 0)}.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1679,7 +1805,16 @@ adjusted_sleep(MSecs) ->
%% to read when using this function, rather than exit directly.
fail(Reason) ->
comment(cast_to_list(Reason)),
- exit({suite_failed,Reason}).
+ try
+ exit({suite_failed,Reason})
+ catch
+ Class:R ->
+ case erlang:get_stacktrace() of
+ [{?MODULE,fail,1,_}|Stk] -> ok;
+ Stk -> ok
+ end,
+ erlang:raise(Class, R, Stk)
+ end.
cast_to_list(X) when is_list(X) -> X;
cast_to_list(X) when is_atom(X) -> atom_to_list(X);
@@ -1693,7 +1828,16 @@ cast_to_list(X) -> lists:flatten(io_lib:format("~p", [X])).
%% Immediately calls exit. Included because test suites are easier
%% to read when using this function, rather than exit directly.
fail() ->
- exit(suite_failed).
+ try
+ exit(suite_failed)
+ catch
+ Class:R ->
+ case erlang:get_stacktrace() of
+ [{?MODULE,fail,0,_}|Stk] -> ok;
+ Stk -> ok
+ end,
+ erlang:raise(Class, R, Stk)
+ end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% break(Comment) -> ok
@@ -1845,11 +1989,54 @@ 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_spec,Other});
+ exit({invalid_time_format,Other});
time_ms(Ms) when is_integer(Ms) -> Ms;
time_ms(infinity) -> infinity;
-time_ms(Other) -> exit({invalid_time_spec,Other}).
+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_check(MFA = {M,F,A}) when is_atom(M), is_atom(F), is_list(A) ->
+ exit({invalid_time_format,MFA});
+time_ms_check(Fun) when is_function(Fun) ->
+ exit({invalid_time_format,Fun});
+time_ms_check(Other) ->
+ time_ms(Other).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timetrap_cancel(Handle) -> ok
@@ -1897,6 +2084,19 @@ hours(N) -> trunc(N * 1000 * 60 * 60).
minutes(N) -> trunc(N * 1000 * 60).
seconds(N) -> trunc(N * 1000).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% sync_send(Pid,Tag,Msg,Timeout,DoAfter) -> Result
+%%
+sync_send(Pid,Tag,Msg,Timeout,DoAfter) ->
+ Pid ! {Tag,self(),Msg},
+ receive
+ {Pid,Tag,Result} ->
+ Result
+ after Timeout ->
+ DoAfter()
+ end.
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timecall(M,F,A) -> {Time,Val}
%% Time = float()
@@ -2283,6 +2483,21 @@ comment(String) ->
group_leader() ! {comment,String},
ok.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% read_comment() -> string()
+%%
+%% Read the current comment string stored in
+%% state during test case execution.
+read_comment() ->
+ MsgLooper = group_leader(),
+ MsgLooper ! {read_comment,self()},
+ receive
+ {MsgLooper,read_comment,Comment} ->
+ Comment
+ after
+ 5000 ->
+ ""
+ end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% os_type() -> OsType
diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl
index de9b962dfc..4fad86d16d 100644
--- a/lib/test_server/src/test_server_ctrl.erl
+++ b/lib/test_server/src/test_server_ctrl.erl
@@ -173,7 +173,7 @@
%%% TEST_SERVER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([output/2, print/2, print/3, print_timestamp/2]).
-export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]).
--export([format/1, format/2, format/3]).
+-export([format/1, format/2, format/3, to_string/1]).
-export([get_target_info/0]).
-export([get_hosts/0]).
-export([get_target_os_type/0]).
@@ -1297,6 +1297,7 @@ terminate(_Reason, State) ->
end,
kill_all_jobs(State#state.jobs),
test_server_node:stop(State#state.target_info),
+ test_server_h:restore(),
ok.
kill_all_jobs([{_Name,JobPid}|Jobs]) ->
@@ -1349,6 +1350,10 @@ init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev},
put(test_server_minor_level, MinLev),
put(test_server_random_seed, proplists:get_value(random_seed, ExtraTools)),
put(test_server_testcase_callback, TCCallback),
+ %% before first print, read and set logging options
+ LogOpts = test_server_sup:framework_call(get_logopts, [], []),
+ put(test_server_logopts, LogOpts),
+ put(test_server_log_nl, not lists:member(no_nl, LogOpts)),
StartedExtraTools = start_extra_tools(ExtraTools),
{TimeMy,Result} = ts_tc(Mod, Func, Args),
put(test_server_common_io_handler, undefined),
@@ -1664,6 +1669,11 @@ do_test_cases(TopCases, SkipCases,
Config, TimetrapData) when is_list(TopCases),
is_tuple(TimetrapData) ->
start_log_file(),
+ FwMod =
+ case os:getenv("TEST_SERVER_FRAMEWORK") of
+ FW when FW =:= false; FW =:= "undefined" -> ?MODULE;
+ FW -> list_to_atom(FW)
+ end,
case collect_all_cases(TopCases, SkipCases) of
{error,Why} ->
print(1, "Error starting: ~p", [Why]),
@@ -1676,11 +1686,11 @@ do_test_cases(TopCases, SkipCases,
put(test_server_cases, N),
put(test_server_case_num, 0),
TestSpec =
- add_init_and_end_per_suite(TestSpec0, undefined, undefined),
-
+ add_init_and_end_per_suite(TestSpec0, undefined, undefined, FwMod),
TI = get_target_info(),
- print(1, "Starting test~s", [print_if_known(N, {", ~w test cases",[N]},
- {" (with repeated test cases)",[]})]),
+ print(1, "Starting test~s",
+ [print_if_known(N, {", ~w test cases",[N]},
+ {" (with repeated test cases)",[]})]),
Test = get(test_server_name),
test_server_sup:framework_call(report, [tests_start,{Test,N}]),
@@ -1709,13 +1719,12 @@ do_test_cases(TopCases, SkipCases,
print(html, "<br>Used Erlang ~s in <tt>~s</tt>.\n",
[erlang:system_info(version), code:root_dir()]),
- case os:getenv("TEST_SERVER_FRAMEWORK") of
- FW when FW =:= false; FW =:= "undefined" ->
+ if FwMod == ?MODULE ->
print(html, "<p>Target:<br>\n"),
print_who(TI#target_info.host, TI#target_info.username),
print(html, "<br>Used Erlang ~s in <tt>~s</tt>.\n",
[TI#target_info.version, TI#target_info.root_dir]);
- _ ->
+ true ->
case test_server_sup:framework_call(target_info, []) of
TargetInfo when is_list(TargetInfo),
length(TargetInfo) > 0 ->
@@ -1884,11 +1893,12 @@ start_minor_log_file1(Mod, Func, LogDir, AbsName) ->
[]),
SrcListing = downcase(cast_to_list(Mod)) ++ ?src_listing_ext,
- case filelib:is_file(filename:join(LogDir, SrcListing)) of
- true ->
+ case {filelib:is_file(filename:join(LogDir, SrcListing)),
+ lists:member(no_src, get(test_server_logopts))} of
+ {true,false} ->
print(Lev, "<a href=\"~s#~s\">source code for ~p:~p/1</a>\n",
[SrcListing,Func,Mod,Func]);
- false -> ok
+ _ -> ok
end,
io:fwrite(Fd, "<pre>\n", []),
@@ -2005,54 +2015,69 @@ copy_html_file(Src, DestDir) ->
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% add_init_and_end_per_suite(TestSpec, Mod, Ref) -> NewTestSpec
+%% add_init_and_end_per_suite(TestSpec, Mod, Ref, FwMod) -> NewTestSpec
%%
%% Expands TestSpec with an initial init_per_suite, and a final
%% end_per_suite element, per each discovered suite in the list.
-add_init_and_end_per_suite([{make,_,_}=Case|Cases], LastMod, LastRef) ->
- [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef)];
-add_init_and_end_per_suite([{skip_case,{{Mod,all},_}}=Case|Cases], LastMod, LastRef)
- when Mod =/= LastMod ->
+add_init_and_end_per_suite([{make,_,_}=Case|Cases], LastMod, LastRef, FwMod) ->
+ [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
+add_init_and_end_per_suite([{skip_case,{{Mod,all},_}}=Case|Cases], LastMod,
+ LastRef, FwMod) when Mod =/= LastMod ->
{PreCases, NextMod, NextRef} =
do_add_end_per_suite_and_skip(LastMod, LastRef, Mod),
- PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)];
-add_init_and_end_per_suite([{skip_case,{{Mod,_},_}}=Case|Cases], LastMod, LastRef)
- when Mod =/= LastMod ->
+ PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)];
+add_init_and_end_per_suite([{skip_case,{{Mod,_},_}}=Case|Cases], LastMod,
+ LastRef, FwMod) when Mod =/= LastMod ->
{PreCases, NextMod, NextRef} =
do_add_init_and_end_per_suite(LastMod, LastRef, Mod),
- PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)];
-add_init_and_end_per_suite([{skip_case,{conf,_,{Mod,_},_}}=Case|Cases], LastMod, LastRef)
- when Mod =/= LastMod ->
+ PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)];
+add_init_and_end_per_suite([{skip_case,{conf,_,{Mod,_},_}}=Case|Cases], LastMod,
+ LastRef, FwMod) when Mod =/= LastMod ->
{PreCases, NextMod, NextRef} =
do_add_init_and_end_per_suite(LastMod, LastRef, Mod),
- PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)];
-add_init_and_end_per_suite([{skip_case,_}=Case|Cases], LastMod, LastRef) ->
- [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef)];
-add_init_and_end_per_suite([{conf,_,_,{Mod,_}}=Case|Cases], LastMod, LastRef)
- when Mod =/= LastMod ->
+ PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)];
+add_init_and_end_per_suite([{skip_case,_}=Case|Cases], LastMod, LastRef, FwMod) ->
+ [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
+add_init_and_end_per_suite([{conf,Ref,Props,{FwMod,Func}}=Case|Cases], LastMod,
+ LastRef, FwMod) ->
+ %% if Mod == FwMod, this conf test is (probably) a test case group where
+ %% the init- and end-functions are missing in the suite, and if so,
+ %% the suite name should be stored as {suite,Suite} in Props
+ case proplists:get_value(suite, Props) of
+ Suite when Suite =/= undefined, Suite =/= LastMod ->
+ {PreCases, NextMod, NextRef} =
+ do_add_init_and_end_per_suite(LastMod, LastRef, Suite),
+ Case1 = {conf,Ref,proplists:delete(suite,Props),{FwMod,Func}},
+ PreCases ++ [Case1|add_init_and_end_per_suite(Cases, NextMod,
+ NextRef, FwMod)];
+ _ ->
+ [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)]
+ end;
+add_init_and_end_per_suite([{conf,_,_,{Mod,_}}=Case|Cases], LastMod,
+ LastRef, FwMod) when Mod =/= LastMod, Mod =/= FwMod ->
{PreCases, NextMod, NextRef} =
do_add_init_and_end_per_suite(LastMod, LastRef, Mod),
- PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)];
-add_init_and_end_per_suite([{conf,_,_,_}=Case|Cases], LastMod, LastRef) ->
- [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef)];
-add_init_and_end_per_suite([{Mod,_}=Case|Cases], LastMod, LastRef)
- when Mod =/= LastMod ->
+ PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)];
+add_init_and_end_per_suite([{conf,_,_,_}=Case|Cases], LastMod, LastRef, FwMod) ->
+ [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
+add_init_and_end_per_suite([{Mod,_}=Case|Cases], LastMod, LastRef, FwMod)
+ when Mod =/= LastMod, Mod =/= FwMod ->
{PreCases, NextMod, NextRef} =
do_add_init_and_end_per_suite(LastMod, LastRef, Mod),
- PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)];
-add_init_and_end_per_suite([{Mod,_,_}=Case|Cases], LastMod, LastRef)
- when Mod =/= LastMod ->
+ PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)];
+add_init_and_end_per_suite([{Mod,_,_}=Case|Cases], LastMod, LastRef, FwMod)
+ when Mod =/= LastMod, Mod =/= FwMod ->
{PreCases, NextMod, NextRef} =
do_add_init_and_end_per_suite(LastMod, LastRef, Mod),
- PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef)];
-add_init_and_end_per_suite([Case|Cases], LastMod, LastRef)->
- [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef)];
-add_init_and_end_per_suite([], _LastMod, undefined) ->
+ PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)];
+add_init_and_end_per_suite([Case|Cases], LastMod, LastRef, FwMod)->
+ [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
+add_init_and_end_per_suite([], _LastMod, undefined, _FwMod) ->
[];
-add_init_and_end_per_suite([], _LastMod, skipped_suite) ->
+add_init_and_end_per_suite([], _LastMod, skipped_suite, _FwMod) ->
[];
-add_init_and_end_per_suite([], LastMod, LastRef) ->
+add_init_and_end_per_suite([], LastMod, LastRef, _FwMod) ->
[{conf,LastRef,[],{LastMod,end_per_suite}}].
do_add_init_and_end_per_suite(LastMod, LastRef, Mod) ->
@@ -2101,7 +2126,12 @@ run_test_cases(TestSpec, Config, TimetrapData) ->
maybe_open_job_sock(),
- html_convert_modules(TestSpec, Config),
+ case lists:member(no_src, get(test_server_logopts)) of
+ true ->
+ ok;
+ false ->
+ html_convert_modules(TestSpec, Config)
+ end,
run_test_cases_loop(TestSpec, [Config], TimetrapData, [], []),
@@ -2310,7 +2340,8 @@ run_test_cases_loop([{auto_skip_case,{Type,Ref,Case,Comment},SkipMode}|Cases],
handle_test_case_io_and_status(),
set_io_buffering(undefined),
{Mod,Func} = skip_case(auto, Ref, 0, Case, Comment, false, SkipMode),
- test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]),
+ test_server_sup:framework_call(report, [tc_auto_skip,
+ {?pl2a(Mod),Func,Comment}]),
run_test_cases_loop(Cases, Config, TimetrapData, ParentMode,
delete_status(Ref, Status));
_ ->
@@ -2318,7 +2349,8 @@ run_test_cases_loop([{auto_skip_case,{Type,Ref,Case,Comment},SkipMode}|Cases],
%% parallel group (io buffering is active)
wait_for_cases(Ref),
{Mod,Func} = skip_case(auto, Ref, 0, Case, Comment, true, SkipMode),
- test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]),
+ test_server_sup:framework_call(report, [tc_auto_skip,
+ {?pl2a(Mod),Func,Comment}]),
case CurrIOHandler of
{Ref,_} ->
%% current_io_handler was set by start conf of this
@@ -3959,8 +3991,11 @@ progress(ok, _CaseNum, Mod, Func, _Loc, RetVal, Time,
case RetVal of
{comment,RetComment} ->
String = to_string(RetComment),
+ HtmlCmt = test_server_sup:framework_call(format_comment,
+ [String],
+ String),
print(major, "=result ok: ~s", [String]),
- "<td>" ++ String ++ "</td>";
+ "<td>" ++ HtmlCmt ++ "</td>";
_ ->
print(major, "=result ok", []),
case Comment0 of
@@ -4345,14 +4380,18 @@ output_to_fd(Fd, [$=|Msg], internal) ->
io:put_chars(Fd, [$=]),
io:put_chars(Fd, Msg),
io:put_chars(Fd, "\n");
+
output_to_fd(Fd, Msg, internal) ->
io:put_chars(Fd, [$=,$=,$=,$ ]),
io:put_chars(Fd, Msg),
io:put_chars(Fd, "\n");
+
output_to_fd(Fd, Msg, _Sender) ->
io:put_chars(Fd, Msg),
- io:put_chars(Fd, "\n").
-
+ case get(test_server_log_nl) of
+ false -> ok;
+ _ -> io:put_chars(Fd, "\n")
+ end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timestamp_filename_get(Leader) -> string()
@@ -4665,7 +4704,7 @@ collect_case_invoke(Mod, Case, MFA, St) ->
collect_subcases(Mod, Case, MFA, St, Suite)
end;
_ ->
- Suite = test_server_sup:framework_call(get_suite, [?pl2a(Mod),Case],[]),
+ Suite = test_server_sup:framework_call(get_suite, [?pl2a(Mod),Case], []),
collect_subcases(Mod, Case, MFA, St, Suite)
end.
@@ -4674,13 +4713,13 @@ collect_subcases(Mod, Case, MFA, St, Suite) ->
[] when Case == all -> {ok,[],St};
[] when element(1, Case) == conf -> {ok,[],St};
[] -> {ok,[MFA],St};
-%%%! --- START Kept for backwards compatibilty ---
+%%%! --- START Kept for backwards compatibility ---
%%%! Requirements are not used
{req,ReqList} ->
collect_case_deny(Mod, Case, MFA, ReqList, [], St);
{req,ReqList,SubCases} ->
collect_case_deny(Mod, Case, MFA, ReqList, SubCases, St);
-%%%! --- END Kept for backwards compatibilty ---
+%%%! --- END Kept for backwards compatibility ---
{Skip,Reason} when Skip==skip; Skip==skipped ->
{ok,[{skip_case,{MFA,Reason}}],St};
{error,Reason} ->
diff --git a/lib/test_server/src/test_server_line.erl b/lib/test_server/src/test_server_line.erl
deleted file mode 100644
index 848a9c23dd..0000000000
--- a/lib/test_server/src/test_server_line.erl
+++ /dev/null
@@ -1,387 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2004-2010. 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(test_server_line).
-
-%% User interface
--export([get_lines/0]).
--export([clear/0]).
-
-%% Parse transform functions
--export([parse_transform/2]).
--export(['$test_server_line'/3]).
--export(['$test_server_lineQ'/3]).
--export([trace_line/3]).
-
--define(TEST_SERVER_LINE_SIZE, 10).
-%-define(STORAGE_FUNCTION, '$test_server_line').
--define(STORAGE_FUNCTION, '$test_server_lineQ').
-
--include("test_server.hrl").
-
--record(vars, {module, % atom() Module name
- function, % atom() Function name
- arity, % int() Function arity
- lines, % [int()] seen lines
- is_guard=false, % boolean()
- no_lines=[], % [{atom(),integer()}]
- % Functions to exclude
- line_trace=false
- }).
-
-
-
-
-%% Process dictionary littering variant
-%%
-
-'$test_server_line'(Mod, Func, Line) ->
- {Prev,Next} =
- case get('$test_server_line') of
- I when is_integer(I) ->
- if 1 =< I, I < ?TEST_SERVER_LINE_SIZE -> {I,I+1};
- true -> {?TEST_SERVER_LINE_SIZE,1}
- end;
- _ -> {?TEST_SERVER_LINE_SIZE,1}
- end,
- PrevTag = {'$test_server_line',Prev},
- case get(PrevTag) of
- {Mod,Func,_} -> put(PrevTag, {Mod,Func,Line});
- _ ->
- put({'$test_server_line',Next}, {Mod,Func,Line}),
- put('$test_server_line', Next)
- end, ok.
-
-test_server_line_get() ->
- case get('$test_server_line') of
- I when is_integer(I), 1 =< I, I =< ?TEST_SERVER_LINE_SIZE ->
- test_server_line_get_1(?TEST_SERVER_LINE_SIZE, I, []);
- _ -> []
- end.
-
-test_server_line_get_1(0, _I, R) ->
- R;
-test_server_line_get_1(Cnt, I, R) ->
- J = if I < ?TEST_SERVER_LINE_SIZE -> I+1;
- true -> 1 end,
- case get({'$test_server_line',J}) of
- undefined ->
- %% Less than ?TEST_SERVER_LINE_SIZE number of lines stored
- %% Start from line 1 and stop at actutual number of lines
- case get({'$test_server_line',1}) of
- undefined -> R; % no lines at all stored
- E -> test_server_line_get_1(I-1,1,[E|R])
- end;
- E ->
- test_server_line_get_1(Cnt-1, J, [E|R])
- end.
-
-test_server_line_clear() ->
- Is = lists:seq(1,?TEST_SERVER_LINE_SIZE),
- lists:foreach(fun (I) -> erase({'$test_server_line',I}) end, Is),
- erase('$test_server_line'),
- ok.
-
-
-%% Queue variant, uses just one process dictionary entry
-%%
-
-'$test_server_lineQ'(Mod, Func, Line) ->
- case get('$test_server_lineQ') of
- {I,Q} when is_integer(I), 1 =< I, I =< ?TEST_SERVER_LINE_SIZE ->
- case queue:head(Q) of
- {Mod,Func,_} ->
- %% Replace queue head
- put('$test_server_lineQ',
- {I,queue:cons({Mod,Func,Line}, queue:tail(Q))});
- _ when I < ?TEST_SERVER_LINE_SIZE ->
- put('$test_server_lineQ',
- {I+1,queue:cons({Mod,Func,Line}, Q)});
- _ ->
- %% Waste last in queue
- put('$test_server_lineQ',
- {I,queue:cons({Mod,Func,Line}, queue:lait(Q))})
- end;
- _ ->
- Q = queue:new(),
- put('$test_server_lineQ', {1,queue:cons({Mod,Func,Line}, Q)})
- end, ok.
-
-%test_server_lineQ_get() ->
-% case get('$test_server_lineQ') of
-% {I,Q} when integer(I), 1 =< I, I =< ?TEST_SERVER_LINE_SIZE ->
-% queue:to_list(Q);
-% _ -> []
-% end.
-
-test_server_lineQ_clear() ->
- erase('$test_server_lineQ'),
- ok.
-
-
-%% Get line - check if queue or dictionary is used, then get the lines
-%%
-
-get_lines() ->
- case get('$test_server_lineQ') of
- {I,Q} when is_integer(I), 1 =< I, I =< ?TEST_SERVER_LINE_SIZE ->
- queue:to_list(Q);
- _ ->
- test_server_line_get()
- end.
-
-%% Clear all dictionary entries
-%%
-clear() ->
- test_server_line_clear(),
- test_server_lineQ_clear().
-
-
-trace_line(Mod,Func,Line) ->
- io:format(lists:concat([Mod,":",Func,",",integer_to_list(Line),": ~p"]),
- [erlang:now()]).
-
-
-%%%=================================================================
-%%%========= **** PARSE TRANSFORM **** ========================
-%%%=================================================================
-parse_transform(Forms, _Options) ->
- transform(Forms, _Options).
-
-%% forms(Fs) -> lists:map(fun (F) -> form(F) end, Fs).
-
-transform(Forms, _Options)->
- Vars0 = #vars{},
- {ok, MungedForms, _Vars} = transform(Forms, [], Vars0),
- MungedForms.
-
-
-transform([Form|Forms], MungedForms, Vars) ->
- case munge(Form, Vars) of
- ignore ->
- transform(Forms, MungedForms, Vars);
- {MungedForm, Vars2} ->
- transform(Forms, [MungedForm|MungedForms], Vars2)
- end;
-transform([], MungedForms, Vars) ->
- {ok, lists:reverse(MungedForms), Vars}.
-
-%% This code traverses the abstract code, stored as the abstract_code
-%% chunk in the BEAM file, as described in absform(3) for Erlang/OTP R8B
-%% (Vsn=abstract_v2).
-%% The abstract format after preprocessing differs slightly from the abstract
-%% format given eg using epp:parse_form, this has been noted in comments.
-munge(Form={attribute,_,module,Module}, Vars) ->
- Vars2 = Vars#vars{module=Module},
- {Form, Vars2};
-
-munge(Form={attribute,_,no_lines,Funcs}, Vars) ->
- Vars2 = Vars#vars{no_lines=Funcs},
- {Form, Vars2};
-
-munge(Form={attribute,_,line_trace,_}, Vars) ->
- Vars2 = Vars#vars{line_trace=true},
- {Form, Vars2};
-
-munge({function,0,module_info,_Arity,_Clauses}, _Vars) ->
- ignore; % module_info will be added again when the forms are recompiled
-munge(Form = {function,Line,Function,Arity,Clauses}, Vars) ->
- case lists:member({Function,Arity},Vars#vars.no_lines) of
- true ->
- %% Line numbers in this function shall not be stored
- {Form,Vars};
- false ->
- Vars2 = Vars#vars{function=Function,
- arity=Arity,
- lines=[]},
- {MungedClauses, Vars3} = munge_clauses(Clauses, Vars2, []),
- {{function,Line,Function,Arity,MungedClauses}, Vars3}
- end;
-munge(Form, Vars) -> % attributes
- {Form, Vars}.
-
-munge_clauses([{clause,Line,Pattern,Guards,Body}|Clauses], Vars, MClauses) ->
- {MungedGuards, _Vars} = munge_exprs(Guards, Vars#vars{is_guard=true},[]),
- {MungedBody, Vars2} = munge_body(Body, Vars, []),
- munge_clauses(Clauses, Vars2,
- [{clause,Line,Pattern,MungedGuards,MungedBody}|
- MClauses]);
-munge_clauses([], Vars, MungedClauses) ->
- {lists:reverse(MungedClauses), Vars}.
-
-munge_body([Expr|Body], Vars, MungedBody) ->
- %% Here is the place to add a call to storage function!
- Line = element(2, Expr),
- Lines = Vars#vars.lines,
- case lists:member(Line,Lines) of
- true -> % already a bump at this line!
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- munge_body(Body, Vars2, [MungedExpr|MungedBody]);
- false ->
- Bump = {call, 0, {remote,0,
- {atom,0,?MODULE},
- {atom,0,?STORAGE_FUNCTION}},
- [{atom,0,Vars#vars.module},
- {atom, 0, Vars#vars.function},
- {integer, 0, Line}]},
- Lines2 = [Line|Lines],
-
- {MungedExpr, Vars2} = munge_expr(Expr, Vars#vars{lines=Lines2}),
- MungedBody2 =
- if Vars#vars.line_trace ->
- LineTrace = {call, 0, {remote,0,
- {atom,0,?MODULE},
- {atom,0,trace_line}},
- [{atom,0,Vars#vars.module},
- {atom, 0, Vars#vars.function},
- {integer, 0, Line}]},
- [MungedExpr,LineTrace,Bump|MungedBody];
- true ->
- [MungedExpr,Bump|MungedBody]
- end,
- munge_body(Body, Vars2, MungedBody2)
- end;
-munge_body([], Vars, MungedBody) ->
- {lists:reverse(MungedBody), Vars}.
-
-munge_expr({match,Line,ExprL,ExprR}, Vars) ->
- {MungedExprL, Vars2} = munge_expr(ExprL, Vars),
- {MungedExprR, Vars3} = munge_expr(ExprR, Vars2),
- {{match,Line,MungedExprL,MungedExprR}, Vars3};
-munge_expr({tuple,Line,Exprs}, Vars) ->
- {MungedExprs, Vars2} = munge_exprs(Exprs, Vars, []),
- {{tuple,Line,MungedExprs}, Vars2};
-munge_expr({record,Line,Expr,Exprs}, Vars) ->
- %% Only for Vsn=raw_abstract_v1
- {MungedExprName, Vars2} = munge_expr(Expr, Vars),
- {MungedExprFields, Vars3} = munge_exprs(Exprs, Vars2, []),
- {{record,Line,MungedExprName,MungedExprFields}, Vars3};
-munge_expr({record_field,Line,ExprL,ExprR}, Vars) ->
- %% Only for Vsn=raw_abstract_v1
- {MungedExprL, Vars2} = munge_expr(ExprL, Vars),
- {MungedExprR, Vars3} = munge_expr(ExprR, Vars2),
- {{record_field,Line,MungedExprL,MungedExprR}, Vars3};
-munge_expr({cons,Line,ExprH,ExprT}, Vars) ->
- {MungedExprH, Vars2} = munge_expr(ExprH, Vars),
- {MungedExprT, Vars3} = munge_expr(ExprT, Vars2),
- {{cons,Line,MungedExprH,MungedExprT}, Vars3};
-munge_expr({op,Line,Op,ExprL,ExprR}, Vars) ->
- {MungedExprL, Vars2} = munge_expr(ExprL, Vars),
- {MungedExprR, Vars3} = munge_expr(ExprR, Vars2),
- {{op,Line,Op,MungedExprL,MungedExprR}, Vars3};
-munge_expr({op,Line,Op,Expr}, Vars) ->
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- {{op,Line,Op,MungedExpr}, Vars2};
-munge_expr({'catch',Line,Expr}, Vars) ->
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- {{'catch',Line,MungedExpr}, Vars2};
-munge_expr({call,Line1,{remote,Line2,ExprM,ExprF},Exprs},
- Vars) when Vars#vars.is_guard==false->
- {MungedExprM, Vars2} = munge_expr(ExprM, Vars),
- {MungedExprF, Vars3} = munge_expr(ExprF, Vars2),
- {MungedExprs, Vars4} = munge_exprs(Exprs, Vars3, []),
- {{call,Line1,{remote,Line2,MungedExprM,MungedExprF},MungedExprs}, Vars4};
-munge_expr({call,Line1,{remote,_Line2,_ExprM,ExprF},Exprs},
- Vars) when Vars#vars.is_guard==true ->
- %% Difference in abstract format after preprocessing: BIF calls in guards
- %% are translated to {remote,...} (which is not allowed as source form)
- %% NOT NECESSARY FOR Vsn=raw_abstract_v1
- munge_expr({call,Line1,ExprF,Exprs}, Vars);
-munge_expr({call,Line,Expr,Exprs}, Vars) ->
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- {MungedExprs, Vars3} = munge_exprs(Exprs, Vars2, []),
- {{call,Line,MungedExpr,MungedExprs}, Vars3};
-munge_expr({lc,Line,Expr,LC}, Vars) ->
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- {MungedLC, Vars3} = munge_lc(LC, Vars2, []),
- {{lc,Line,MungedExpr,MungedLC}, Vars3};
-munge_expr({block,Line,Body}, Vars) ->
- {MungedBody, Vars2} = munge_body(Body, Vars, []),
- {{block,Line,MungedBody}, Vars2};
-munge_expr({'if',Line,Clauses}, Vars) ->
- {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []),
- {{'if',Line,MungedClauses}, Vars2};
-munge_expr({'case',Line,Expr,Clauses}, Vars) ->
- {MungedExpr,Vars2} = munge_expr(Expr,Vars),
- {MungedClauses,Vars3} = munge_clauses(Clauses, Vars2, []),
- {{'case',Line,MungedExpr,MungedClauses}, Vars3};
-munge_expr({'receive',Line,Clauses}, Vars) ->
- {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []),
- {{'receive',Line,MungedClauses}, Vars2};
-munge_expr({'receive',Line,Clauses,Expr,Body}, Vars) ->
- {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []),
- {MungedExpr, Vars3} = munge_expr(Expr, Vars2),
- {MungedBody, Vars4} = munge_body(Body, Vars3, []),
- {{'receive',Line,MungedClauses,MungedExpr,MungedBody}, Vars4};
-munge_expr({'try',Line,Exprs,Clauses,CatchClauses,After}, Vars) ->
- {MungedExprs, Vars1} = munge_exprs(Exprs, Vars, []),
- {MungedClauses, Vars2} = munge_clauses(Clauses, Vars1, []),
- {MungedCatchClauses, Vars3} = munge_clauses(CatchClauses, Vars2, []),
- {MungedAfter, Vars4} = munge_body(After, Vars3, []),
- {{'try',Line,MungedExprs,MungedClauses,MungedCatchClauses,MungedAfter},
- Vars4};
-%% Difference in abstract format after preprocessing: Funs get an extra
-%% element Extra.
-%% NOT NECESSARY FOR Vsn=raw_abstract_v1
-munge_expr({'fun',Line,{function,Name,Arity},_Extra}, Vars) ->
- {{'fun',Line,{function,Name,Arity}}, Vars};
-munge_expr({'fun',Line,{clauses,Clauses},_Extra}, Vars) ->
- {MungedClauses,Vars2}=munge_clauses(Clauses, Vars, []),
- {{'fun',Line,{clauses,MungedClauses}}, Vars2};
-munge_expr({'fun',Line,{clauses,Clauses}}, Vars) ->
- %% Only for Vsn=raw_abstract_v1
- {MungedClauses,Vars2}=munge_clauses(Clauses, Vars, []),
- {{'fun',Line,{clauses,MungedClauses}}, Vars2};
-munge_expr({bc,Line,Expr,LC}, Vars) ->
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- {MungedLC, Vars3} = munge_lc(LC, Vars2, []),
- {{bc,Line,MungedExpr,MungedLC}, Vars3};
-munge_expr(Form, Vars) -> % var|char|integer|float|string|atom|nil|bin|eof
- {Form, Vars}.
-
-munge_exprs([Expr|Exprs], Vars, MungedExprs) when Vars#vars.is_guard==true,
- is_list(Expr) ->
- {MungedExpr, _Vars} = munge_exprs(Expr, Vars, []),
- munge_exprs(Exprs, Vars, [MungedExpr|MungedExprs]);
-munge_exprs([Expr|Exprs], Vars, MungedExprs) ->
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- munge_exprs(Exprs, Vars2, [MungedExpr|MungedExprs]);
-munge_exprs([], Vars, MungedExprs) ->
- {lists:reverse(MungedExprs), Vars}.
-
-munge_lc([{generate,Line,Pattern,Expr}|LC], Vars, MungedLC) ->
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- munge_lc(LC, Vars2, [{generate,Line,Pattern,MungedExpr}|MungedLC]);
-munge_lc([{b_generate,Line,Pattern,Expr}|LC], Vars, MungedLC) ->
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- munge_lc(LC, Vars2, [{b_generate,Line,Pattern,MungedExpr}|MungedLC]);
-munge_lc([Expr|LC], Vars, MungedLC) ->
- {MungedExpr, Vars2} = munge_expr(Expr, Vars),
- munge_lc(LC, Vars2, [MungedExpr|MungedLC]);
-munge_lc([], Vars, MungedLC) ->
- {lists:reverse(MungedLC), Vars}.
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl
index 53dfb45e3a..875f45eea6 100644
--- a/lib/test_server/src/test_server_sup.erl
+++ b/lib/test_server/src/test_server_sup.erl
@@ -26,7 +26,7 @@
cleanup_crash_dumps/0, crash_dump_dir/0, tar_crash_dumps/0,
get_username/0, get_os_family/0,
hostatom/0, hostatom/1, hoststr/0, hoststr/1,
- framework_call/2,framework_call/3,
+ framework_call/2,framework_call/3,framework_call/4,
format_loc/1, package_str/1, package_atom/1,
call_trace/1]).
-include("test_server_internal.hrl").
@@ -51,18 +51,19 @@ timetrap(Timeout0, Scale, Pid) ->
Timeout = if not Scale -> Timeout0;
true -> test_server:timetrap_scale_factor() * Timeout0
end,
+ TruncTO = trunc(Timeout),
receive
- after trunc(Timeout) ->
- Line = test_server:get_loc(Pid),
+ 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,trunc(Timeout),Line};
+ {timetrap_timeout,TruncTO,MFLs};
InitOrEnd ->
- {timetrap_timeout,trunc(Timeout),Line,InitOrEnd}
+ {timetrap_timeout,TruncTO,MFLs,InitOrEnd}
end,
- exit(Pid,Trap),
+ exit(Pid, Trap),
receive
{'DOWN', Mon, process, Pid, _} ->
ok
@@ -540,8 +541,9 @@ format_loc({Mod,Func}) when is_atom(Func) ->
format_loc({Mod,Line}) when is_integer(Line) ->
%% ?line macro is used
ModStr = package_str(Mod),
- case lists:reverse(ModStr) of
- [$E,$T,$I,$U,$S,$_|_] ->
+ case {lists:member(no_src, get(test_server_logopts)),
+ lists:reverse(ModStr)} of
+ {false,[$E,$T,$I,$U,$S,$_|_]} ->
io_lib:format("{~s,<a href=\"~s~s#~w\">~w</a>}",
[ModStr,downcase(ModStr),?src_listing_ext,
round_to_10(Line),Line]);
@@ -557,8 +559,9 @@ format_loc1([{Mod,Func,Line}|Rest]) ->
[" ",format_loc1({Mod,Func,Line}),",\n"|format_loc1(Rest)];
format_loc1({Mod,Func,Line}) ->
ModStr = package_str(Mod),
- case lists:reverse(ModStr) of
- [$E,$T,$I,$U,$S,$_|_] ->
+ case {lists:member(no_src, get(test_server_logopts)),
+ lists:reverse(ModStr)} of
+ {false,[$E,$T,$I,$U,$S,$_|_]} ->
io_lib:format("{~s,~w,<a href=\"~s~s#~w\">~w</a>}",
[ModStr,Func,downcase(ModStr),?src_listing_ext,
round_to_10(Line),Line]);
diff --git a/lib/test_server/src/ts.config b/lib/test_server/src/ts.config
index f021f5958b..cf3d269616 100644
--- a/lib/test_server/src/ts.config
+++ b/lib/test_server/src/ts.config
@@ -12,7 +12,7 @@
% "10.10.0.1", %IP string
% {10,10,0,1}, %IP tuple
% ["my_ip4_host"], %Any aliases
-% "::ffff:10.10.0.1", %IPv6 string (compatibilty addr)
+% "::ffff:10.10.0.1", %IPv6 string (compatibility addr)
% {0,0,0,0,0,65535,2570,1} %IPv6 tuple
% }}.
diff --git a/lib/test_server/src/ts_erl_config.erl b/lib/test_server/src/ts_erl_config.erl
index 640c8ddc9f..3b41f90d55 100644
--- a/lib/test_server/src/ts_erl_config.erl
+++ b/lib/test_server/src/ts_erl_config.erl
@@ -222,7 +222,6 @@ erl_interface(Vars,OsType) ->
end,
CrossCompile = case OsType of
vxworks -> "true";
- ose -> "true";
_ -> "false"
end,
[{erl_interface_libpath, filename:nativename(LibPath)},
@@ -329,8 +328,6 @@ sock_libraries({win32, _}) ->
sock_libraries({unix, _}) ->
""; % Included in general libraries if needed.
sock_libraries(vxworks) ->
- "";
-sock_libraries(ose) ->
"".
link_library(LibName,{win32, _}) ->
@@ -339,8 +336,6 @@ link_library(LibName,{unix, _}) ->
"lib" ++ LibName ++ ".a";
link_library(LibName,vxworks) ->
"lib" ++ LibName ++ ".a";
-link_library(_LibName,ose) ->
- "";
link_library(_LibName,_Other) ->
exit({link_library, not_supported}).
diff --git a/lib/test_server/src/ts_install_cth.erl b/lib/test_server/src/ts_install_cth.erl
index c5444a342f..a41916fd0a 100644
--- a/lib/test_server/src/ts_install_cth.erl
+++ b/lib/test_server/src/ts_install_cth.erl
@@ -49,8 +49,7 @@
-include_lib("kernel/include/file.hrl").
--type proplist() :: list({atom(),term()}).
--type config() :: proplist().
+-type config() :: proplists:proplist().
-type reason() :: term().
-type skip_or_fail() :: {skip, reason()} |
{auto_skip, reason()} |
@@ -65,19 +64,19 @@ id(_Opts) ->
?MODULE.
%% @doc Always called before any other callback function.
--spec init(Id :: term(), Opts :: proplist()) ->
- State :: #state{}.
+-spec init(Id :: term(), Opts :: proplists:proplist()) ->
+ {ok, State :: #state{}}.
init(_Id, Opts) ->
Nodenames = proplists:get_value(nodenames, Opts, 0),
Nodes = proplists:get_value(nodes, Opts, 0),
TSConfDir = proplists:get_value(ts_conf_dir, Opts),
TargetSystem = proplists:get_value(target_system, Opts, install_local),
InstallOpts = proplists:get_value(install_opts, Opts, []),
- #state{ nodenames = Nodenames,
- nodes = Nodes,
- ts_conf_dir = TSConfDir,
- target_system = TargetSystem,
- install_opts = InstallOpts }.
+ {ok, #state{ nodenames = Nodenames,
+ nodes = Nodes,
+ ts_conf_dir = TSConfDir,
+ target_system = TargetSystem,
+ install_opts = InstallOpts } }.
%% @doc Called before init_per_suite is called.
-spec pre_init_per_suite(Suite :: atom(),
diff --git a/lib/test_server/test/Makefile b/lib/test_server/test/Makefile
index ab72a9d579..198440bb17 100644
--- a/lib/test_server/test/Makefile
+++ b/lib/test_server/test/Makefile
@@ -85,7 +85,7 @@ release_spec: opt
release_tests_spec: make_emakefile
$(INSTALL_DIR) $(RELSYSDIR)
$(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) $(COVERFILE) $(RELSYSDIR)
- $(INSTALL_DATA) test_server.spec test_server.cover $(RELSYSDIR)
+ $(INSTALL_DATA) test_server_test_lib.hrl test_server.spec test_server.cover $(RELSYSDIR)
chmod -R u+w $(RELSYSDIR)
@tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -)
diff --git a/lib/test_server/test/test_server_SUITE.erl b/lib/test_server/test/test_server_SUITE.erl
index 4c344717f0..a8532b08ab 100644
--- a/lib/test_server/test/test_server_SUITE.erl
+++ b/lib/test_server/test/test_server_SUITE.erl
@@ -119,6 +119,11 @@ test_server_conf02_SUITE(Config) ->
run_test_server_tests(SuiteName, NCases, NFail, NExpected, NSucc,
NUsrSkip, NAutoSkip,
NActualSkip, NActualFail, NActualSucc, Config) ->
+
+ ct:log("See test case log files under:~n~p~n",
+ [filename:join([proplists:get_value(priv_dir, Config),
+ SuiteName++".logs"])]),
+
Node = proplists:get_value(node, Config),
{ok,_Pid} = rpc:call(Node,test_server_ctrl, start, []),
rpc:call(Node,
@@ -132,6 +137,7 @@ run_test_server_tests(SuiteName, NCases, NFail, NExpected, NSucc,
end),
rpc:call(Node,test_server_ctrl, stop, []),
+
{ok,#suite{ n_cases = NCases,
n_cases_failed = NFail,
n_cases_expected = NExpected,
diff --git a/lib/test_server/vsn.mk b/lib/test_server/vsn.mk
index 1dd4a84ce9..563c1b6db6 100644
--- a/lib/test_server/vsn.mk
+++ b/lib/test_server/vsn.mk
@@ -1,2 +1,2 @@
-TEST_SERVER_VSN = 3.4.4
+TEST_SERVER_VSN = 3.4.5
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 09:49:31 +0000