[ct] Cleanup after timetrap timeout or kill during framework call or hook

If a framework callback function exits due to a timetrap timeout, or
the process in other way is killed, during the execution of such
function, some internal common_test data was not cleaned up. An
example of such data is the 'curr_tc' test data. This is now corrected.

4 files changed, 218 insertions, 17 deletions

diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl
index 6066470233..de72344611 100644
--- a/lib/common_test/src/ct_framework.erl
+++ b/lib/common_test/src/ct_framework.erl
@@ -696,9 +696,16 @@ end_tc(Mod,IPTC={init_per_testcase,_Func},_TCPid,Result,Args,Return) ->
             end
     end;
 
-end_tc(Mod,Func0,TCPid,Result,Args,Return) ->
+end_tc(Mod,Func00,TCPid,Result,Args,Return) ->
     %% in case Mod == ct_framework, lookup the suite name
     Suite = get_suite_name(Mod, Args),
+    {OnlyCleanup,Func0} =
+        case Func00 of
+            {cleanup,F0} ->
+                {true,F0};
+            _ ->
+                {false,Func00}
+        end,
     {Func,FuncSpec,HookFunc} =
         case Func0 of
             {end_per_testcase_not_run,F} ->
@@ -742,6 +749,8 @@ end_tc(Mod,Func0,TCPid,Result,Args,Return) ->
         case HookFunc of
             undefined ->
                 {ok,Result};
+            _ when OnlyCleanup ->
+                {ok,Result};
             _ ->
                 case ct_hooks:end_tc(Suite,HookFunc,Args,Result,Return) of
                     '$ct_no_change' ->
@@ -752,6 +761,8 @@ end_tc(Mod,Func0,TCPid,Result,Args,Return) ->
         end,
     FinalResult =
 	case get('$test_server_framework_test') of
+            _ when OnlyCleanup ->
+                Result1;
 	    undefined ->
 		%% send sync notification so that event handlers may print
 		%% in the log file before it gets closed
diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl
index ecb2ee7caf..c6916ea815 100644
--- a/lib/common_test/src/test_server.erl
+++ b/lib/common_test/src/test_server.erl
@@ -384,8 +384,8 @@ run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,TimetrapData}) ->
     {Result,DetFail,ProcBef,ProcAft}.
 
 -type tc_status() :: 'starting' | 'running' | 'init_per_testcase' |
-		     'end_per_testcase' | {'framework',atom(),atom()} |
-		     'tc'.
+		     'end_per_testcase' | {'framework',{atom(),atom(),list}} |
+                     'tc'.
 -record(st,
 	{
 	  ref :: reference(),
@@ -652,8 +652,8 @@ handle_tc_exit({testcase_aborted,{user_timetrap_error,_}=Msg,_}, St) ->
     #st{config=Config,mf={Mod,Func},pid=Pid} = St,
     spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()),
     St;
-handle_tc_exit(Reason, #st{status={framework,FwMod,FwFunc},
-			   config=Config,pid=Pid}=St) ->
+handle_tc_exit(Reason, #st{status={framework,{FwMod,FwFunc,_}=FwMFA},
+			   config=Config,mf={Mod,Func},pid=Pid}=St) ->
     R = case Reason of
 	    {timetrap_timeout,TVal,_} ->
 		{timetrap,TVal};
@@ -665,7 +665,7 @@ handle_tc_exit(Reason, #st{status={framework,FwMod,FwFunc},
 		Other
 	end,
     Error = {framework_error,R},
-    spawn_fw_call(FwMod, FwFunc, Config, Pid, Error, unknown, self()),
+    spawn_fw_call(Mod, Func, Config, Pid, {Error,FwMFA}, unknown, self()),
     St;
 handle_tc_exit(Reason, #st{status=tc,config=Config0,mf={Mod,Func},pid=Pid}=St)
   when is_list(Config0) ->
@@ -869,22 +869,48 @@ spawn_fw_call(Mod,EPTC={end_per_testcase,Func},EndConf,Pid,
 	end,
     spawn_link(FwCall);
 
-spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) ->
+spawn_fw_call(Mod,Func,Conf,Pid,{{framework_error,FwError},
+                                 {FwMod,FwFunc,[A1,A2|_]}=FwMFA},_,SendTo) ->
     FwCall =
 	fun() ->
                 ct_util:mark_process(),
-		test_server_sup:framework_call(report, [framework_error,
-							{{FwMod,FwFunc},
-							 FwError}]),
+                Time =
+                    case FwError of
+                        {timetrap,TVal} ->
+                            TVal/1000;
+                        _ ->
+                            died
+                    end,
+                {Ret,Loc,WarnOrError} =
+                    cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,FwMFA),
 		Comment =
-		    lists:flatten(
-		      io_lib:format("<font color=\"red\">"
-				    "WARNING! ~w:~tw failed!</font>",
-				    [FwMod,FwFunc])),
+                    case WarnOrError of
+                        warn ->
+			    group_leader() !
+				{printout,12,
+                                 "WARNING! ~w:~tw(~w,~tw,...) failed!\n"
+                                 "    Reason: ~tp\n",
+                                 [FwMod,FwFunc,A1,A2,FwError]},
+                            lists:flatten(
+                              io_lib:format("<font color=\"red\">"
+                                            "WARNING! ~w:~tw(~w,~tw,...) "
+                                            "failed!</font>",
+                                            [FwMod,FwFunc,A1,A2]));
+                        error ->
+			    group_leader() !
+				{printout,12,
+                                 "Error! ~w:~tw(~w,~tw,...) failed!\n"
+                                 "    Reason: ~tp\n",
+                                 [FwMod,FwFunc,A1,A2,FwError]},
+                            lists:flatten(
+                              io_lib:format("<font color=\"red\">"
+                                            "ERROR! ~w:~tw(~w,~tw,...) "
+                                            "failed!</font>",
+                                            [FwMod,FwFunc,A1,A2]))
+                    end,
 	    %% finished, report back
 	    SendTo ! {self(),fw_notify_done,
-		      {died,{error,{FwMod,FwFunc,FwError}},
-		       {FwMod,FwFunc},[],Comment}}
+		      {Time,Ret,Loc,[],Comment}}
 	end,
     spawn_link(FwCall);
 
@@ -929,6 +955,163 @@ spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) ->
 	end,
     spawn_link(FwCall).
 
+cleanup_after_fw_error(_Mod,_Func,Conf,Pid,FwError,
+                       {FwMod,FwFunc=init_tc,
+                        [Mod,{init_per_testcase,Func}=IPTC|_]}) ->
+    %% Failed during pre_init_per_testcase, the test must be skipped
+    Skip = {auto_skip,{failed,{FwMod,FwFunc,FwError}}},
+    try begin do_end_tc_call(Mod,IPTC, {Pid,Skip,[Conf]}, FwError),
+              do_init_tc_call(Mod,{end_per_testcase_not_run,Func},
+                              [Conf],{ok,[Conf]}),
+              do_end_tc_call(Mod,{end_per_testcase_not_run,Func},
+                             {Pid,Skip,[Conf]}, FwError) end of
+        _ -> ok
+    catch
+        _:FwEndTCErr ->
+            exit({fw_notify_done,end_tc,FwEndTCErr})
+    end,
+    {Skip,{FwMod,FwFunc},error};
+cleanup_after_fw_error(_Mod,_Func,Conf,Pid,FwError,
+                       {FwMod,FwFunc=end_tc,[Mod,{init_per_testcase,Func}|_]}) ->
+    %% Failed during post_init_per_testcase, the test must be skipped
+    Skip = {auto_skip,{failed,{FwMod,FwFunc,FwError}}},
+    try begin do_init_tc_call(Mod,{end_per_testcase_not_run,Func},
+                              [Conf],{ok,[Conf]}),
+              do_end_tc_call(Mod,{end_per_testcase_not_run,Func},
+                             {Pid,Skip,[Conf]}, FwError) end of
+        _ -> ok
+    catch
+        _:FwEndTCErr ->
+            exit({fw_notify_done,end_tc,FwEndTCErr})
+    end,
+    {Skip,{FwMod,FwFunc},error};
+cleanup_after_fw_error(_Mod,_Func,Conf,Pid,FwError,
+                       {FwMod,FwFunc=init_tc,[Mod,{end_per_testcase,Func}|_]}) ->
+    %% Failed during pre_end_per_testcase. Warn about it.
+    {RetVal,Loc} =
+        case {proplists:get_value(tc_status, Conf),
+              proplists:get_value(tc_fail_loc, Conf, unknown)} of
+            {undefined,_} ->
+                {{failed,{FwMod,FwFunc,FwError}},{FwMod,FwFunc}};
+            {E = {failed,_Reason},unknown} ->
+                {E,[{Mod,Func}]};
+            {Result,FailLoc} ->
+                {Result,FailLoc}
+        end,
+    try begin do_end_tc_call(Mod,{end_per_testcase_not_run,Func},
+                             {Pid,RetVal,[Conf]}, FwError) end of
+        _ -> ok
+    catch
+        _:FwEndTCErr ->
+            exit({fw_notify_done,end_tc,FwEndTCErr})
+    end,
+    {RetVal,Loc,warn};
+cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,
+                       {FwMod,FwFunc=end_tc,[Mod,{end_per_testcase,Func}|_]}) ->
+    %% Failed during post_end_per_testcase. Warn about it.
+    {RetVal,Report,Loc} =
+        case {proplists:get_value(tc_status, Conf),
+              proplists:get_value(tc_fail_loc, Conf, unknown)} of
+            {undefined,_} ->
+                {{failed,{FwMod,FwFunc,FwError}},
+                 {{FwMod,FwError},FwError},
+                 {FwMod,FwFunc}};
+            {E = {failed,_Reason},unknown} ->
+                {E,{Mod,Func,E},[{Mod,Func}]};
+            {Result,FailLoc} ->
+                {Result,{Mod,Func,Result},FailLoc}
+        end,
+    try begin do_end_tc_call(Mod,{cleanup,{end_per_testcase_not_run,Func}},
+                             {Pid,RetVal,[Conf]}, FwError) end of
+        _ -> ok
+    catch
+        _:FwEndTCErr ->
+            exit({fw_notify_done,end_tc,FwEndTCErr})
+    end,
+    test_server_sup:framework_call(report,[framework_error,Report]),
+    {RetVal,Loc,warn};
+cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,{FwMod,FwFunc=init_tc,_})
+  when Func =:= init_per_suite; Func =:=init_per_group ->
+    %% Failed during pre_init_per_suite or pre_init_per_group
+    RetVal = {failed,{FwMod,FwFunc,FwError}},
+    try do_end_tc_call(Mod,Func,{Pid,RetVal,[Conf]},FwError) of
+        _ -> ok
+    catch
+        _:FwEndTCErr ->
+            exit({fw_notify_done,end_tc,FwEndTCErr})
+    end,
+    {RetVal,{FwMod,FwFunc},error};
+cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,{FwMod,FwFunc=end_tc,_})
+  when Func =:= init_per_suite; Func =:=init_per_group ->
+    %% Failed during post_init_per_suite or post_init_per_group
+    RetVal = {failed,{FwMod,FwFunc,FwError}},
+    try do_end_tc_call(Mod,{cleanup,Func},{Pid,RetVal,[Conf]},FwError) of
+        _ -> ok
+    catch
+        _:FwEndTCErr ->
+            exit({fw_notify_done,end_tc,FwEndTCErr})
+    end,
+    ReportFunc =
+        case Func of
+            init_per_group ->
+                case proplists:get_value(tc_group_properties,Conf) of
+                    undefined ->
+                        {Func,unknown,[]};
+                    GProps ->
+                        Name = proplists:get_value(name,GProps),
+                        {Func,Name,proplists:delete(name,GProps)}
+                end;
+            _ ->
+                Func
+        end,
+    test_server_sup:framework_call(report,[framework_error,
+                                           {Mod,ReportFunc,RetVal}]),
+    {RetVal,{FwMod,FwFunc},error};
+cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,{FwMod,FwFunc=init_tc,_})
+  when Func =:= end_per_suite; Func =:=end_per_group ->
+    %% Failed during pre_end_per_suite or pre_end_per_group
+    RetVal = {failed,{FwMod,FwFunc,FwError}},
+    try do_end_tc_call(Mod,Func,{Pid,RetVal,[Conf]},FwError) of
+        _ -> ok
+    catch
+        _:FwEndTCErr ->
+            exit({fw_notify_done,end_tc,FwEndTCErr})
+    end,
+    {RetVal,{FwMod,FwFunc},error};
+cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,{FwMod,FwFunc=end_tc,_})
+  when Func =:= end_per_suite; Func =:=end_per_group ->
+    %% Failed during post_end_per_suite or post_end_per_group
+    RetVal = {failed,{FwMod,FwFunc,FwError}},
+    try do_end_tc_call(Mod,{cleanup,Func},{Pid,RetVal,[Conf]},FwError) of
+        _ -> ok
+    catch
+        _:FwEndTCErr ->
+            exit({fw_notify_done,end_tc,FwEndTCErr})
+    end,
+    ReportFunc =
+        case Func of
+            end_per_group ->
+                case proplists:get_value(tc_group_properties,Conf) of
+                    undefined ->
+                        {Func,unknown,[]};
+                    GProps ->
+                        Name = proplists:get_value(name,GProps),
+                        {Func,Name,proplists:delete(name,GProps)}
+                end;
+            _ ->
+                Func
+        end,
+    test_server_sup:framework_call(report,[framework_error,
+                                           {Mod,ReportFunc,RetVal}]),
+    {RetVal,{FwMod,FwFunc},error};
+cleanup_after_fw_error(_Mod,_Func,_Conf,_Pid,FwError,{FwMod,FwFunc,_}) ->
+    %% This is unexpected
+    test_server_sup:framework_call(report,
+                                   [framework_error,
+                                    {{FwMod,FwFunc},
+                                     FwError}]),
+    {FwError,{FwMod,FwFunc},error}.
+
 %% The job proxy process forwards messages between the test case
 %% process on a shielded node (and its descendants) and the job process.
 %%
@@ -1104,6 +1287,9 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) ->
 		    EndConf1 =
 			user_callback(TCCallback, Mod, Func, 'end', EndConf),
 
+                    %% save updated config in controller loop
+                    set_tc_state(tc, EndConf1),
+
 		    %% We can't handle fails or skips here
 		    EndConf2 =
 			case do_init_tc_call(Mod,{end_per_testcase,Func},
diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl
index 8ef28b3343..69669bbeef 100644
--- a/lib/common_test/src/test_server_ctrl.erl
+++ b/lib/common_test/src/test_server_ctrl.erl
@@ -3840,6 +3840,10 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
 	    {died,{timetrap_timeout,TimetrapTimeout}} ->
 		progress(failed, Num, Mod, Func, GrName, Loc,
 			 timetrap_timeout, TimetrapTimeout, Comment, Style);
+	    {died,Reason={auto_skip,_Why}} ->
+                %% died in init_per_testcase or in a hook in this context
+		progress(skip, Num, Mod, Func, GrName, Loc, Reason,
+			 Time, Comment, Style);
 	    {died,{Skip,Reason}} when Skip==skip; Skip==skipped ->
                 %% died in init_per_testcase
 		progress(skip, Num, Mod, Func, GrName, Loc, Reason,
diff --git a/lib/common_test/src/test_server_sup.erl b/lib/common_test/src/test_server_sup.erl
index 6ddbf1ad27..fae977e40c 100644
--- a/lib/common_test/src/test_server_sup.erl
+++ b/lib/common_test/src/test_server_sup.erl
@@ -770,7 +770,7 @@ framework_call(Callback,Func,Args,DefaultReturn) ->
 			 end,
 	    case SetTcState of
 		true ->
-		    test_server:set_tc_state({framework,Mod,Func});
+		    test_server:set_tc_state({framework,{Mod,Func,Args}});
 		false ->
 		    ok
 	    end,