ct: Include actual error reason in CTH failure test log

lib/common_test/src/ct_hooks.erl

@@ -1164,13 +1164,13 @@ catch_apply(M,F,A, Default, Fallback) ->
 catch_apply(M,F,A) ->
     try
         erlang:apply(M,F,A)
-    catch _:Reason:Trace ->
+    catch Class:Reason:Trace ->
             ct_logs:log("Suite Hook","Call to CTH failed: ~w:~tp",
-                            [error,{Reason,Trace}]),
+                            [Class,{Reason,Trace}]),
             throw({error_in_cth_call,
-                   lists:flatten(
-                     io_lib:format("~w:~tw/~w CTH call failed",
-                                   [M,F,length(A)]))})
+                   {lists:flatten(
+                      io_lib:format("~w:~tw/~w CTH call failed: ~w:~tp",
+                                    [M,F,length(A),Class,Reason])), Trace}})
     end.
 
 process_hooks_order(init, Return) when is_list(Return) ->

lib/common_test/src/test_server_ctrl.erl

@@ -138,6 +138,9 @@
 -define(user_skip_color, "#FF8000").
 -define(sortable_table_name, "SortableTable").
 
+-define(reason_prefix, "=== Reason: ").
+-define(exception_prefix, "exception error: ").
+
 -record(state,{jobs=[], levels={1,19,10}, reject_io_reqs=false,
 	       multiply_timetraps=1, scale_timetraps=true,
 	       create_priv_dir=auto_per_run, finish=false,
@@ -4141,8 +4144,8 @@ progress(failed, CaseNum, Mod, Func, GrName, Loc, {testcase_aborted,Reason}, T,
     FormatLoc = test_server_sup:format_loc(Loc),
     print(minor, "=== Location: ~ts", [FormatLoc]),
     print(minor,
-          "~ts",
-	  [escape_chars(io_lib:format("=== Reason: {testcase_aborted,~tp}",
+          "=== Reason: ~ts",
+          [escape_chars(io_lib:format("{testcase_aborted,~tp}",
 				     [Reason]))]),
     failed;
 
@@ -4179,10 +4182,10 @@ progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, T,
 	  "<td>~ts</td></tr>\n",
 	  [TimeStr,Comment]),
     print(minor, "=== Location: ~w", [unknown]),
-    {FStr,FormattedReason} = format_exception(Reason),
+    {FStr,FormattedReason} = format_exception(Reason, string:length(?reason_prefix)),
     print(minor,
-          "~ts",
-	  [escape_chars(io_lib:format("=== Reason: " ++ FStr, [FormattedReason]))]),
+          ?reason_prefix ++ "~ts",
+          [escape_chars(io_lib:format(FStr, [FormattedReason]))]),
     failed;
 
 progress(failed, CaseNum, Mod, Func, GrName, Loc, Reason, T,
@@ -4215,10 +4218,9 @@ progress(failed, CaseNum, Mod, Func, GrName, Loc, Reason, T,
 	  [TimeStr,FormatLastLoc,Comment]),
     FormatLoc = test_server_sup:format_loc(LocMin),
     print(minor, "=== Location: ~ts", [FormatLoc]),
-    {FStr,FormattedReason} = format_exception(Reason),
-    print(minor, "~ts",
-          ["=== Reason: " ++
-           escape_chars(io_lib:format(FStr, [FormattedReason]))]),
+    {FStr,FormattedReason} = format_exception(Reason, string:length(?reason_prefix)),
+    print(minor, ?reason_prefix ++ "~ts",
+          [escape_chars(io_lib:format(FStr, [FormattedReason]))]),
     failed;
 
 progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, T,
@@ -4423,37 +4425,47 @@ get_font_style1(default) ->
 %% test_server node with init argument 'test_server_format_exception'
 %% set to false.
 
-format_exception(Reason={_Error,Stack}) when is_list(Stack) ->
+format_exception(Reason={_Error,Stack}, Shift) when is_list(Stack) ->
     case get_fw_mod(undefined) of
-	undefined ->
-	    case application:get_env(test_server, format_exception) of
-		{ok,false} ->
-		    {"~tp",Reason};
-		_ ->
-		    do_format_exception(Reason)
-	    end;
-	FW ->
-	    case application:get_env(FW, format_exception) of
-		{ok,false} ->
-		    {"~tp",Reason};
-		_ ->
-		    do_format_exception(Reason)
-	    end
+        undefined ->
+            case application:get_env(test_server, format_exception) of
+                {ok,false} ->
+                    {"~tp",Reason};
+                _ ->
+                    do_format_exception(Reason, Shift)
+            end;
+        FW ->
+            case application:get_env(FW, format_exception) of
+                {ok,false} ->
+                    {"~tp",Reason};
+                _ ->
+                    do_format_exception(Reason, Shift)
+            end
     end;
-format_exception(Error) ->
-    format_exception({Error,[]}).
+format_exception(Error, Shift) ->
+    format_exception({Error, []}, Shift).
 
-do_format_exception(Reason={Error,Stack}) ->
+do_format_exception(Reason={Error,Stack}, Shift) ->
     StackFun = fun(_, _, _) -> false end,
-    PF = fun(Term, I) ->
-		 io_lib:format("~." ++ integer_to_list(I) ++ "tkp", [Term])
-	 end,
+    PF = fun(Str, I) when is_list(Str), Str =/= [], Str =:= Error ->
+                 case io_lib:printable_unicode_list(Str) of
+                     true ->
+                         io_lib:format("~ts", [shift_stacktrace(Str, Shift)]);
+                     false ->
+                         io_lib:format("~." ++ integer_to_list(I) ++ "tkp", [Str])
+                 end;
+            (Term, I) ->
+                 io_lib:format("~." ++ integer_to_list(I) ++ "tkp", [Term])
+         end,
     case catch erl_error:format_exception(1, error, Error, Stack, StackFun, PF, utf8) of
-	{'EXIT',_R} ->
-	    {"~tp",Reason};
-	Formatted  ->
-	    Formatted1 = re:replace(Formatted, "exception error: ", "", [{return,list},unicode]),
-	    {"~ts",lists:flatten(Formatted1)}
+        {'EXIT',_R} ->
+            {"~tp",Reason};
+        Formatted0 ->
+            Flat = lists:flatten(Formatted0),
+            case string:prefix(Flat, ?exception_prefix) of
+                nomatch   -> {"~ts", Flat};
+                Formatted -> {"~ts", Formatted}
+            end
     end.
 
 
@@ -5884,3 +5896,14 @@ report_repeat_testcase(M,forever) ->
     print(minor, "~n=== Repeated test case: ~w of infinity", [M]);
 report_repeat_testcase(M,N) ->
     print(minor, "~n=== Repeated test case: ~w of ~w", [M,N]).
+
+shift_stacktrace(Trace, 0) ->
+    Trace;
+shift_stacktrace(Trace, Shift) when Shift > 0 ->
+    case string:find(Trace, "\n") of
+        nomatch ->
+            Trace;
+        _ ->
+            Indent = lists:duplicate(Shift, $\s),
+            string:replace(Trace, "\n", "\n" ++ Indent, all)
+    end.

lib/common_test/test/ct_hooks_SUITE.erl

@@ -97,7 +97,7 @@ all(suite) ->
        one_cth, two_cth, faulty_cth_no_init, faulty_cth_id_no_init,
        faulty_cth_exit_in_init, faulty_cth_exit_in_id,
        faulty_cth_exit_in_init_scope_suite, minimal_cth,
-       minimal_and_maximal_cth, faulty_cth_undef,
+       minimal_and_maximal_cth, faulty_cth_undef, faulty_cth_long_reason,
        scope_per_suite_cth, scope_per_group_cth, scope_suite_cth,
        scope_suite_group_only_cth,
        scope_per_suite_state_cth, scope_per_group_state_cth,
@@ -156,8 +156,59 @@ minimal_and_maximal_cth(Config) when is_list(Config) ->
 	    [minimal_cth, empty_cth],Config).
 
 faulty_cth_undef(Config) when is_list(Config) ->
+    LogName = "ct_cth_empty_suite.init_per_suite.html",
+    OldLogs = reason_logs(Config, LogName),
     do_test(faulty_cth_undef, "ct_cth_empty_SUITE.erl",
-	    [undef_cth],Config).
+            [undef_cth], Config),
+    verify_reason_log(Config, LogName, OldLogs,
+                      ["=== Reason: undef_cth:pre_init_per_suite/3 "
+                       "CTH call failed: error:undef\n"
+                       "  in function  lists:flaten/1\n"
+                       "     called as lists:flaten("]).
+
+faulty_cth_long_reason(Config) when is_list(Config) ->
+    LogName = "ct_cth_empty_suite.test_case.html",
+    OldLogs = reason_logs(Config, LogName),
+    do_test(faulty_cth_long_reason, "ct_cth_empty_SUITE.erl",
+            [crash_post_end_tc_cth], Config),
+    Prefix = "=== Reason: ",
+    verify_reason_log(Config, LogName, OldLogs,
+                      [Prefix ++ long_cth_reason(string:length(Prefix)) ++ "\n"
+                       "  in function  gen_server:call/3"]).
+
+long_cth_reason(Shift) ->
+    Ind = fun(N) -> lists:duplicate(N + Shift, $\s) end,
+    lists:append(
+      ["crash_post_end_tc_cth:post_end_per_testcase/5 CTH call failed: "
+       "exit:{timeout,\n",
+       Ind(69), "{gen_server,\n",
+       Ind(70), "call,\n",
+       Ind(70), "[crash_post_end_tc_cth,\n",
+       Ind(71), "{assert_no_failures,\n",
+       Ind(72), "[{\"SOME_REFERENCE\",\n",
+       Ind(74), "\"related to XXYYZZ\"}]},\n",
+       Ind(71), "100]}}"]).
+
+verify_reason_log(Config, LogName, OldLogs, Expected) ->
+    TCLogs = reason_logs(Config, LogName) -- OldLogs,
+    [_|_] = TCLogs,
+    lists:foreach(
+      fun(TCLog) ->
+              {ok, Bin} = file:read_file(TCLog),
+              Log = unicode:characters_to_list(Bin),
+              [case string:find(Log, Str) of
+                   nomatch ->
+                       ct:fail({not_found_in_log, Str, TCLog});
+                   _ ->
+                       ok
+               end || Str <- Expected],
+              nomatch = string:find(Log, "=== === Reason:")
+      end, TCLogs).
+
+reason_logs(Config, LogName) ->
+    Logdir = proplists:get_value(logdir, ct_test_support:get_opts(Config)),
+    filelib:wildcard(
+      filename:join(Logdir, "ct_run*/cth.tests*/run*/" ++ LogName)).
 
 faulty_cth_exit_in_init_scope_suite(Config) when is_list(Config) ->
     do_test(faulty_cth_exit_in_init_scope_suite,
@@ -703,7 +754,11 @@ test_events(minimal_and_maximal_cth) ->
     ];
 
 test_events(faulty_cth_undef) ->
-    FailReasonStr = "undef_cth:pre_init_per_suite/3 CTH call failed",
+    FailReasonStr =
+        fun({"undef_cth:pre_init_per_suite/3 CTH call failed: error:undef",
+             [_|_]}) ->
+                match
+        end,
     FailReason = {ct_cth_empty_SUITE,init_per_suite,
 		  {failed,FailReasonStr}},
     [
@@ -727,6 +782,37 @@ test_events(faulty_cth_undef) ->
      {?eh,stop_logging,[]}
     ];
 
+test_events(faulty_cth_long_reason) ->
+    FailStr = long_cth_reason(0),
+    FailReason =
+        fun({Str, [_|_] = T}) when Str =:= FailStr ->
+                {gen_server,call,3,_} = lists:keyfind(gen_server, 1, T),
+                true = lists:keymember(crash_post_end_tc_cth, 1, T),
+                match
+        end,
+    [
+     {?eh,start_logging,{'DEF','RUNDIR'}},
+     {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+     {?eh,cth,{'_',init,['_',[]]}},
+     {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
+     {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}},
+
+     {?eh,tc_start,{ct_cth_empty_SUITE,test_case}},
+     {?eh,cth,{'_',pre_init_per_testcase,
+               [ct_cth_empty_SUITE,test_case,'$proplist',[]]}},
+     {?eh,cth,{'_',post_end_per_testcase,
+               [ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}},
+     {?eh,tc_done,{ct_cth_empty_SUITE,test_case,
+                   {failed,{error,FailReason}}}},
+     {?eh,cth,{'_',on_tc_fail,'_'}},
+
+     {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}},
+     {?eh,tc_done,{ct_cth_empty_SUITE,end_per_suite,ok}},
+     {?eh,test_done,{'DEF','STOP_TIME'}},
+     {?eh,cth,{'_',terminate,[[]]}},
+     {?eh,stop_logging,[]}
+    ];
+
 test_events(faulty_cth_exit_in_init_scope_suite) ->
     [{?eh,start_logging,{'DEF','RUNDIR'}},
      {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
@@ -2924,7 +3010,11 @@ test_events(crash_groups) ->
      {?eh,tc_start,{ct_framework,error_in_suite}},
      {?eh,tc_done,{ct_framework,error_in_suite,
                    {failed,
-                    {error,"all_and_groups_cth:post_groups/2 CTH call failed"}}}},
+                    {error,
+                     fun({"all_and_groups_cth:post_groups/2 CTH call failed: "
+                          "error:crash_in_post_groups", [_|_]}) ->
+                             match
+                     end}}}},
      {?eh,test_done,{'DEF','STOP_TIME'}},
      {?eh,cth,{empty_cth,terminate,[[]]}},
      {?eh,stop_logging,[]}
@@ -2944,7 +3034,11 @@ test_events(crash_all) ->
      {?eh,tc_start,{ct_framework,error_in_suite}},
      {?eh,tc_done,{ct_framework,error_in_suite,
                    {failed,
-                    {error,"all_and_groups_cth:post_all/3 CTH call failed"}}}},
+                    {error,
+                     fun({"all_and_groups_cth:post_all/3 CTH call failed: "
+                          "error:crash_in_post_all", [_|_]}) ->
+                             match
+                     end}}}},
      {?eh,test_done,{'DEF','STOP_TIME'}},
      {?eh,cth,{empty_cth,terminate,[[]]}},
      {?eh,stop_logging,[]}

lib/common_test/test/ct_hooks_SUITE_data/cth/tests/crash_post_end_tc_cth.erl

@@ -0,0 +1,94 @@
+%%
+%% %CopyrightBegin%
+%%
+%% SPDX-License-Identifier: Apache-2.0
+%%
+%% Copyright Ericsson AB 2026. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%%     http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%% CTH crashing in post_end_per_testcase with a long, nested exit
+%% reason (gen_server:call timeout with a large request term). Used to
+%% verify how such a reason is presented in the "=== Reason:" line.
+
+-module(crash_post_end_tc_cth).
+
+
+-include_lib("common_test/src/ct_util.hrl").
+-include_lib("common_test/include/ct_event.hrl").
+
+
+%% CT Hooks
+-compile(export_all).
+
+init(Id, Opts) ->
+    empty_cth:init(Id, Opts).
+
+pre_init_per_suite(Suite, Config, State) ->
+    empty_cth:pre_init_per_suite(Suite,Config,State).
+
+post_init_per_suite(Suite,Config,Return,State) ->
+    empty_cth:post_init_per_suite(Suite,Config,Return,State).
+
+pre_end_per_suite(Suite,Config,State) ->
+    empty_cth:pre_end_per_suite(Suite,Config,State).
+
+post_end_per_suite(Suite,Config,Return,State) ->
+    empty_cth:post_end_per_suite(Suite,Config,Return,State).
+
+pre_init_per_group(Suite,Group,Config,State) ->
+    empty_cth:pre_init_per_group(Suite,Group,Config,State).
+
+post_init_per_group(Suite,Group,Config,Return,State) ->
+    empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
+
+pre_end_per_group(Suite,Group,Config,State) ->
+    empty_cth:pre_end_per_group(Suite,Group,Config,State).
+
+post_end_per_group(Suite,Group,Config,Return,State) ->
+    empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
+
+pre_init_per_testcase(Suite,TC,Config,State) ->
+    empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
+
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+    empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
+
+pre_end_per_testcase(Suite,TC,Config,State) ->
+    empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
+
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+    empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State),
+    Name = ?MODULE,
+    Pid = spawn(fun() -> receive stop -> ok end end),
+    true = register(Name, Pid),
+    Request = {assert_no_failures,
+               [{"SOME_REFERENCE",
+                 "related to XXYYZZ"}]},
+    try
+        [gen_server:call(Name, R, 100) || R <- [Request]]
+    after
+        Pid ! stop
+    end.
+
+on_tc_fail(Suite,TC, Reason, State) ->
+    empty_cth:on_tc_fail(Suite,TC,Reason,State).
+
+on_tc_skip(Suite,TC, Reason, State) ->
+    empty_cth:on_tc_skip(Suite,TC,Reason,State).
+
+terminate(State) ->
+    empty_cth:terminate(State).