Don't include tail-recursive calls in stacktraces

The stacktrace in debugger-generated exceptions should be
as similar to stacktraces in BEAM-generated exceptions as
possible.

4 files changed, 195 insertions, 36 deletions

diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl
index 251c11fdb9..70600121b3 100644
--- a/lib/debugger/src/dbg_ieval.erl
+++ b/lib/debugger/src/dbg_ieval.erl
@@ -403,6 +403,7 @@ eval_mfa(Debugged, M, F, As, #ieval{level=Le}=Ieval0) ->
     Ieval = Ieval0#ieval{level=Le+1,top=true},
     try do_eval_function(M, F, As, Bs, extern, Ieval) of
 	{value, Val, _Bs} ->
+	    trace(return, {Le,Val}),
 	    {ready, Val}
     catch
 	exit:{Debugged, Reason} ->
@@ -414,38 +415,41 @@ eval_mfa(Debugged, M, F, As, #ieval{level=Le}=Ieval0) ->
     end.
 
 eval_function(Mod, Name, As, Bs, Called, Ieval0, Lc) ->
-    Ieval = dbg_istk:push(Bs, Ieval0, Lc),
-    Res = do_eval_function(Mod, Name, As, Bs, Called, Ieval),
-    dbg_istk:pop(),
-    Res.
+    Tail = Lc andalso get(trace_stack) =:= no_tail,
+    case Tail of
+	false ->
+	    Ieval = dbg_istk:push(Bs, Ieval0, Lc),
+	    {value,Val,_} = do_eval_function(Mod, Name, As, Bs, Called, Ieval),
+	    dbg_istk:pop(),
+	    trace(return, {Ieval#ieval.level,Val}),
+	    {value,Val,Bs};
+	true ->
+	    do_eval_function(Mod, Name, As, Bs, Called, Ieval0)
+    end.
 
-do_eval_function(Mod, Fun, As0, Bs0, _, Ieval) when is_function(Fun);
+do_eval_function(Mod, Fun, As0, Bs0, _, Ieval0) when is_function(Fun);
 						    Mod =:= ?MODULE,
 						    Fun =:= eval_fun ->
-    #ieval{level=Le, line=Li, top=Top} = Ieval,
+    #ieval{level=Le,line=Li,top=Top} = Ieval0,
     case lambda(Fun, As0) of
-	{Cs,Module,Name,As,Bs} ->
+	{[{clause,Fc,_,_,_}|_]=Cs,Module,Name,As,Bs} ->
+	    Ieval = Ieval0#ieval{module=Module,function=Name,
+				 arguments=As0,line=Fc},
 	    trace(call_fun, {Le,Li,Name,As}),
-	    {value, Val, _Bs} =
-		fnk_clauses(Cs, Module, Name, As, Bs, Ieval),
-	    trace(return, {Le,Val}),
-	    {value, Val, Bs0};
+	    fnk_clauses(Cs, As, Bs, Ieval);
 
 	not_interpreted when Top -> % We are leaving interpreted code
 	    trace(call_fun, {Le,Li,Fun,As0}),
 	    {value, {dbg_apply,erlang,apply,[Fun,As0]}, Bs0};
 	not_interpreted ->
 	    trace(call_fun, {Le,Li,Fun,As0}),
-	    {value, Val, _Bs} =
-		debugged_cmd({apply,erlang,apply,[Fun,As0]}, Bs0, Ieval),
-	    trace(return, {Le,Val}),
-	    {value, Val, Bs0};
+	    debugged_cmd({apply,erlang,apply,[Fun,As0]}, Bs0, Ieval0);
 
 	{error,Reason} ->
 	    %% It's ok not to push anything in this case, the error
 	    %% reason contains information about the culprit
 	    %% ({badarity,{{Mod,Name},As}})
-	    exception(error, Reason, Bs0, Ieval)
+	    exception(error, Reason, Bs0, Ieval0)
     end;
 
 %% Common Test adaptation
@@ -459,19 +463,12 @@ do_eval_function(Mod, Name, As0, Bs0, Called, Ieval0) ->
     Ieval = Ieval0#ieval{module=Mod,function=Name,arguments=As0},
     case get_function(Mod, Name, As0, Called) of
 	Cs when is_list(Cs) ->
-	    {value, Val, _Bs} =
-		fnk_clauses(Cs, Mod, Name, As0, erl_eval:new_bindings(),
-			    Ieval),
-	    trace(return, {Le,Val}),
-	    {value, Val, Bs0};
+	    fnk_clauses(Cs, As0, erl_eval:new_bindings(), Ieval);
 
 	not_interpreted when Top -> % We are leaving interpreted code
 	    {value, {dbg_apply,Mod,Name,As0}, Bs0};
 	not_interpreted ->
-	    {value, Val, _Bs} =
-		debugged_cmd({apply,Mod,Name,As0}, Bs0, Ieval),
-	    trace(return, {Le,Val}),
-	    {value, Val, Bs0};
+	    debugged_cmd({apply,Mod,Name,As0}, Bs0, Ieval);
 
 	undef ->
 	    exception(error, undef, Bs0, Ieval, true)
@@ -575,22 +572,20 @@ cached(Key) ->
 
 %% Try to find a matching function clause
 %% #ieval.level is set, the other fields must be set in this function
-fnk_clauses([{clause,Line,Pars,Gs,Body}|Cs], M, F, As, Bs0, Ieval) ->
+fnk_clauses([{clause,Line,Pars,Gs,Body}|Cs], As, Bs0, Ieval) ->
     case head_match(Pars, As, [], Bs0) of
 	{match,Bs1} ->
 	    Bs = add_bindings(Bs1, Bs0),
 	    case guard(Gs, Bs) of
 		true ->
-		    seq(Body, Bs,
-			Ieval#ieval{line=Line,
-				    module=M,function=F,arguments=As});
+		    seq(Body, Bs, Ieval#ieval{line=Line});
 		false ->
-		    fnk_clauses(Cs, M, F, As, Bs0, Ieval)
+		    fnk_clauses(Cs, As, Bs0, Ieval)
 	    end;
 	nomatch ->
-	    fnk_clauses(Cs, M, F, As, Bs0, Ieval)
+	    fnk_clauses(Cs, As, Bs0, Ieval)
     end;
-fnk_clauses([], _M, _F, _As, Bs, Ieval) ->
+fnk_clauses([], _As, Bs, Ieval) ->
     exception(error, function_clause, Bs, Ieval, true).
 
 seq([E], Bs0, Ieval) ->
diff --git a/lib/debugger/src/dbg_istk.erl b/lib/debugger/src/dbg_istk.erl
index 21365fa4e9..92dc802da4 100644
--- a/lib/debugger/src/dbg_istk.erl
+++ b/lib/debugger/src/dbg_istk.erl
@@ -31,7 +31,8 @@
 	{level,					%Level
 	 mfa,					%{Mod,Func,Args|Arity}|{Fun,Args}
 	 line,					%Line called from
-	 bindings
+	 bindings,
+	 lc					%Last call (true|false)
 	 }).
 
 init() ->
@@ -63,7 +64,7 @@ init(Stack) ->
 
 push(Bs, #ieval{level=Le,module=Mod,function=Name,
 		arguments=As,line=Li}=Ieval, Lc) ->
-    Entry = #e{level=Le,mfa={Mod,Name,As},line=Li,bindings=Bs},
+    Entry = #e{level=Le,mfa={Mod,Name,As},line=Li,bindings=Bs,lc=Lc},
     case get(trace_stack) of
 	false ->
 	    Ieval#ieval{level=Le+1};
@@ -141,6 +142,8 @@ delayed_stacktrace(no_args, Ieval) ->
 	    [ArityOnly || {ArityOnly,_} <- Stack]
     end.
 
+stacktrace(N, [#e{lc=true}|T], Acc) ->
+    stacktrace(N, T, Acc);
 stacktrace(N, [E|T], []) ->
     stacktrace(N-1, T, [normalize(E)]);
 stacktrace(N, [E|T], [{P,_}|_]=Acc) when N > 0 ->
diff --git a/lib/debugger/test/int_eval_SUITE.erl b/lib/debugger/test/int_eval_SUITE.erl
index f36ed213d1..99af1a8a2e 100644
--- a/lib/debugger/test/int_eval_SUITE.erl
+++ b/lib/debugger/test/int_eval_SUITE.erl
@@ -28,7 +28,7 @@
 	 bifs_outside_erlang/1, spawning/1, applying/1,
 	 catch_and_throw/1, external_call/1, test_module_info/1,
 	 apply_interpreted_fun/1, apply_uninterpreted_fun/1,
-	 interpreted_exit/1, otp_8310/1]).
+	 interpreted_exit/1, otp_8310/1, stacktrace/1]).
 
 %% Helpers.
 -export([applier/3]).
@@ -44,7 +44,7 @@ all() ->
     [bifs_outside_erlang, spawning, applying,
      catch_and_throw, external_call, test_module_info,
      apply_interpreted_fun, apply_uninterpreted_fun,
-     interpreted_exit, otp_8310].
+     interpreted_exit, otp_8310, stacktrace].
 
 groups() -> 
     [].
@@ -277,6 +277,37 @@ applier(M, F, A) ->
     io:format("~p:~p(~p) => ~p\n", [M,F,A,Res]),
     Res.
 
+stacktrace(Config) when is_list(Config) ->
+    ?line {done,Stk} = do_eval(Config, stacktrace),
+    ?line 13 = length(Stk),
+    ?line OldStackTraceFlag = int:stack_trace(),
+    ?line int:stack_trace(no_tail),
+    try
+	?line Res = spawn_eval(fun() -> stacktrace:stacktrace() end),
+	?line io:format("\nInterpreted (no_tail):\n~p", [Res]),
+	?line {done,Stk} = Res
+	after
+	    ?line int:stack_trace(OldStackTraceFlag)
+	end,
+    ok.
+
+
+do_eval(Config, Mod) ->
+    ?line DataDir = ?config(data_dir, Config),
+    ?line ok = file:set_cwd(DataDir),
+
+    ?line {ok,Mod} = compile:file(Mod, [report,debug_info]),
+    ?line {module,Mod} = code:load_file(Mod),
+    ?line CompiledRes = Mod:Mod(),
+    ?line ok = io:format("Compiled:\n~p", [CompiledRes]),
+    io:nl(),
+
+    ?line {module,Mod} = int:i(Mod),
+    ?line IntRes = Mod:Mod(),
+    ?line ok = io:format("Interpreted:\n~p", [IntRes]),
+
+    ?line CompiledRes = IntRes.
+
 %%
 %% Evaluate in another process, to prevent the test_case process to become
 %% interpreted.
diff --git a/lib/debugger/test/int_eval_SUITE_data/stacktrace.erl b/lib/debugger/test/int_eval_SUITE_data/stacktrace.erl
new file mode 100644
index 0000000000..a42dfca433
--- /dev/null
+++ b/lib/debugger/test/int_eval_SUITE_data/stacktrace.erl
@@ -0,0 +1,130 @@
+-module(stacktrace).
+-export([?MODULE/0]).
+
+?MODULE() ->
+    OldDepth = erlang:system_flag(backtrace_depth, 32),
+    done = (catch do_try()),
+    Stk = trim(erlang:get_stacktrace()),
+    erlang:system_flag(backtrace_depth, OldDepth),
+    {done,Stk}.
+
+trim([{int_eval_SUITE,_,_}|_]) ->
+    [];
+trim([H|T]) ->
+    [H|trim(T)];
+trim([]) -> [].
+
+do_try() ->
+    try
+	0 = id(42)
+    catch
+	error:{badmatch,42} ->
+	    do_try2()				%Tail-recursive
+    end.
+
+do_try2() ->
+    try
+	0 = id(42)
+    catch
+	error:{badmatch,42} ->
+	    do_try3()				%Not tail-recursive
+    end,
+    ?LINE.
+
+do_try3() ->
+    try id(42) of
+	42 -> do_try4()				%Tail-recursive
+    catch
+	error:ignore ->				%Should never catch
+	    ?LINE
+    end.
+
+do_try4() ->
+    try
+	do_recv()				%Not tail-recursive
+    catch
+	error:ignore ->				%Should never catch
+	    ?LINE
+    end.
+
+do_recv() ->
+    self() ! x,
+    receive
+	x -> do_recv2()				%Not tail-recursive
+    end,
+    ?LINE.
+
+do_recv2() ->
+    self() ! y,
+    receive
+	y -> do_recv3()				%Tail-recursive
+    end.
+
+do_recv3() ->
+    receive
+	after 0 -> do_recv4()			%Tail-recursive
+    end.
+
+do_recv4() ->
+    receive
+	after 0 -> do_if(true)			%Not tail-recursive
+    end,
+    ?LINE.
+
+do_if(Bool) ->
+    if
+	Bool -> do_if2(Bool)			%Tail-recursive
+    end.
+
+do_if2(Bool) ->
+    if
+	Bool -> do_case(Bool)			%Not tail-recursive
+    end,
+    ?LINE.
+
+
+do_case(Bool) ->
+    case Bool of
+	true -> do_case2(Bool)			%Tail-recursive
+    end.
+
+do_case2(Bool) ->
+    case Bool of
+	true -> do_fun(Bool)			%Not tail-recursive
+    end,
+    ?LINE.
+
+do_fun(Bool) ->
+    F = fun(true) ->
+		do_fun2(Bool)			%Tail-recursive
+	end,
+    F(Bool).					%Tail-recursive
+
+do_fun2(Bool) ->
+    F = fun(true) ->
+		cons(Bool)			%Tail-recursive
+	end,
+    F(Bool),					%Not tail-recursive
+    ?LINE.
+
+cons(Bool) ->
+    [Bool|tuple()].
+
+tuple() ->
+    {ok,op()}.
+
+op() ->
+    1 + lc().
+
+lc() ->
+    [done() || true].
+
+done() ->
+    tail(100),
+    throw(done).
+
+tail(0) -> ok;
+tail(N) -> tail(N-1).
+
+id(I) ->
+    I.