add sys:get_state/1,2 and sys:replace_state/2,3

At Erlang Factory 2013 there was discussion during one of the talks about
the sys:get_status functions and how useful they were for debugging. Geoff
Cant mentioned it would be very useful if the sys module also provided
functions to use while debugging to get just the state of a process and
also to be able to replace the state of a process, and many others in the
audience appeared to agree.

The sys:get_state/1,2 functions return the state of a gen_server, gen_fsm,
or gen_event process. The return value varies depending on the process
type: process state for a gen_server, state name and state data for a
gen_fsm, and handler module, handler id, and handler state for each handler
registered in a gen_event process.

The sys:replace_state/2,3 functions allow the state of a gen_server,
gen_fsm, or gen_event process to be replaced with a new state. These
functions take a function argument that updates or replaces the process
state; using a function to change the state eliminates the race condition
of first reading the state via sys:get_state/1 or sys:get_state/2, using
its return value to create a new state, and then replacing the old state
with the new state, since during that time the process might have received
other calls or messages that could have changed its state.

* For a gen_server process, the state replacement function takes the
  process state as an argument and returns a new state.

* For a gen_fsm process, the state replacement function gets a tuple of
  {StateName, StateData} and returns a similar tuple that specifies a new
  state name, new state data, or both.

* For a gen_event process, the state replacement function is called for
  each registered event handler. It gets a tuple {Module, Id, HandlerState}
  and returns a similar tuple that specifies the same Module and Id values
  but may specify a different value for HandlerState.

If the state replacement function crashes or results in an error, the
original state of a gen_server or gen_fsm process is maintained; if such a
crash occurs for a gen_event process, the original state of the event
handler for which the state replacement function was called is maintained,
but the states of other event handlers of the same gen_event process may
still be updated if no errors or crashes occur while replacing their
states.

Add documentation for sys:get_state/1,2 and sys:replace_state/2,3. The
documentation explicitly notes that the functions are intended for use
during debugging.

Add new tests for these functions to gen_server_SUITE, gen_fsm_SUITE, and
gen_event_SUITE.

8 files changed, 263 insertions, 5 deletions

diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml
index bb75efb5e7..a177b80739 100644
--- a/lib/stdlib/doc/src/sys.xml
+++ b/lib/stdlib/doc/src/sys.xml
@@ -225,6 +225,73 @@
       </desc>
     </func>
     <func>
+      <name name="get_state" arity="1"/>
+      <name name="get_state" arity="2"/>
+      <fsummary>Get the state of the process</fsummary>
+      <desc>
+        <p>Gets the state of the process.</p>
+        <note>
+          <p>These functions are intended only to help with debugging. They are provided for
+            convenience, allowing developers to avoid having to create their own state extraction
+            functions and also avoid having to interactively extract state from the return values of
+            <c><seealso marker="get_status/1">get_status/1</seealso></c> or
+            <c><seealso marker="get_status/2">get_status/2</seealso></c> while debugging.</p>
+        </note>
+        <p>The value of <c><anno>State</anno></c> varies for different types of
+          processes. For a <c>gen_server</c> process, the returned <c><anno>State</anno></c>
+          is simply the callback module's state. For a <c>gen_fsm</c> process,
+          <c><anno>State</anno></c> is the tuple <c>{CurrentStateName, CurrentStateData}</c>.
+          For a <c>gen_event</c> process, <c><anno>State</anno></c> a list of tuples,
+          where each tuple corresponds to an event handler registered in the process and contains
+          <c>{Module, Id, HandlerState}</c>, where <c>Module</c> is the event handler's module name,
+          <c>Id</c> is the handler's ID (which is the value <c>false</c> if it was registered without
+          an ID), and <c>HandlerState</c> is the handler's state.</p>
+        <p>To obtain more information about a process, including its state, see
+          <seealso marker="get_status/1">get_status/1</seealso> and
+          <seealso marker="get_status/2">get_status/2</seealso>.</p>
+      </desc>
+    </func>
+    <func>
+      <name name="replace_state" arity="2"/>
+      <name name="replace_state" arity="3"/>
+      <fsummary>Replace the state of the process</fsummary>
+      <desc>
+        <p>Replaces the state of the process, and returns the new state.</p>
+        <note>
+          <p>These functions are intended only to help with debugging, and they should not be
+            be called from normal code. They are provided for convenience, allowing developers
+            to avoid having to create their own custom state replacement functions.</p>
+        </note>
+        <p>The <c><anno>StateFun</anno></c> function provides a new state for the process.
+          The <c><anno>State</anno></c> argument and <c><anno>NewState</anno></c> return value
+          of <c><anno>StateFun</anno></c> vary for different types of processes. For a
+          <c>gen_server</c> process, <c><anno>State</anno></c> is simply the callback module's
+          state, and <c><anno>NewState</anno></c> is a new instance of that state. For a
+          <c>gen_fsm</c> process, <c><anno>State</anno></c> is the tuple
+          <c>{CurrentStateName, CurrentStateData}</c>, and <c><anno>NewState</anno></c>
+          is a similar tuple that may contain a new state name, new state data, or both.
+          For a <c>gen_event</c> process, <c><anno>State</anno></c> is the tuple
+          <c>{Module, Id, HandlerState}</c> where <c>Module</c> is the event handler's module name,
+          <c>Id</c> is the handler's ID (which is the value <c>false</c> if it was registered without
+          an ID), and <c>HandlerState</c> is the handler's state. <c><anno>NewState</anno></c> is a
+          similar tuple where <c>Module</c> and <c>Id</c> shall have the same values as in
+          <c><anno>State</anno></c> but the value of <c>HandlerState</c> may be different. Returning
+          a <c><anno>NewState</anno></c> whose <c>Module</c> or <c>Id</c> values differ from those of
+          <c><anno>State</anno></c> will result in the event handler's state remaining unchanged. For a
+          <c>gen_event</c> process, <c><anno>StateFun</anno></c> is called once for each event handler
+          registered in the <c>gen_event</c> process.</p>
+        <p>If a <c><anno>StateFun</anno></c> function decides not to effect any change in process
+          state, then regardless of process type, it may simply return its <c><anno>State</anno></c>
+          argument.</p>
+        <p>If a <c><anno>StateFun</anno></c> function crashes or throws an exception, then
+          for <c>gen_server</c> and <c>gen_fsm</c> processes, the original state of the process is
+          unchanged. For <c>gen_event</c> processes, a crashing or failing <c><anno>StateFun</anno></c>
+          function means that only the state of the particular event handler it was working on when it
+          failed or crashed is unchanged; it can still succeed in changing the states of other event
+          handlers registered in the same <c>gen_event</c> process.</p>
+      </desc>
+    </func>
+    <func>
       <name name="install" arity="2"/>
       <name name="install" arity="3"/>
       <fsummary>Install a debug function in the process</fsummary>
diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl
index 2b8ba86909..bfebf29080 100644
--- a/lib/stdlib/src/gen_event.erl
+++ b/lib/stdlib/src/gen_event.erl
@@ -229,6 +229,24 @@ wake_hib(Parent, ServerName, MSL, Debug) ->
 
 fetch_msg(Parent, ServerName, MSL, Debug, Hib) ->
     receive
+	{system, From, get_state} ->
+	    States = [{Mod,Id,State} || #handler{module=Mod, id=Id, state=State} <- MSL],
+	    sys:handle_system_msg(get_state, From, Parent, ?MODULE, Debug,
+				  {States, [ServerName, MSL, Hib]}, Hib);
+	{system, From, {replace_state, StateFun}} ->
+	    {NMSL, NStates} =
+		lists:unzip([begin
+				 Cur = {Mod,Id,State},
+				 try
+				     NState = {Mod,Id,NS} = StateFun(Cur),
+				     {HS#handler{state=NS}, NState}
+				 catch
+				     _:_ ->
+					 {HS, Cur}
+				 end
+			     end || #handler{module=Mod, id=Id, state=State}=HS <- MSL]),
+	    sys:handle_system_msg(replace_state, From, Parent, ?MODULE, Debug,
+				  {NStates, [ServerName, NMSL, Hib]}, Hib);
 	{system, From, Req} ->
 	    sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug,
 				  [ServerName, MSL, Hib],Hib);
diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl
index e480e2ac11..d9411e58cf 100644
--- a/lib/stdlib/src/gen_fsm.erl
+++ b/lib/stdlib/src/gen_fsm.erl
@@ -422,6 +422,17 @@ wake_hib(Parent, Name, StateName, StateData, Mod, Debug) ->
 
 decode_msg(Msg,Parent, Name, StateName, StateData, Mod, Time, Debug, Hib) ->
     case Msg of
+	{system, From, get_state} ->
+	    Misc = [Name, StateName, StateData, Mod, Time],
+	    sys:handle_system_msg(get_state, From, Parent, ?MODULE, Debug,
+				  {{StateName, StateData}, Misc}, Hib);
+	{system, From, {replace_state, StateFun}} ->
+	    State = {StateName, StateData},
+	    NState = {NStateName, NStateData} = try StateFun(State)
+						catch _:_ -> State end,
+	    NMisc = [Name, NStateName, NStateData, Mod, Time],
+	    sys:handle_system_msg(replace_state, From, Parent, ?MODULE, Debug,
+				  {NState, NMisc}, Hib);
         {system, From, Req} ->
 	    sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug,
 				  [Name, StateName, StateData, Mod, Time], Hib);
diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl
index 04308a51b7..9c4b95acf6 100644
--- a/lib/stdlib/src/gen_server.erl
+++ b/lib/stdlib/src/gen_server.erl
@@ -372,6 +372,13 @@ wake_hib(Parent, Name, State, Mod, Debug) ->
 
 decode_msg(Msg, Parent, Name, State, Mod, Time, Debug, Hib) ->
     case Msg of
+	{system, From, get_state} ->
+	    sys:handle_system_msg(get_state, From, Parent, ?MODULE, Debug,
+				  {State, [Name, State, Mod, Time]}, Hib);
+	{system, From, {replace_state, StateFun}} ->
+	    NState = try StateFun(State) catch _:_ -> State end,
+	    sys:handle_system_msg(replace_state, From, Parent, ?MODULE, Debug,
+				  {NState, [Name, NState, Mod, Time]}, Hib);
 	{system, From, Req} ->
 	    sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug,
 				  [Name, State, Mod, Time], Hib);
diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl
index 2d6287814e..bffeb44179 100644
--- a/lib/stdlib/src/sys.erl
+++ b/lib/stdlib/src/sys.erl
@@ -21,6 +21,8 @@
 %% External exports
 -export([suspend/1, suspend/2, resume/1, resume/2,
 	 get_status/1, get_status/2,
+	 get_state/1, get_state/2,
+	 replace_state/2, replace_state/3,
 	 change_code/4, change_code/5,
 	 log/2, log/3, trace/2, trace/3, statistics/2, statistics/3,
 	 log_to_file/2, log_to_file/3, no_debug/1, no_debug/2,
@@ -97,6 +99,32 @@ get_status(Name) -> send_system_msg(Name, get_status).
              | (Misc :: term()).
 get_status(Name, Timeout) -> send_system_msg(Name, get_status, Timeout).
 
+-spec get_state(Name) -> State when
+      Name :: name(),
+      State :: term().
+get_state(Name) -> send_system_msg(Name, get_state).
+
+-spec get_state(Name, Timeout) -> State when
+      Name :: name(),
+      Timeout :: timeout(),
+      State :: term().
+get_state(Name, Timeout) -> send_system_msg(Name, get_state, Timeout).
+
+-spec replace_state(Name, StateFun) -> NewState when
+      Name :: name(),
+      StateFun :: fun((State :: term()) -> NewState :: term()),
+      NewState :: term().
+replace_state(Name, StateFun) ->
+    send_system_msg(Name, {replace_state, StateFun}).
+
+-spec replace_state(Name, StateFun, Timeout) -> NewState when
+      Name :: name(),
+      StateFun :: fun((State :: term()) -> NewState :: term()),
+      Timeout :: timeout(),
+      NewState :: term().
+replace_state(Name, StateFun, Timeout) ->
+    send_system_msg(Name, {replace_state, StateFun}, Timeout).
+
 -spec change_code(Name, Module, OldVsn, Extra) -> 'ok' | {error, Reason} when
       Name :: name(),
       Module :: module(),
@@ -362,6 +390,10 @@ do_cmd(_, suspend, _Parent, _Mod, Debug, Misc) ->
     {suspended, ok, Debug, Misc};
 do_cmd(_, resume, _Parent, _Mod, Debug, Misc) ->
     {running, ok, Debug, Misc};
+do_cmd(SysState, get_state, _Parent, _Mod, Debug, {State, Misc}) ->
+    {SysState, State, Debug, Misc};
+do_cmd(SysState, replace_state, _Parent, _Mod, Debug, {State, Misc}) ->
+    {SysState, State, Debug, Misc};
 do_cmd(SysState, get_status, Parent, Mod, Debug, Misc) ->
     Res = get_status(SysState, Parent, Mod, Debug, Misc),
     {SysState, Res, Debug, Misc};
diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl
index 5c51e12e35..1594049ebf 100644
--- a/lib/stdlib/test/gen_event_SUITE.erl
+++ b/lib/stdlib/test/gen_event_SUITE.erl
@@ -26,13 +26,14 @@
 	 delete_handler/1, swap_handler/1, swap_sup_handler/1,
 	 notify/1, sync_notify/1, call/1, info/1, hibernate/1,
 	 call_format_status/1, call_format_status_anon/1,
-         error_format_status/1]).
+         error_format_status/1, get_state/1, replace_state/1]).
 
 suite() -> [{ct_hooks,[ts_install_cth]}].
 
 all() -> 
     [start, {group, test_all}, hibernate,
-     call_format_status, call_format_status_anon, error_format_status].
+     call_format_status, call_format_status_anon, error_format_status,
+     get_state, replace_state].
 
 groups() -> 
     [{test_all, [],
@@ -956,3 +957,45 @@ error_format_status(Config) when is_list(Config) ->
     ?line ok = gen_event:stop(Pid),
     process_flag(trap_exit, OldFl),
     ok.
+
+get_state(suite) ->
+    [];
+get_state(doc) ->
+    ["Test that sys:get_state/1,2 return the gen_event state"];
+get_state(Config) when is_list(Config) ->
+    ?line {ok, Pid} = gen_event:start({local, my_dummy_handler}),
+    State1 = self(),
+    ?line ok = gen_event:add_handler(my_dummy_handler, dummy1_h, [State1]),
+    ?line [{dummy1_h,false,State1}] = sys:get_state(Pid),
+    ?line [{dummy1_h,false,State1}] = sys:get_state(Pid, 5000),
+    State2 = {?MODULE, self()},
+    ?line ok = gen_event:add_handler(my_dummy_handler, {dummy1_h,id}, [State2]),
+    ?line Result1 = sys:get_state(Pid),
+    ?line [{dummy1_h,false,State1},{dummy1_h,id,State2}] = lists:sort(Result1),
+    ?line Result2 = sys:get_state(Pid, 5000),
+    ?line [{dummy1_h,false,State1},{dummy1_h,id,State2}] = lists:sort(Result2),
+    ?line ok = gen_event:stop(Pid),
+    ok.
+
+replace_state(suite) ->
+    [];
+replace_state(doc) ->
+    ["Test that replace_state/2,3 replace the gen_event state"];
+replace_state(Config) when is_list(Config) ->
+    ?line {ok, Pid} = gen_event:start({local, my_dummy_handler}),
+    State1 = self(),
+    ?line ok = gen_event:add_handler(my_dummy_handler, dummy1_h, [State1]),
+    ?line [{dummy1_h,false,State1}] = sys:get_state(Pid),
+    NState1 = "replaced",
+    Replace1 = fun({dummy1_h,false,_}=S) -> setelement(3,S,NState1) end,
+    ?line [{dummy1_h,false,NState1}] = sys:replace_state(Pid, Replace1),
+    ?line [{dummy1_h,false,NState1}] = sys:get_state(Pid),
+    NState2 = "replaced again",
+    Replace2 = fun({dummy1_h,false,_}=S) -> setelement(3,S,NState2) end,
+    ?line [{dummy1_h,false,NState2}] = sys:replace_state(Pid, Replace2, 5000),
+    ?line [{dummy1_h,false,NState2}] = sys:get_state(Pid),
+    %% verify no change in state if replace function crashes
+    Replace3 = fun(_) -> exit(fail) end,
+    ?line [{dummy1_h,false,NState2}] = sys:replace_state(Pid, Replace3),
+    ?line [{dummy1_h,false,NState2}] = sys:get_state(Pid),
+    ok.
diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl
index a637a8543b..f6b0fbc20d 100644
--- a/lib/stdlib/test/gen_fsm_SUITE.erl
+++ b/lib/stdlib/test/gen_fsm_SUITE.erl
@@ -31,7 +31,7 @@
 
 -export([shutdown/1]).
 
--export([ sys1/1, call_format_status/1, error_format_status/1]).
+-export([ sys1/1, call_format_status/1, error_format_status/1, get_state/1, replace_state/1]).
 
 -export([hibernate/1,hiber_idle/3,hiber_wakeup/3,hiber_idle/2,hiber_wakeup/2]).
 
@@ -66,7 +66,7 @@ groups() ->
        start8, start9, start10, start11, start12]},
      {abnormal, [], [abnormal1, abnormal2]},
      {sys, [],
-      [sys1, call_format_status, error_format_status]}].
+      [sys1, call_format_status, error_format_status, get_state, replace_state]}].
 
 init_per_suite(Config) ->
     Config.
@@ -413,6 +413,40 @@ error_format_status(Config) when is_list(Config) ->
     process_flag(trap_exit, OldFl),
     ok.
 
+get_state(Config) when is_list(Config) ->
+    State = self(),
+    ?line {ok, Pid} = gen_fsm:start(?MODULE, {state_data, State}, []),
+    ?line {idle, State} = sys:get_state(Pid),
+    ?line {idle, State} = sys:get_state(Pid, 5000),
+    ?line stop_it(Pid),
+
+    %% check that get_state can handle a name being an atom (pid is
+    %% already checked by the previous test)
+    ?line {ok, Pid2} = gen_fsm:start({local, gfsm}, gen_fsm_SUITE, {state_data, State}, []),
+    ?line {idle, State} = sys:get_state(gfsm),
+    ?line {idle, State} = sys:get_state(gfsm, 5000),
+    ?line stop_it(Pid2),
+    ok.
+
+replace_state(Config) when is_list(Config) ->
+    State = self(),
+    ?line {ok, Pid} = gen_fsm:start(?MODULE, {state_data, State}, []),
+    ?line {idle, State} = sys:get_state(Pid),
+    NState1 = "replaced",
+    Replace1 = fun({StateName, _}) -> {StateName, NState1} end,
+    ?line {idle, NState1} = sys:replace_state(Pid, Replace1),
+    ?line {idle, NState1} = sys:get_state(Pid),
+    NState2 = "replaced again",
+    Replace2 = fun({idle, _}) -> {state0, NState2} end,
+    ?line {state0, NState2} = sys:replace_state(Pid, Replace2, 5000),
+    ?line {state0, NState2} = sys:get_state(Pid),
+    %% verify no change in state if replace function crashes
+    Replace3 = fun(_) -> error(fail) end,
+    ?line {state0, NState2} = sys:replace_state(Pid, Replace3),
+    ?line {state0, NState2} = sys:get_state(Pid),
+    ?line stop_it(Pid),
+    ok.
+
 %% Hibernation
 hibernate(suite) -> [];
 hibernate(Config) when is_list(Config) ->
diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl
index dffeadb423..a5cba6e4c4 100644
--- a/lib/stdlib/test/gen_server_SUITE.erl
+++ b/lib/stdlib/test/gen_server_SUITE.erl
@@ -32,7 +32,7 @@
 	 spec_init_local_registered_parent/1, 
 	 spec_init_global_registered_parent/1,
 	 otp_5854/1, hibernate/1, otp_7669/1, call_format_status/1,
-	 error_format_status/1, call_with_huge_message_queue/1
+	 error_format_status/1, get_state/1, replace_state/1, call_with_huge_message_queue/1
 	]).
 
 % spawn export
@@ -57,6 +57,7 @@ all() ->
      spec_init_local_registered_parent,
      spec_init_global_registered_parent, otp_5854, hibernate,
      otp_7669, call_format_status, error_format_status,
+     get_state, replace_state,
      call_with_huge_message_queue].
 
 groups() -> 
@@ -1033,6 +1034,51 @@ error_format_status(Config) when is_list(Config) ->
     process_flag(trap_exit, OldFl),
     ok.
 
+%% Verify that sys:get_state correctly returns gen_server state
+%%
+get_state(suite) ->
+    [];
+get_state(doc) ->
+    ["Test that sys:get_state/1,2 return the gen_server state"];
+get_state(Config) when is_list(Config) ->
+    State = self(),
+    ?line {ok, _Pid} = gen_server:start_link({local, get_state},
+                                             ?MODULE, {state,State}, []),
+    ?line State = sys:get_state(get_state),
+    ?line State = sys:get_state(get_state, 5000),
+    ?line {ok, Pid} = gen_server:start_link(?MODULE, {state,State}, []),
+    ?line State = sys:get_state(Pid),
+    ?line State = sys:get_state(Pid, 5000),
+    ok.
+
+%% Verify that sys:replace_state correctly replaces gen_server state
+%%
+replace_state(suite) ->
+    [];
+replace_state(doc) ->
+    ["Test that sys:replace_state/1,2 replace the gen_server state"];
+replace_state(Config) when is_list(Config) ->
+    State = self(),
+    ?line {ok, _Pid} = gen_server:start_link({local, replace_state},
+                                             ?MODULE, {state,State}, []),
+    ?line State = sys:get_state(replace_state),
+    NState1 = "replaced",
+    Replace1 = fun(_) -> NState1 end,
+    ?line NState1 = sys:replace_state(replace_state, Replace1),
+    ?line NState1 = sys:get_state(replace_state),
+    ?line {ok, Pid} = gen_server:start_link(?MODULE, {state,NState1}, []),
+    ?line NState1 = sys:get_state(Pid),
+    Suffix = " again",
+    NState2 = NState1 ++ Suffix,
+    Replace2 = fun(S) -> S ++ Suffix end,
+    ?line NState2 = sys:replace_state(Pid, Replace2, 5000),
+    ?line NState2 = sys:get_state(Pid, 5000),
+    %% verify no change in state if replace function crashes
+    Replace3 = fun(_) -> throw(fail) end,
+    ?line NState2 = sys:replace_state(Pid, Replace3),
+    ?line NState2 = sys:get_state(Pid, 5000),
+    ok.
+
 %% Test that the time for a huge message queue is not
 %% significantly slower than with an empty message queue.
 call_with_huge_message_queue(Config) when is_list(Config) ->