Merge branch 'maint'

8 files changed, 273 insertions, 13 deletions

diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml
index 073faf2df2..a177b80739 100644
--- a/lib/stdlib/doc/src/sys.xml
+++ b/lib/stdlib/doc/src/sys.xml
@@ -211,18 +211,87 @@
         <p>Gets the status of the process.</p>
         <p>The value of <c><anno>Misc</anno></c> varies for different types of
           processes. For example, a <c>gen_server</c> process returns
-          the callback module's state, and a <c>gen_fsm</c> process
-          returns information such as its current state name. Callback
-          modules for <c>gen_server</c> and <c>gen_fsm</c> can also
-          customise the value of <c><anno>Misc</anno></c> by exporting
-          a <c>format_status/2</c> function that contributes
-          module-specific information;
-          see <seealso marker="gen_server#Module:format_status/2">gen_server:format_status/2</seealso>
-          and <seealso marker="gen_fsm#Module:format_status/2">gen_fsm:format_status/2</seealso>
+          the callback module's state, a <c>gen_fsm</c> process
+          returns information such as its current state name and state data,
+          and a <c>gen_event</c> process returns information about each of its
+          registered handlers. Callback modules for <c>gen_server</c>,
+          <c>gen_fsm</c>, and <c>gen_event</c> can also customise the value
+          of <c><anno>Misc</anno></c> by exporting a <c>format_status/2</c>
+          function that contributes module-specific information;
+          see <seealso marker="gen_server#Module:format_status/2">gen_server:format_status/2</seealso>,
+          <seealso marker="gen_fsm#Module:format_status/2">gen_fsm:format_status/2</seealso>, and
+          <seealso marker="gen_event#Module:format_status/2">gen_event:format_status/2</seealso>
           for more details.</p>
       </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..6be5a299b6 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) ->
+    {ok, Pid} = gen_event:start({local, my_dummy_handler}),
+    State1 = self(),
+    ok = gen_event:add_handler(my_dummy_handler, dummy1_h, [State1]),
+    [{dummy1_h,false,State1}] = sys:get_state(Pid),
+    [{dummy1_h,false,State1}] = sys:get_state(Pid, 5000),
+    State2 = {?MODULE, self()},
+    ok = gen_event:add_handler(my_dummy_handler, {dummy1_h,id}, [State2]),
+    Result1 = sys:get_state(Pid),
+    [{dummy1_h,false,State1},{dummy1_h,id,State2}] = lists:sort(Result1),
+    Result2 = sys:get_state(Pid, 5000),
+    [{dummy1_h,false,State1},{dummy1_h,id,State2}] = lists:sort(Result2),
+    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) ->
+    {ok, Pid} = gen_event:start({local, my_dummy_handler}),
+    State1 = self(),
+    ok = gen_event:add_handler(my_dummy_handler, dummy1_h, [State1]),
+    [{dummy1_h,false,State1}] = sys:get_state(Pid),
+    NState1 = "replaced",
+    Replace1 = fun({dummy1_h,false,_}=S) -> setelement(3,S,NState1) end,
+    [{dummy1_h,false,NState1}] = sys:replace_state(Pid, Replace1),
+    [{dummy1_h,false,NState1}] = sys:get_state(Pid),
+    NState2 = "replaced again",
+    Replace2 = fun({dummy1_h,false,_}=S) -> setelement(3,S,NState2) end,
+    [{dummy1_h,false,NState2}] = sys:replace_state(Pid, Replace2, 5000),
+    [{dummy1_h,false,NState2}] = sys:get_state(Pid),
+    %% verify no change in state if replace function crashes
+    Replace3 = fun(_) -> exit(fail) end,
+    [{dummy1_h,false,NState2}] = sys:replace_state(Pid, Replace3),
+    [{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..fd15838b7d 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(),
+    {ok, Pid} = gen_fsm:start(?MODULE, {state_data, State}, []),
+    {idle, State} = sys:get_state(Pid),
+    {idle, State} = sys:get_state(Pid, 5000),
+    stop_it(Pid),
+
+    %% check that get_state can handle a name being an atom (pid is
+    %% already checked by the previous test)
+    {ok, Pid2} = gen_fsm:start({local, gfsm}, gen_fsm_SUITE, {state_data, State}, []),
+    {idle, State} = sys:get_state(gfsm),
+    {idle, State} = sys:get_state(gfsm, 5000),
+    stop_it(Pid2),
+    ok.
+
+replace_state(Config) when is_list(Config) ->
+    State = self(),
+    {ok, Pid} = gen_fsm:start(?MODULE, {state_data, State}, []),
+    {idle, State} = sys:get_state(Pid),
+    NState1 = "replaced",
+    Replace1 = fun({StateName, _}) -> {StateName, NState1} end,
+    {idle, NState1} = sys:replace_state(Pid, Replace1),
+    {idle, NState1} = sys:get_state(Pid),
+    NState2 = "replaced again",
+    Replace2 = fun({idle, _}) -> {state0, NState2} end,
+    {state0, NState2} = sys:replace_state(Pid, Replace2, 5000),
+    {state0, NState2} = sys:get_state(Pid),
+    %% verify no change in state if replace function crashes
+    Replace3 = fun(_) -> error(fail) end,
+    {state0, NState2} = sys:replace_state(Pid, Replace3),
+    {state0, NState2} = sys:get_state(Pid),
+    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..3b6a3f38bc 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(),
+    {ok, _Pid} = gen_server:start_link({local, get_state},
+                                             ?MODULE, {state,State}, []),
+    State = sys:get_state(get_state),
+    State = sys:get_state(get_state, 5000),
+    {ok, Pid} = gen_server:start_link(?MODULE, {state,State}, []),
+    State = sys:get_state(Pid),
+    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(),
+    {ok, _Pid} = gen_server:start_link({local, replace_state},
+                                             ?MODULE, {state,State}, []),
+    State = sys:get_state(replace_state),
+    NState1 = "replaced",
+    Replace1 = fun(_) -> NState1 end,
+    NState1 = sys:replace_state(replace_state, Replace1),
+    NState1 = sys:get_state(replace_state),
+    {ok, Pid} = gen_server:start_link(?MODULE, {state,NState1}, []),
+    NState1 = sys:get_state(Pid),
+    Suffix = " again",
+    NState2 = NState1 ++ Suffix,
+    Replace2 = fun(S) -> S ++ Suffix end,
+    NState2 = sys:replace_state(Pid, Replace2, 5000),
+    NState2 = sys:get_state(Pid, 5000),
+    %% verify no change in state if replace function crashes
+    Replace3 = fun(_) -> throw(fail) end,
+    NState2 = sys:replace_state(Pid, Replace3),
+    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) ->