From 6c298a7bfa332e5b7d153648d741740abc3bcdf8 Mon Sep 17 00:00:00 2001 From: Steve Vinoski Date: Wed, 19 Mar 2014 11:45:11 -0400 Subject: 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. --- lib/stdlib/doc/src/sys.xml | 73 +++++++++++++++++++++- lib/stdlib/src/gen_event.erl | 37 ++++++------ lib/stdlib/src/gen_fsm.erl | 20 +++--- lib/stdlib/src/gen_server.erl | 16 ++--- lib/stdlib/src/sys.erl | 65 +++++++++++++++++--- lib/stdlib/test/Makefile | 2 + lib/stdlib/test/gen_event_SUITE.erl | 11 ++++ lib/stdlib/test/gen_fsm_SUITE.erl | 20 +++++- lib/stdlib/test/gen_server_SUITE.erl | 15 ++++- lib/stdlib/test/sys_SUITE.erl | 84 ++++++++++++++++++++++++-- lib/stdlib/test/sys_sp1.erl | 114 +++++++++++++++++++++++++++++++++++ lib/stdlib/test/sys_sp2.erl | 107 ++++++++++++++++++++++++++++++++ 12 files changed, 511 insertions(+), 53 deletions(-) create mode 100644 lib/stdlib/test/sys_sp1.erl create mode 100644 lib/stdlib/test/sys_sp2.erl (limited to 'lib/stdlib') diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml index ab8b380f49..a46fa1289f 100644 --- a/lib/stdlib/doc/src/sys.xml +++ b/lib/stdlib/doc/src/sys.xml @@ -246,6 +246,22 @@ {Module, Id, HandlerState}, where Module is the event handler's module name, Id is the handler's ID (which is the value false if it was registered without an ID), and HandlerState is the handler's state.

+

If the callback module exports a system_get_state/1 function, it will be called in the + target process to get its state. Its argument is the same as the Misc value returned by + get_status/1,2, and the system_get_state/1 + function is expected to extract the callback module's state from it. The system_get_state/1 + function must return {ok, State} where State is the callback module's state.

+

If the callback module does not export a system_get_state/1 function, get_state/1,2 + assumes the Misc value is the callback module's state and returns it directly instead.

+

If the callback module's system_get_state/1 function crashes or throws an exception, the + caller exits with error {callback_failed, {Module, system_get_state}, {Class, Reason}} where + Module is the name of the callback module and Class and Reason indicate + details of the exception.

+

The system_get_state/1 function is primarily useful for user-defined + behaviours and modules that implement OTP special + processes. The gen_server, gen_fsm, and gen_event OTP + behaviour modules export this function, and so callback modules for those behaviours + need not supply their own.

To obtain more information about a process, including its state, see get_status/1 and get_status/2.

@@ -289,6 +305,28 @@ 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 gen_event process.

+

If the callback module exports a system_replace_state/2 function, it will be called in the + target process to replace its state using StateFun. Its two arguments are StateFun + and Misc, where Misc is the same as the Misc value returned by + get_status/1,2. A system_replace_state/2 function + is expected to return {ok, NewState, NewMisc} where NewState is the callback module's + new state obtained by calling StateFun, and NewMisc is a possibly new value used to + replace the original Misc (required since Misc often contains the callback + module's state within it).

+

If the callback module does not export a system_replace_state/2 function, + replace_state/2,3 assumes the Misc value is the callback module's state, passes it + to StateFun and uses the return value as both the new state and as the new value of + Misc.

+

If the callback module's system_replace_state/2 function crashes or throws an exception, + the caller exits with error {callback_failed, {Module, system_replace_state}, {Class, Reason}} + where Module is the name of the callback module and Class and Reason indicate details + of the exception. If the callback module does not provide a system_replace_state/2 function and + StateFun crashes or throws an exception, the caller exits with error + {callback_failed, StateFun, {Class, Reason}}.

+

The system_replace_state/2 function is primarily useful for user-defined behaviours and + modules that implement OTP special processes. The + gen_server, gen_fsm, and gen_event OTP behaviour modules export this function, + and so callback modules for those behaviours need not supply their own.

@@ -322,7 +360,7 @@
Process Implementation Functions -

The following functions are used when implementing a +

The following functions are used when implementing a special process. This is an ordinary process which does not use a standard behaviour, but a process which understands the standard system messages.

@@ -375,8 +413,9 @@ process continues the execution, or Module:system_terminate(Reason, Parent, Debug, Misc) if the process should terminate. The Module must export - system_continue/3, system_terminate/4, and - system_code_change/4 (see below). + system_continue/3, system_terminate/4, + system_code_change/4, system_get_state/1 and + system_replace_state/2 (see below).

The Misc argument can be used to save internal data in a process, for example its state. It is sent to @@ -444,6 +483,34 @@ defined, the atom undefined is sent.

 + + Mod:system_get_state(Misc) -> {ok, State} + Called when the process should return its current state + + Misc = term() + State = term() + + +

This function is called from sys:handle_system_msg/6 when the process + should return a term that reflects its current state. State is the + value returned by sys:get_state/2.

+ + + + Mod:system_replace_state(StateFun, Misc) -> {ok, NState, NMisc} + Called when the process should replace its current state + + StateFun = fun((State :: term()) -> NState) + Misc = term() + NState = term() + NMisc = term() + + +

This function is called from sys:handle_system_msg/6 when the process + should replace its current state. NState is the value returned by + sys:replace_state/3.

+ + diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 7629e88fbf..d39dd89d3a 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -40,6 +40,8 @@ system_continue/3, system_terminate/4, system_code_change/4, + system_get_state/1, + system_replace_state/2, format_status/2]). -export_type([handler/0, handler_args/0, add_handler_ret/0, @@ -229,24 +231,6 @@ 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); @@ -383,6 +367,23 @@ system_code_change([ServerName, MSL, Hib], Module, OldVsn, Extra) -> MSL), {ok, [ServerName, MSL1, Hib]}. +system_get_state([_ServerName, MSL, _Hib]) -> + {ok, [{Mod,Id,State} || #handler{module=Mod, id=Id, state=State} <- MSL]}. + +system_replace_state(StateFun, [ServerName, MSL, Hib]) -> + {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]), + {ok, NStates, [ServerName, NMSL, Hib]}. + %%----------------------------------------------------------------- %% Format debug messages. Print them as the call-back module sees %% them, not as the real erlang messages. Use trace for that. diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index e9654322f1..e914f7d0b2 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -118,6 +118,8 @@ system_continue/3, system_terminate/4, system_code_change/4, + system_get_state/1, + system_replace_state/2, format_status/2]). -import(error_logger, [format/2]). @@ -422,17 +424,6 @@ 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); @@ -467,6 +458,13 @@ system_code_change([Name, StateName, StateData, Mod, Time], Else -> Else end. +system_get_state([_Name, StateName, StateData, _Mod, _Time]) -> + {ok, {StateName, StateData}}. + +system_replace_state(StateFun, [Name, StateName, StateData, Mod, Time]) -> + Result = {NStateName, NStateData} = StateFun({StateName, StateData}), + {ok, Result, [Name, NStateName, NStateData, Mod, Time]}. + %%----------------------------------------------------------------- %% Format debug messages. Print them as the call-back module sees %% them, not as the real erlang messages. Use trace for that. diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 5f14e48b0a..202a931fae 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -98,6 +98,8 @@ -export([system_continue/3, system_terminate/4, system_code_change/4, + system_get_state/1, + system_replace_state/2, format_status/2]). %% Internal exports @@ -372,13 +374,6 @@ 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); @@ -687,6 +682,13 @@ system_code_change([Name, State, Mod, Time], _Module, OldVsn, Extra) -> Else -> Else end. +system_get_state([_Name, State, _Mod, _Time]) -> + {ok, State}. + +system_replace_state(StateFun, [Name, State, Mod, Time]) -> + NState = StateFun(State), + {ok, NState, [Name, NState, Mod, Time]}. + %%----------------------------------------------------------------- %% Format debug messages. Print them as the call-back module sees %% them, not as the real erlang messages. Use trace for that. diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl index 04f8dfb61b..e25cc25f57 100644 --- a/lib/stdlib/src/sys.erl +++ b/lib/stdlib/src/sys.erl @@ -102,20 +102,31 @@ 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). +get_state(Name) -> + case send_system_msg(Name, get_state) of + {error, Reason} -> error(Reason); + State -> State + end. -spec get_state(Name, Timeout) -> State when Name :: name(), Timeout :: timeout(), State :: term(). -get_state(Name, Timeout) -> send_system_msg(Name, get_state, Timeout). +get_state(Name, Timeout) -> + case send_system_msg(Name, get_state, Timeout) of + {error, Reason} -> error(Reason); + State -> State + end. -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}). + case send_system_msg(Name, {replace_state, StateFun}) of + {error, Reason} -> error(Reason); + State -> State + end. -spec replace_state(Name, StateFun, Timeout) -> NewState when Name :: name(), @@ -123,7 +134,10 @@ replace_state(Name, StateFun) -> Timeout :: timeout(), NewState :: term(). replace_state(Name, StateFun, Timeout) -> - send_system_msg(Name, {replace_state, StateFun}, Timeout). + case send_system_msg(Name, {replace_state, StateFun}, Timeout) of + {error, Reason} -> error(Reason); + State -> State + end. -spec change_code(Name, Module, OldVsn, Extra) -> 'ok' | {error, Reason} when Name :: name(), @@ -390,10 +404,11 @@ 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_state, _Parent, Mod, Debug, Misc) -> + {SysState, do_get_state(Mod, Misc), Debug, Misc}; +do_cmd(SysState, {replace_state, StateFun}, _Parent, Mod, Debug, Misc) -> + {Res, NMisc} = do_replace_state(StateFun, Mod, Misc), + {SysState, Res, Debug, NMisc}; do_cmd(SysState, get_status, Parent, Mod, Debug, Misc) -> Res = get_status(SysState, Parent, Mod, Debug, Misc), {SysState, Res, Debug, Misc}; @@ -407,6 +422,40 @@ do_cmd(suspended, {change_code, Module, Vsn, Extra}, _Parent, do_cmd(SysState, Other, _Parent, _Mod, Debug, Misc) -> {SysState, {error, {unknown_system_msg, Other}}, Debug, Misc}. +do_get_state(Mod, Misc) -> + case erlang:function_exported(Mod, system_get_state, 1) of + true -> + try + {ok, State} = Mod:system_get_state(Misc), + State + catch + Cl:Exc -> + {error, {callback_failed,{Mod,system_get_state},{Cl,Exc}}} + end; + false -> + Misc + end. + +do_replace_state(StateFun, Mod, Misc) -> + case erlang:function_exported(Mod, system_replace_state, 2) of + true -> + try + {ok, State, NMisc} = Mod:system_replace_state(StateFun, Misc), + {State, NMisc} + catch + Cl:Exc -> + {{error, {callback_failed,{Mod,system_replace_state},{Cl,Exc}}}, Misc} + end; + false -> + try + NMisc = StateFun(Misc), + {NMisc, NMisc} + catch + Cl:Exc -> + {{error, {callback_failed,StateFun,{Cl,Exc}}}, Misc} + end + end. + get_status(SysState, Parent, Mod, Debug, Misc) -> PDict = get(), FmtMisc = 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. -- cgit v1.2.3