aboutsummaryrefslogtreecommitdiffstats
path: root/lib/test_server
diff options
context:
space:
mode:
Diffstat (limited to 'lib/test_server')
-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.erl231
-rw-r--r--lib/test_server/src/test_server_line.erl387
-rw-r--r--lib/test_server/src/test_server_sup.erl11
7 files changed, 152 insertions, 487 deletions
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..2cb33a9a69 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/test_server/src/test_server.erl
@@ -759,7 +759,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
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,6 +774,7 @@ 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
@@ -810,7 +810,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
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,6 +827,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) ->
TVal),
{EndConfPid,{Mod,Func},Conf};
_ ->
+ {Mod,Func} = get_mf(Loc1),
spawn_fw_call(Mod,Func,Pid,ErrorMsg,
Loc1,self(),Comment),
undefined
@@ -1307,57 +1307,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 +1380,79 @@ 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 ->
+ _ ->
+ ok
+ catch
+ throw:Other ->
+ set_loc(erlang:get_stacktrace()),
comment(io_lib:format("<font color=\"red\">"
- "WARNING: ~w crashed!"
+ "WARNING: ~w thrown!"
"</font>\n",[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 ->
+ {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,
comment(io_lib:format("<font color=\"red\">"
- "WARNING: ~w thrown!"
+ "WARNING: ~w crashed!"
"</font>\n",[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 +1525,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 +1548,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 +1716,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 +1739,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
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..ec9be52bd3 100644
--- a/lib/test_server/src/test_server_sup.erl
+++ b/lib/test_server/src/test_server_sup.erl
@@ -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
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-02 07:45:19 +0000