Return callback module in supervisor format_status

The previous implementation of supervisor:get_callback_module/1
used sys:get_status/1 to get the supervisor inner state and
retrieve the callback module. Such implementation forbids any
other supervisor implementation that has an internal state
different than the #state{} record in supervisor.erl.

This patch allows supervisors to return the callback module
as part of the sys:get_status/1 data, no longer coupling the
callback module implementation with the inner #state{} record.

Notice we have kept the clause matching the previous
sys:get_status/1 reply for backwards compatibility purposes.

4 files changed, 26 insertions, 7 deletions

diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl
index 871ef603db..2f07b73578 100644
--- a/lib/observer/src/observer_procinfo.erl
+++ b/lib/observer/src/observer_procinfo.erl
@@ -317,7 +317,7 @@ fetch_state_info2(Pid, M) ->
     of
 	{status, _, {module, _},
 	 [_PDict, _SysState, _Parent, _Dbg,
-	  [Header,{data, First},{data, Second}]]} ->
+	  [Header,{data, First},{data, Second}|_]]} ->
 	    [{"Behaviour", B}, Header] ++ First ++ Second;
 	{status, _, {module, _},
 	 [_PDict, _SysState, _Parent, _Dbg,
diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl
index ee620dcdb4..fa0ec1e80e 100644
--- a/lib/sasl/test/release_handler_SUITE.erl
+++ b/lib/sasl/test/release_handler_SUITE.erl
@@ -1361,7 +1361,7 @@ upgrade_supervisor(Conf) when is_list(Conf) ->
     ASupBeam2 = rpc:call(Node, code, which, [a_sup]),
 
     %% Check that the restart strategy and child spec is updated
-    {status, _, {module, _}, [_, _, _, _, [_,_,{data,[{"State",State}]}]]} =
+    {status, _, {module, _}, [_, _, _, _, [_,_,{data,[{"State",State}]}|_]]} =
 	rpc:call(Node,sys,get_status,[a_sup]),
     {state,_,RestartStrategy,[Child],_,_,_,_,_,_,_} = State,
     one_for_all = RestartStrategy, % changed from one_for_one
diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl
index 0400c845ab..205ed534ad 100644
--- a/lib/stdlib/src/supervisor.erl
+++ b/lib/stdlib/src/supervisor.erl
@@ -30,7 +30,7 @@
 
 %% Internal exports
 -export([init/1, handle_call/3, handle_cast/2, handle_info/2,
-	 terminate/2, code_change/3]).
+	 terminate/2, code_change/3, format_status/2]).
 -export([try_again_restart/2]).
 
 %% For release_handler only
@@ -264,8 +264,13 @@ cast(Supervisor, Req) ->
 get_callback_module(Pid) ->
     {status, _Pid, {module, _Mod},
      [_PDict, _SysState, _Parent, _Dbg, Misc]} = sys:get_status(Pid),
-    [_Header, _Data, {data, [{"State", State}]}] = Misc,
-    State#state.module.
+    case lists:keyfind(supervisor, 1, Misc) of
+	{supervisor, [{"Callback", Mod}]} ->
+	    Mod;
+	_ ->
+	    [_Header, _Data, {data, [{"State", State}]} | _] = Misc,
+	    State#state.module
+    end.
 
 %%% ---------------------------------------------------
 %%% 
@@ -1456,3 +1461,9 @@ report_progress(Child, SupName) ->
     Progress = [{supervisor, SupName},
 		{started, extract_child(Child)}],
     error_logger:info_report(progress, Progress).
+
+format_status(terminate, [_PDict, State]) ->
+    State;
+format_status(_, [_PDict, State]) ->
+    [{data, [{"State", State}]},
+     {supervisor, [{"Callback", State#state.module}]}].
diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl
index 903ca76575..16c30c961e 100644
--- a/lib/stdlib/test/supervisor_SUITE.erl
+++ b/lib/stdlib/test/supervisor_SUITE.erl
@@ -67,7 +67,7 @@
 
 %% Misc tests
 -export([child_unlink/1, tree/1, count_children/1,
-	 count_restarting_children/1,
+	 count_restarting_children/1, get_callback_module/1,
 	 do_not_save_start_parameters_for_temporary_children/1,
 	 do_not_save_child_specs_for_temporary_children/1,
 	 simple_one_for_one_scale_many_temporary_children/1,
@@ -91,7 +91,7 @@ all() ->
      {group, normal_termination},
      {group, shutdown_termination},
      {group, abnormal_termination}, child_unlink, tree,
-     count_children, count_restarting_children,
+     count_children, count_restarting_children, get_callback_module,
      do_not_save_start_parameters_for_temporary_children,
      do_not_save_child_specs_for_temporary_children,
      simple_one_for_one_scale_many_temporary_children, temporary_bystander,
@@ -1509,6 +1509,14 @@ count_restarting_children(Config) when is_list(Config) ->
     [1,0,0,0] = get_child_counts(SupPid).
 
 %%-------------------------------------------------------------------------
+%% Test get_callback_module
+get_callback_module(Config) when is_list(Config) ->
+    Child = {child, {supervisor_1, start_child, []}, temporary, 1000,
+	     worker, []},
+    {ok, SupPid} = start_link({ok, {{simple_one_for_one, 2, 3600}, [Child]}}),
+    supervisor_SUITE = supervisor:get_callback_module(SupPid).
+
+%%-------------------------------------------------------------------------
 %% Temporary children shall not be restarted so they should not save
 %% start parameters, as it potentially can take up a huge amount of
 %% memory for no purpose.