fix sys:get_state/1,2 and sys:replace_state/2,3 when sys suspended

Add two new system callbacks Module:system_get_state/1 and
Module:system_replace_state/2 to allow sys:get_state/1,2 and
sys:replace_state/2,3 to operate correctly even if a process is sys
suspended. Modify gen_server, gen_fsm, and gen_event to support the new
callbacks.

If a callback module does not export these functions, then by default the
Misc value (the same as that passed as the final argument to
sys:handle_system_msg/6, and returned as part of the return value of
sys:get_status/1,2) is treated as the callback module's state.

The previous behaviour of intercepting the system message and passing a
tuple of size 2 as the last argument to sys:handle_system_msg/6 is no
longer supported.

Add tests to verify the correctness of sys:get_state/1,2 and
sys:replace_state/2,3 when processes are sys suspended. Add two tests for
modules that implement special processes, one that exports
system_get_state/1 and system_replace_state/2 and one that doesn't.

Much of the credit for this patch goes to James Fish, who reported the
initial problem and implemented much of the fix.

7 files changed, 347 insertions, 6 deletions

diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile
index af82f22b21..39f6ce423a 100644
--- a/lib/stdlib/test/Makefile
+++ b/lib/stdlib/test/Makefile
@@ -73,6 +73,8 @@ MODULES= \
 	supervisor_SUITE \
 	supervisor_bridge_SUITE \
 	sys_SUITE \
+	sys_sp1 \
+	sys_sp2 \
 	tar_SUITE \
 	timer_SUITE \
 	timer_simple_SUITE \
diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl
index 5819ef3890..60a1ba8c60 100644
--- a/lib/stdlib/test/gen_event_SUITE.erl
+++ b/lib/stdlib/test/gen_event_SUITE.erl
@@ -974,6 +974,10 @@ get_state(Config) when is_list(Config) ->
     [{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 = sys:suspend(Pid),
+    Result3 = sys:get_state(Pid),
+    [{dummy1_h,false,State1},{dummy1_h,id,State2}] = lists:sort(Result3),
+    ok = sys:resume(Pid),
     ok = gen_event:stop(Pid),
     ok.
 
@@ -998,4 +1002,11 @@ replace_state(Config) when is_list(Config) ->
     Replace3 = fun(_) -> exit(fail) end,
     [{dummy1_h,false,NState2}] = sys:replace_state(Pid, Replace3),
     [{dummy1_h,false,NState2}] = sys:get_state(Pid),
+    %% verify state replaced if process sys suspended
+    NState3 = "replaced again and again",
+    Replace4 = fun({dummy1_h,false,_}=S) -> setelement(3,S,NState3) end,
+    ok = sys:suspend(Pid),
+    [{dummy1_h,false,NState3}] = sys:replace_state(Pid, Replace4),
+    ok = sys:resume(Pid),
+    [{dummy1_h,false,NState3}] = sys:get_state(Pid),
     ok.
diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl
index fd15838b7d..8aeec07ae8 100644
--- a/lib/stdlib/test/gen_fsm_SUITE.erl
+++ b/lib/stdlib/test/gen_fsm_SUITE.erl
@@ -426,6 +426,14 @@ get_state(Config) when is_list(Config) ->
     {idle, State} = sys:get_state(gfsm),
     {idle, State} = sys:get_state(gfsm, 5000),
     stop_it(Pid2),
+
+    %% check that get_state works when pid is sys suspended
+    {ok, Pid3} = gen_fsm:start(gen_fsm_SUITE, {state_data, State}, []),
+    {idle, State} = sys:get_state(Pid3),
+    ok = sys:suspend(Pid3),
+    {idle, State} = sys:get_state(Pid3, 5000),
+    ok = sys:resume(Pid3),
+    stop_it(Pid3),
     ok.
 
 replace_state(Config) when is_list(Config) ->
@@ -442,8 +450,18 @@ replace_state(Config) when is_list(Config) ->
     {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),
+    {'EXIT',{{callback_failed,
+	      {gen_fsm,system_replace_state},{error,fail}},_}} =
+	(catch sys:replace_state(Pid, Replace3)),
     {state0, NState2} = sys:get_state(Pid),
+    %% verify state replaced if process sys suspended
+    ok = sys:suspend(Pid),
+    Suffix2 = " and again",
+    NState3 = NState2 ++ Suffix2,
+    Replace4 = fun({StateName, _}) -> {StateName, NState3} end,
+    {state0, NState3} = sys:replace_state(Pid, Replace4),
+    ok = sys:resume(Pid),
+    {state0, NState3} = sys:get_state(Pid, 5000),
     stop_it(Pid),
     ok.
 
diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl
index a360a0809b..960e7f60e7 100644
--- a/lib/stdlib/test/gen_server_SUITE.erl
+++ b/lib/stdlib/test/gen_server_SUITE.erl
@@ -1049,6 +1049,9 @@ get_state(Config) when is_list(Config) ->
     {ok, Pid} = gen_server:start_link(?MODULE, {state,State}, []),
     State = sys:get_state(Pid),
     State = sys:get_state(Pid, 5000),
+    ok = sys:suspend(Pid),
+    State = sys:get_state(Pid),
+    ok = sys:resume(Pid),
     ok.
 
 %% Verify that sys:replace_state correctly replaces gen_server state
@@ -1075,8 +1078,18 @@ replace_state(Config) when is_list(Config) ->
     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),
+    {'EXIT',{{callback_failed,
+	      {gen_server,system_replace_state},{throw,fail}},_}} =
+	(catch sys:replace_state(Pid, Replace3)),
     NState2 = sys:get_state(Pid, 5000),
+    %% verify state replaced if process sys suspended
+    ok = sys:suspend(Pid),
+    Suffix2 = " and again",
+    NState3 = NState2 ++ Suffix2,
+    Replace4 = fun(S) -> S ++ Suffix2 end,
+    NState3 = sys:replace_state(Pid, Replace4),
+    ok = sys:resume(Pid),
+    NState3 = sys:get_state(Pid, 5000),
     ok.
 
 %% Test that the time for a huge message queue is not
diff --git a/lib/stdlib/test/sys_SUITE.erl b/lib/stdlib/test/sys_SUITE.erl
index c06ba545e7..f38bc87ae5 100644
--- a/lib/stdlib/test/sys_SUITE.erl
+++ b/lib/stdlib/test/sys_SUITE.erl
@@ -19,7 +19,7 @@
 -module(sys_SUITE).
 -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
 	 init_per_group/2,end_per_group/2,log/1,log_to_file/1,
-	 stats/1,trace/1,suspend/1,install/1]).
+	 stats/1,trace/1,suspend/1,install/1,special_process/1]).
 -export([handle_call/3,terminate/2,init/1]).
 -include_lib("test_server/include/test_server.hrl").
 
@@ -27,14 +27,12 @@
 
 
 %% Doesn't look into change_code at all
-%% Doesn't address writing your own process that understands
-%% system messages at all.
 
 
 suite() -> [{ct_hooks,[ts_install_cth]}].
 
 all() -> 
-    [log, log_to_file, stats, trace, suspend, install].
+    [log, log_to_file, stats, trace, suspend, install, special_process].
 
 groups() -> 
     [].
@@ -157,6 +155,84 @@ install(Config) when is_list(Config) ->
     ?line stop(),
     ok.
 
+special_process(suite) -> [];
+special_process(Config) when is_list(Config) ->
+    ok = spec_proc(sys_sp1),
+    ok = spec_proc(sys_sp2).
+
+spec_proc(Mod) ->
+    {ok,_} = Mod:start_link(100),
+    ok = sys:statistics(Mod,true),
+    ok = sys:trace(Mod,true),
+    1 = Ch = Mod:alloc(),
+    Free = lists:seq(2,100),
+    Replace = case sys:get_state(Mod) of
+		  {[Ch],Free} ->
+		      fun({A,F}) ->
+			      Free = F,
+			      {A,[2,3,4]}
+		      end;
+		  {state,[Ch],Free} ->
+		      fun({state,A,F}) ->
+			      Free = F,
+			      {state,A,[2,3,4]}
+		      end
+	      end,
+    case sys:replace_state(Mod, Replace) of
+	{[Ch],[2,3,4]} -> ok;
+	{state,[Ch],[2,3,4]} -> ok
+    end,
+    ok = Mod:free(Ch),
+    case sys:get_state(Mod) of
+	{[],[1,2,3,4]} -> ok;
+	{state,[],[1,2,3,4]} -> ok
+    end,
+    {ok,[{start_time,_},
+	 {current_time,_},
+	 {reductions,_},
+	 {messages_in,2},
+	 {messages_out,1}]} = sys:statistics(Mod,get),
+    ok = sys:statistics(Mod,false),
+    [] = sys:replace_state(Mod, fun(_) -> [] end),
+    process_flag(trap_exit,true),
+    ok = case catch sys:get_state(Mod) of
+	     [] ->
+		 ok;
+	     {'EXIT',{{callback_failed,
+		       {Mod,system_get_state},{throw,fail}},_}} ->
+		 ok
+	 end,
+    Mod:stop(),
+    WaitForUnregister = fun W() ->
+		       case whereis(Mod) of
+			   undefined -> ok;
+			   _ -> timer:sleep(10), W()
+		       end
+	       end,
+    WaitForUnregister(),
+    {ok,_} = Mod:start_link(4),
+    ok = case catch sys:replace_state(Mod, fun(_) -> {} end) of
+	     {} ->
+		 ok;
+	     {'EXIT',{{callback_failed,
+		       {Mod,system_replace_state},{throw,fail}},_}} ->
+		 ok
+	 end,
+    Mod:stop(),
+    WaitForUnregister(),
+    {ok,_} = Mod:start_link(4),
+    StateFun = fun(_) -> error(fail) end,
+    ok = case catch sys:replace_state(Mod, StateFun) of
+	     {} ->
+		 ok;
+	     {'EXIT',{{callback_failed,
+		       {Mod,system_replace_state},{error,fail}},_}} ->
+		 ok;
+	     {'EXIT',{{callback_failed,StateFun,{error,fail}},_}} ->
+		 ok
+	 end,
+    Mod:stop().
+
 %%%%%%%%%%%%%%%%%%%%
 %% Dummy server
 
diff --git a/lib/stdlib/test/sys_sp1.erl b/lib/stdlib/test/sys_sp1.erl
new file mode 100644
index 0000000000..e84ffcfa12
--- /dev/null
+++ b/lib/stdlib/test/sys_sp1.erl
@@ -0,0 +1,114 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(sys_sp1).
+-export([start_link/1, stop/0]).
+-export([alloc/0, free/1]).
+-export([init/1]).
+-export([system_continue/3, system_terminate/4,
+         write_debug/3,
+         system_get_state/1, system_replace_state/2]).
+
+%% Implements the ch4 example from the Design Principles doc.  Same as
+%% sys_sp2 except this module exports system_get_state/1 and
+%% system_replace_state/2
+
+start_link(NumCh) ->
+    proc_lib:start_link(?MODULE, init, [[self(),NumCh]]).
+
+stop() ->
+    ?MODULE ! stop,
+    ok.
+
+alloc() ->
+    ?MODULE ! {self(), alloc},
+    receive
+        {?MODULE, Res} ->
+            Res
+    end.
+
+free(Ch) ->
+    ?MODULE ! {free, Ch},
+    ok.
+
+init([Parent,NumCh]) ->
+    register(?MODULE, self()),
+    Chs = channels(NumCh),
+    Deb = sys:debug_options([]),
+    proc_lib:init_ack(Parent, {ok, self()}),
+    loop(Chs, Parent, Deb).
+
+loop(Chs, Parent, Deb) ->
+    receive
+        {From, alloc} ->
+            Deb2 = sys:handle_debug(Deb, fun write_debug/3,
+                                    ?MODULE, {in, alloc, From}),
+            {Ch, Chs2} = alloc(Chs),
+            From ! {?MODULE, Ch},
+            Deb3 = sys:handle_debug(Deb2, fun write_debug/3,
+                                    ?MODULE, {out, {?MODULE, Ch}, From}),
+            loop(Chs2, Parent, Deb3);
+        {free, Ch} ->
+            Deb2 = sys:handle_debug(Deb, fun write_debug/3,
+                                    ?MODULE, {in, {free, Ch}}),
+            Chs2 = free(Ch, Chs),
+            loop(Chs2, Parent, Deb2);
+        {system, From, Request} ->
+            sys:handle_system_msg(Request, From, Parent,
+                                  ?MODULE, Deb, Chs);
+        stop ->
+            sys:handle_debug(Deb, fun write_debug/3,
+                             ?MODULE, {in, stop}),
+            ok
+    end.
+
+system_continue(Parent, Deb, Chs) ->
+    loop(Chs, Parent, Deb).
+
+system_terminate(Reason, _Parent, _Deb, _Chs) ->
+    exit(Reason).
+
+system_get_state([]) ->
+    throw(fail);
+system_get_state(Chs) ->
+    {ok, Chs}.
+
+system_replace_state(_StateFun, {}) ->
+    throw(fail);
+system_replace_state(StateFun, Chs) ->
+    NChs = StateFun(Chs),
+    {ok, NChs, NChs}.
+
+write_debug(Dev, Event, Name) ->
+    io:format(Dev, "~p event = ~p~n", [Name, Event]).
+
+channels(NumCh) ->
+    {_Allocated=[], _Free=lists:seq(1,NumCh)}.
+
+alloc({_, []}) ->
+    {error, "no channels available"};
+alloc({Allocated, [H|T]}) ->
+    {H, {[H|Allocated], T}}.
+
+free(Ch, {Alloc, Free}=Channels) ->
+    case lists:member(Ch, Alloc) of
+        true ->
+            {lists:delete(Ch, Alloc), [Ch|Free]};
+        false ->
+            Channels
+    end.
diff --git a/lib/stdlib/test/sys_sp2.erl b/lib/stdlib/test/sys_sp2.erl
new file mode 100644
index 0000000000..56a5e4d071
--- /dev/null
+++ b/lib/stdlib/test/sys_sp2.erl
@@ -0,0 +1,107 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(sys_sp2).
+-export([start_link/1, stop/0]).
+-export([alloc/0, free/1]).
+-export([init/1]).
+-export([system_continue/3, system_terminate/4,
+         write_debug/3]).
+
+%% Implements the ch4 example from the Design Principles doc.  Same as
+%% sys_sp1 except this module does not export system_get_state/1 or
+%% system_replace_state/2
+
+start_link(NumCh) ->
+    proc_lib:start_link(?MODULE, init, [[self(),NumCh]]).
+
+stop() ->
+    ?MODULE ! stop,
+    ok.
+
+alloc() ->
+    ?MODULE ! {self(), alloc},
+    receive
+        {?MODULE, Res} ->
+            Res
+    end.
+
+free(Ch) ->
+    ?MODULE ! {free, Ch},
+    ok.
+
+%% can't use 2-tuple for state here as we do in sys_sp1, since the 2-tuple
+%% is not compatible with the backward compatibility handling for
+%% sys:get_state in sys.erl
+-record(state, {alloc,free}).
+
+init([Parent,NumCh]) ->
+    register(?MODULE, self()),
+    Chs = channels(NumCh),
+    Deb = sys:debug_options([]),
+    proc_lib:init_ack(Parent, {ok, self()}),
+    loop(Chs, Parent, Deb).
+
+loop(Chs, Parent, Deb) ->
+    receive
+        {From, alloc} ->
+            Deb2 = sys:handle_debug(Deb, fun write_debug/3,
+                                    ?MODULE, {in, alloc, From}),
+            {Ch, Chs2} = alloc(Chs),
+            From ! {?MODULE, Ch},
+            Deb3 = sys:handle_debug(Deb2, fun write_debug/3,
+                                    ?MODULE, {out, {?MODULE, Ch}, From}),
+            loop(Chs2, Parent, Deb3);
+        {free, Ch} ->
+            Deb2 = sys:handle_debug(Deb, fun write_debug/3,
+                                    ?MODULE, {in, {free, Ch}}),
+            Chs2 = free(Ch, Chs),
+            loop(Chs2, Parent, Deb2);
+        {system, From, Request} ->
+            sys:handle_system_msg(Request, From, Parent,
+                                  ?MODULE, Deb, Chs);
+        stop ->
+            sys:handle_debug(Deb, fun write_debug/3,
+                             ?MODULE, {in, stop}),
+            ok
+    end.
+
+system_continue(Parent, Deb, Chs) ->
+    loop(Chs, Parent, Deb).
+
+system_terminate(Reason, _Parent, _Deb, _Chs) ->
+    exit(Reason).
+
+write_debug(Dev, Event, Name) ->
+    io:format(Dev, "~p event = ~p~n", [Name, Event]).
+
+channels(NumCh) ->
+    #state{alloc=[], free=lists:seq(1,NumCh)}.
+
+alloc(#state{free=[]}=Channels) ->
+    {{error, "no channels available"}, Channels};
+alloc(#state{alloc=Allocated, free=[H|T]}) ->
+    {H, #state{alloc=[H|Allocated], free=T}}.
+
+free(Ch, #state{alloc=Alloc, free=Free}=Channels) ->
+    case lists:member(Ch, Alloc) of
+        true ->
+            #state{alloc=lists:delete(Ch, Alloc), free=[Ch|Free]};
+        false ->
+            Channels
+    end.