Support Module:format_status/2

src/wpool_process.erl

@@ -46,6 +46,7 @@
         , handle_cast/2
         , handle_info/2
         , handle_continue/2
+        , format_status/2
         ]).
 
 %%%===================================================================
@@ -141,6 +142,20 @@ handle_continue(Continue, State) ->
       {stop, Reason, State#state{state = NewState}}
   end.
 
+%% @private
+-spec format_status(normal | terminate, [[{_, _}] | state(), ...]) -> term().
+format_status(Opt, [PDict, State]) ->
+  case erlang:function_exported(State#state.mod, format_status, 2) of
+    false ->
+      case Opt of % This is copied from gen_server:format_status/4
+        terminate -> State#state.state;
+        normal -> [{data, [{"State", State#state.state}]}]
+      end;
+    true ->
+      wpool_utils:do_try(
+        fun() -> (State#state.mod):format_status(Opt, [PDict, State#state.state]) end)
+  end.
+
 %%%===================================================================
 %%% real (i.e. interesting) callbacks
 %%%===================================================================

test/echo_server.erl

@@ -25,6 +25,7 @@
         , handle_cast/2
         , handle_info/2
         , handle_continue/2
+        , format_status/2
         ]).
 
 -dialyzer([no_behaviours]).
@@ -49,9 +50,11 @@ handle_info(Info, _State) -> Info.
 handle_cast(Cast, _State) -> Cast.
 
 -type from() :: {pid(), reference()}.
--spec handle_call(state | Call, from(), State) -> {reply, State, State} | Call.
-handle_call(state, _From, State) -> {reply, State, State};
+-spec handle_call(Call, from(), term()) -> Call.
 handle_call(Call, _From, _State) -> Call.
 
 -spec handle_continue(Continue, term()) -> Continue.
 handle_continue(Continue, _State) -> Continue.
+
+-spec format_status(normal | terminate, [[{_, _}] | State, ...]) -> {formatted_state, State}.
+format_status(_, [_PDict, State]) -> {formatted_state, State}.

test/wpool_process_SUITE.erl

@@ -30,6 +30,7 @@
         , cast/1
         , call/1
         , continue/1
+        , no_format_status/1
         , stop/1
         ]).
 -export([ pool_restart_crash/1
@@ -80,7 +81,7 @@ init_timeout(_Config) ->
   {ok, Pid} =
     wpool_process:start_link(?MODULE, echo_server, {ok, state, 0}, []),
   timer:sleep(1),
-  timeout = wpool_process:call(?MODULE, state, 5000),
+  timeout = get_state(?MODULE),
   Pid ! {stop, normal, state},
   timer:sleep(1000),
   false = erlang:is_process_alive(Pid),
@@ -91,10 +92,10 @@ init_timeout(_Config) ->
 info(_Config) ->
   {ok, Pid} = wpool_process:start_link(?MODULE, echo_server, {ok, state}, []),
   Pid ! {noreply, newstate},
-  newstate = wpool_process:call(?MODULE, state, 5000),
+  newstate = get_state(?MODULE),
   Pid ! {noreply, newerstate, 1},
   timer:sleep(1),
-  timeout = wpool_process:call(?MODULE, state, 5000),
+  timeout = get_state(?MODULE),
   Pid ! {stop, normal, state},
   timer:sleep(1000),
   false = erlang:is_process_alive(Pid),
@@ -105,10 +106,10 @@ info(_Config) ->
 cast(_Config) ->
   {ok, Pid} = wpool_process:start_link(?MODULE, echo_server, {ok, state}, []),
   wpool_process:cast(Pid, {noreply, newstate}),
-  newstate = wpool_process:call(?MODULE, state, 5000),
+  newstate = get_state(?MODULE),
   wpool_process:cast(Pid, {noreply, newerstate, 0}),
   timer:sleep(100),
-  timeout = wpool_process:call(?MODULE, state, 5000),
+  timeout = get_state(?MODULE),
   wpool_process:cast(Pid, {stop, normal, state}),
   timer:sleep(1000),
   false = erlang:is_process_alive(Pid),
@@ -122,44 +123,44 @@ continue(_Config) ->
   {ok, Pid} =
     wpool_process:start_link(
       ?MODULE, echo_server, {ok, state, {continue, C(continue_state)}}, []),
-  continue_state = wpool_process:call(?MODULE, state, 5000),
+  continue_state = get_state(Pid),
 
   %% handle_call/3 returns {continue, ...}
   ok = wpool_process:call(Pid, {reply, ok, state, {continue, C(continue_state_2)}}, 5000),
-  continue_state_2 = wpool_process:call(?MODULE, state, 5000),
+  continue_state_2 = get_state(Pid),
   try wpool_process:call(Pid, {noreply, state, {continue, C(continue_state_3)}}, 100) of
     Result -> ct:fail("Unexpected Result: ~p", [Result])
   catch
     _:{timeout, _} ->
-      continue_state_3 = wpool_process:call(?MODULE, state, 5000)
+      continue_state_3 = get_state(Pid)
   end,
 
   %% handle_cast/2 returns {continue, ...}
   wpool_process:cast(Pid, {noreply, state, {continue, C(continue_state_4)}}),
-  continue_state_4 = wpool_process:call(?MODULE, state, 5000),
+  continue_state_4 = get_state(Pid),
 
   %% handle_continue/2 returns {continue, ...}
   SecondContinueResponse = C(continue_state_5),
   FirstContinueResponse = {noreply, another_state, {continue, SecondContinueResponse}},
   CastResponse = {noreply, state, {continue, FirstContinueResponse}},
   wpool_process:cast(Pid, CastResponse),
-  continue_state_5 = wpool_process:call(?MODULE, state, 5000),
+  continue_state_5 = get_state(Pid),
 
   %% handle_info/2 returns {continue, ...}
   Pid ! {noreply, state, {continue, C(continue_state_6)}},
-  continue_state_6 = wpool_process:call(?MODULE, state, 5000),
+  continue_state_6 = get_state(Pid),
 
   %% handle_continue/2 returns {continue, ...}
   SecondContinueResponse = C(continue_state_5),
   FirstContinueResponse = {noreply, another_state, {continue, SecondContinueResponse}},
   CastResponse = {noreply, state, {continue, FirstContinueResponse}},
   wpool_process:cast(Pid, CastResponse),
-  continue_state_5 = wpool_process:call(?MODULE, state, 5000),
+  continue_state_5 = get_state(Pid),
 
   %% handle_continue/2 returns timeout = 0
   wpool_process:cast(Pid, {noreply, state, {continue, {noreply, continue_state_7, 0}}}),
   timer:sleep(100),
-  timeout = wpool_process:call(?MODULE, state, 5000),
+  timeout = get_state(Pid),
 
   %% handle_continue/2 returns {stop, normal, state}
   wpool_process:cast(Pid, {noreply, state, {continue, {stop, normal, state}}}),
@@ -168,14 +169,24 @@ continue(_Config) ->
 
   {comment, []}.
 
+-spec no_format_status(config()) -> {comment, []}.
+no_format_status(_Config) ->
+  %% crashy_server doesn't implement format_status/2
+  {ok, Pid} = wpool_process:start_link(?MODULE, crashy_server, state, []),
+  %% therefore it uses the default format for the stauts (but with the status of the gen_server,
+  %% not wpool_process)
+  {status, Pid, {module, gen_server}, SItems} = sys:get_status(Pid),
+  [state] = [S || SItemList = [_|_] <- SItems, {data, Data} <- SItemList, {"State", S} <- Data],
+  {comment, []}.
+
 -spec call(config()) -> {comment, []}.
 call(_Config) ->
   {ok, Pid} = wpool_process:start_link(?MODULE, echo_server, {ok, state}, []),
   ok1 = wpool_process:call(Pid, {reply, ok1, newstate}, 5000),
-  newstate = wpool_process:call(?MODULE, state, 5000),
+  newstate = get_state(?MODULE),
   ok2 = wpool_process:call(Pid, {reply, ok2, newerstate, 1}, 5000),
   timer:sleep(1),
-  timeout = wpool_process:call(?MODULE, state, 5000),
+  timeout = get_state(?MODULE),
   ok3 = wpool_process:call(Pid, {stop, normal, ok3, state}, 5000),
   timer:sleep(1000),
   false = erlang:is_process_alive(Pid),
@@ -294,3 +305,10 @@ complete_coverage(_Config) ->
   {error, bad} = wpool_process:code_change("oldvsn", State, bad),
 
   {comment, []}.
+
+get_state(Atom) when is_atom(Atom) ->
+  get_state(whereis(Atom));
+get_state(Pid) ->
+  {status, Pid, {module, gen_server}, SItems} = sys:get_status(Pid),
+  [State] = [S || SItemList = [_|_] <- SItems, {formatted_state, S} <- SItemList],
+  State.