From 6ace96d3e5c9ac8ace3d8967bcafb3e6a081d9be Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Mon, 26 Oct 2015 11:52:17 +0100 Subject: New state machine --- lib/stdlib/doc/src/Makefile | 3 +- lib/stdlib/doc/src/gen_statem.xml | 1131 +++++++++++++++++++++++++ lib/stdlib/doc/src/ref_man.xml | 3 +- lib/stdlib/doc/src/specs.xml | 1 + lib/stdlib/src/Makefile | 3 +- lib/stdlib/src/gen_statem.erl | 1095 ++++++++++++++++++++++++ lib/stdlib/src/proc_lib.erl | 16 +- lib/stdlib/src/stdlib.app.src | 3 +- lib/stdlib/test/Makefile | 1 + lib/stdlib/test/error_logger_forwarder.erl | 8 +- lib/stdlib/test/gen_statem_SUITE.erl | 1250 ++++++++++++++++++++++++++++ 11 files changed, 3501 insertions(+), 13 deletions(-) create mode 100644 lib/stdlib/doc/src/gen_statem.xml create mode 100644 lib/stdlib/src/gen_statem.erl create mode 100644 lib/stdlib/test/gen_statem_SUITE.erl diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile index 196c86748f..26602764a6 100644 --- a/lib/stdlib/doc/src/Makefile +++ b/lib/stdlib/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2015. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -68,6 +68,7 @@ XML_REF3_FILES = \ gen_event.xml \ gen_fsm.xml \ gen_server.xml \ + gen_statem.xml \ io.xml \ io_lib.xml \ lib.xml \ diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml new file mode 100644 index 0000000000..885021f61c --- /dev/null +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -0,0 +1,1131 @@ + + + + +
+ + 2016 + Ericsson AB. All Rights Reserved. + + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + + + gen_statem + + + + +
+ gen_statem + Generic State Machine Behaviour + +

A behaviour module for implementing a state machine, primarily + a finite state machine, but an infinite state space is possible. + A generic state machine process (gen_statem) implemented using + this module will have a standard set of interface functions + and include functionality for tracing and error reporting. + It will also fit into an OTP supervision tree. Refer to + + OTP Design Principles for more information. +

+

A gen_statem assumes all specific parts to be located in a + callback module exporting a pre-defined set of functions. + The relationship between the behaviour functions and the callback + functions can be illustrated as follows:

+ 
+gen_statem module            Callback module
+-----------------            ---------------
+gen_statem:start
+gen_statem:start_link -----> Module:init/1
+
+gen_statem:stop       -----> Module:terminate/2
+
+gen_statem:call
+gen_statem:cast
+erlang:send
+erlang:'!'            -----> Module:State/5
+                             Module:handle_event/5
+
+-                     -----> Module:terminate/3
+
+-                     -----> Module:code_change/3
+

Events are of different + types + so the callback functions can know the origin of an event + and how to respond. +

+

If a callback function fails or returns a bad value, + the gen_statem will terminate. An exception of class + throw, + however, is not regarded as an error but as a valid return. +

+ +

The "state function" for a specific + state + in a gen_statem is the callback function that is called + for all events in this state. + An event can can be postponed causing it to be retried + after the state has changed, or more precisely; + after a state change all postponed events are retried + in the new state. +

+

The state machine + State + is normally an atom in which case the + state function + that will be called is + Module:State/5. + For a + State + that is not an atom the + state function + + Module:handle_event/5 + will be called. + If you use handle_event as a + state and later + decides to use non-atom states you will then have to + rewrite your code to stop using that state. +

+

When the using an atom-only + State + it becomes fairly obvious in the implementation code + which events are handled in which state + since there are different callback functions for different states. +

+

+ When using a non-atom State + all events are handled in the callback function + + Module:handle_event/5 + + so it may require more coding discipline to ensure what events + are handled in which state. Therefore it might be a wee bit + easier to accidentally postpone an event in two or more states + and not handling it in any of them causing a tight infinite + loop when the event bounces to be retried between the states. +

+

A gen_statem handles system messages as documented in + sys. + The sys module + can be used for debugging a gen_statem. +

+

Note that a gen_statem does not trap exit signals automatically, + this must be explicitly initiated by the callback module. +

+

Unless otherwise stated, all functions in this module fail if + the specified gen_statem does not exist or if bad arguments are given. +

+

The gen_statem process can go into hibernation (see + + erlang:hibernate/3 + ) if a + state function or + Module:init/1 + specifies 'hibernate' in the returned + StateOps list. + This might be useful if the server is expected to be idle + for a long time. However use this feature with care + since hibernation implies at least two garbage collections + (when hibernating and shortly after waking up) and that is not + something you'd want to do between each event on a busy server. +

+ + + + + + +

Name specification to use when starting a gen_statem server. + See + start_link/3 + and + + server_ref() + below. +

+ + + + + +

Server specification to use when addressing a gen_statem server. + See call/2 and + + server_name() + above. +

+

It can be:

+ + the pid(), + Name, + if the gen_statem is locally registered, + + {Name,Node}, + if the gen_statem is locally registered at another node, or + + {global,GlobalName}, + if the gen_statem is globally registered. + + {via,RegMod,ViaName}, + if the gen_statem is registered through + an alternative process registry. + The registry callback module RegMod + should export the functions + register_name/2, unregister_name/1, + whereis_name/1 and send/2, + which should behave like the corresponding functions + in global. + Thus, {via,global,GlobalName} is the same as + {global,GlobalName}. + + + + + + + +

Debug option that can be used when starting + a gen_statem server through for example + enter_loop/4. +

+

For every entry in Dbgs + the corresponding function in + sys will be called. +

+ + + + + +

Options that can be used when starting + a gen_statem server through for example + start_link/3. +

+ + + + + +

Return value from the start functions for_example + start_link/3. +

+ + + + + + +

Client address to use when replying through for example the + state_op() + {reply,Client,Reply} to a client + that has called the gen_statem server using + call/2. +

+ + + + + +

If the gen_statem State is an atom(), the + state function is + Module:State/5. + If it is any other term() the + state function is + + Module:handle_event/5 + . After a state change (NewState =/= State) + all postponed events are retried. +

+ + + + + +

A term() in which the state machine implementation + should store any state data it needs. The difference between + this data and the + state() + itself is that a change in this data does not cause + postponed events to be retried. +

+ + + + + +

External events are of 3 different type: + {call,Client}, cast or info. + Calls (synchronous) and casts (asynchronous) + originate from the corresponding API functions. + For calls the event contain whom to reply to. + Type info originates from normal messages sent + to the gen_statem process. + It is also possible for the state machine + implementation to insert events to itself, + in particular of types + timeout and internal. +

+ + + + + +

A fun() of arity 2 that takes an event + and returns a boolean. + When used in {remove_event,RemoveEventPredicate} + from state_op(). + The event for which the predicate returns true will + be removed. +

+

+ The predicate may not use a throw exception + to return its result. +

+ + + + + +

Either a + + state_option() + of which the first occurence + in the containing list takes precedence, or a + + state_operation() + that are performed in order of + the containing list. +

+

These may be returned from the + state function + or from Module:init/1. +

+

The gen_statem enqueues postponed events and + not yet processed events in order of arrival, except for + an event that a callback function inserts with + {insert_event,EventType,EventContent} that is inserted + as the next event to process. +

+

When the state machine changes states all enqueued events + becomes not yet processed to be processed before the old + not yet processed events. In other words; the order of arrival + is retained. +

+

The processing order is:

+ + If the option retry is true + the current event is enqueued as postponed to be retried. + + If the state changes all postponed events + are transferred to not yet processed to be processed + before other not yet processed events. + + All operations are processed in order of appearance. + + The timeout option is processed if present. + So a state timer may be started or a timeout zero event + may be inserted as if just received. + + The (possibly new) + state function + is called with the next not yet processed event + if there is any, otherwise the gen_statem goes into receive + or hibernation (if the option hibernate is true) + to wait for the next message. In hibernation the next + non-system event awakens the gen_statem. + + + + + + + + + retry + {retry,Retry} + If Retry =:= true + or plain retry postpone the current event + to be retried after a state change. + + hibernate + {hibernate,Hibernate} + If Hibernate =:= true + or plain hibernate hibernate the gen_statem by calling + + proc_lib:hibernate/3 + before receive to wait for a new event. + If there are not yet processed events the + hibernate operation is ignored as if an event + just arrived and awakened the gen_statem. + + + {timeout,Time,Msg} + + Generate an event of + type timeout + after Time milliseconds unless some other + event is received before that time. Note that a retried + event counts just like a new in this respect. + If Time =:= infinity or Time =:= 0 + no timer is started but for zero time the timeout + event is enqued as just received after all + other already received events. + Also note that it is not possible + to cancel this timeout using the + + state_operation() + cancel_timer. + This timeout is cancelled automatically by any event. + + + + + + + + + + {reply,Client,Reply} + + Reply to a client that called + call/2. + Client must be the term from the + + {call,Client} + argument to the + state function. + + {stop,Reason} + The gen_statem will call + + Module:terminate/3 + with Reason and terminate. + + + + {insert_event,EventType,EventContent} + + + Insert the given event as the next to process + before any other not yet processed events. + An event of type + + internal + should be used when you want to reliably distinguish + an event inserted this way from any external event. + + + + {remove_event,EventType,EventContent} + + + Remove the oldest queued event + that matches equal to the given event. + + + + {remove_event,EventPredicate} + + + Remove the oldest queued event for which + the EventPredicate returns true. + + {cancel_timer,TimerRef} + Uses TimerRef when calling + + erlang:cancel_timer/2 + to cancel a timer, cleans the gen_statem's + message queue from any late timeout message from + the timer, and removes any late timeout message + from the queued events using + {remove_event,EventPredicate} above. + This is a convenience function that saves quite some + lines of code and testing time over doing it from + the primitives mentioned above. + + {demonitor,MonitorRef} + Like {cancel_timer,_} above but for + + demonitor/2 + . + + {unlink,Id} + Like {cancel_timer,_} above but for + + unlink/1 + . + + + + + + + + + + + + Create a linked gen_statem process + +

Creates a gen_statem process according to OTP design principles + (using + proc_lib + primitives) + that is linked to the calling process. + This is essential when the gen_statem shall be part of + a supervision tree so it gets linked to its supervisor. +

+

The gen_statem process calls + Module:init/1 + to initialize the server. To ensure a synchronized start-up + procedure, start_link/3,4 does not return until + Module:init/1 + has returned. +

+

ServerName specifies the + + server_name() + to register for the gen_statem. + If the gen_statem is started with start_link/3 + no ServerName is provided and + the gen_statem is not registered. +

+

Module is the name of the callback module.

+

Args is an arbitrary term which is passed as + the argument to + Module:init/1 + . +

+

If the option {timeout,Time} is present in + Options, the gen_statem is allowed to spend + Time milliseconds initializing or it will be + terminated and the start function will return + + {error,timeout} + . +

+

If the option + {debug,Dbgs} + is present in Options, debugging through + sys is activated. +

+

If the option {spawn_opt,SOpts} is present in + Options, SOpts will be passed + as option list to the spawn_opt BIF + which is used to + spawn + the gen_statem. +

+ +

Using the spawn option monitor is currently not + allowed, but will cause this function to fail with reason + badarg.

+ +

If the gen_statem is successfully created and initialized + this function returns + + {ok,Pid}, + where Pid is the pid() of the gen_statem. + If there already exists a process with the specified + ServerName this function returns + + {error,{already_started,Pid}} + , where Pid is the pid() of that process. +

+

If Module:init/1 fails with Reason, + this function returns + + {error,Reason} + . If Module:init/1 returns + + {stop,Reason} + + or + + ignore + , the process is terminated and this function + returns + + {error,Reason} + or + + ignore + , respectively. +

+ + + + + + + + Create a stand-alone gen_statem process + +

Creates a stand-alone gen_statem process according to + OTP design principles (using + proc_lib + primitives). + Since it does not get linked to the calling process + this start function can not be used by a supervisor + to start a child. +

+

See start_link/3,4 + for a description of arguments and return values. +

+ + + + + + Synchronously stop a generic server + +

The same as + + stop(ServerRef, normal, infinity) + . +

+ + + + + Synchronously stop a generic server + +

Orders the gen_statem + + ServerRef + to exit with the given Reason + and waits for it to terminate. + The gen_statem will call + + Module:terminate/3 + before exiting. +

+

This function returns ok if the server terminates + with the expected reason. Any other reason than normal, + shutdown, or {shutdown,Term} will cause an + error report to be issued through + + error_logger:format/2 + . + The default Reason is normal. +

+

Timeout is an integer greater than zero + which specifies how many milliseconds to wait for the server to + terminate, or the atom infinity to wait indefinitely. + The default value is infinity. + If the server has not terminated within the specified time, + a timeout exception is raised. +

+

If the process does not exist, a noproc exception + is raised. +

+ + + + + + + Make a synchronous call to a gen_statem + +

Makes a synchronous call to the gen_statem + + ServerRef + by sending a request + and waiting until its reply arrives. + The gen_statem will call the + state function with + event_type() + {call,Client} and event content + Request. +

+

A Reply is generated when a + state function + returns with + {reply,Client,Reply} as one + state_op(), + and that Reply becomes the return value + of this function. +

+

Timeout is an integer greater than zero + which specifies how many milliseconds to wait for a reply, + or the atom infinity to wait indefinitely, + which is the default. If no reply is received within + the specified time, the function call fails. + +

To avoid getting a late reply in the caller's + inbox this function spawns a proxy process that + does the call. A late reply gets delivered to the + dead proxy process hence gets discarded. This is + less efficient than using + Timeout =:= infinity. +

+ +

+

The call may fail for example if the gen_statem dies + before or during this function call. +

+ + + + + + Send an asynchronous event to a gen_statem + +

Sends an asynchronous event to the gen_statem + + ServerRef + and returns ok immediately, + ignoring if the destination node or gen_statem does not exist. + The gen_statem will call the + state function with + event_type() + cast and event content + Msg. +

+ + + + + + Send a reply to a client + +

This function can be used by a gen_statem to explicitly send + a reply to a client that called + call/2 + when the reply cannot be defined in + the return value of the + state function. +

+

Client must be the term from the + + {call,Client} + argument to the + state function. +

+ +

A reply sent with this function will not be visible + in sys debug output. +

+ + + + + + + Enter the gen_statem receive loop + +

The same as + enter_loop/6 + except that no + + server_name() + must have been registered. +

+ + + + + Enter the gen_statem receive loop + +

If Server_or_StateOps is a list() + the same as + enter_loop/6 + except that no + + server_name() + must have been registered and + StateOps = Server_or_StateOps. +

+

Otherwise the same as + enter_loop/6 + with + Server = Server_or_StateOps and + StateOps = []. +

+ + + + + Enter the gen_statem receive loop + +

Makes an the calling process become a gen_statem. Does not return, + instead the calling process will enter the gen_statem receive + loop and become a gen_statem server. The process + must have been started using one of the start + functions in + proc_lib. + The user is responsible for any initialization of the process, + including registering a name for it. +

+

This function is useful when a more complex initialization + procedure is needed than the gen_statem behaviour provides. +

+

Module, Options and + Server have the same meanings + as when calling + gen_statem:start[_link]/3,4. + However, the + + server_name() + name must have been registered accordingly + before this function is called.

+

State and StateData + have the same meanings as in the return value of + Module:init/1. + Also, the callback module Module + does not need to export an init/1 function. +

+

Failure: If the calling process was not started by a + proc_lib + start function, or if it is not registered + according to + + server_name() + . +

+ + + + + + + +
+ CALLBACK FUNCTIONS +

The following functions should be exported from a + gen_statem callback module. +

+
+ + + + Module:init(Args) -> Result + Initialize process and internal state + + Args = term() + Result = {ok,State,StateData} +  | {ok,State,StateData,StateOps} +  | {stop,Reason} | ignore + State = state() + StateData = state_data() + StateOps = [state_op()] + Reason = term() + + + +

Whenever a gen_statem is started using + gen_statem:start_link/3,4 + or + gen_statem:start/3,4, + this function is called by the new process to initialize + the implementation loop data. +

+

Args is the Args argument provided to the start + function.

+

If the initialization is successful, the function should + return {ok,State,StateData} or + {ok,State,StateData,StateOps}. + State is the state + of the gen_statem. +

+

The StateOps + are executed before entering the first + state just as for a + state function. +

+

If something goes wrong during the initialization + the function should return {stop,Reason} + or ignore. See + gen_statem:start_link/3,4. +

+ + + + + Module:handle_event(EventType, EventContent, + PrevState, State, StateData) -> Result + + Module:State(EventType, EventContent, + PrevState, State, StateData) -> Result + + Handle an event + + EventType = + event_type() + + EventContent = term() + Result = {NewState,NewStateData,StateOps} +   | {NewState,NewStateData} +   The same as {NewState,NewStateData,[]} +   | {NewStateData} +   The same as {State,NewStateData,[retry]} +   | {} +   The same as {State,StateData,[]} +   | StateOps +   The same as {State,StateData,StateOps} + + PrevState = State = NewState = + state() + + StateData = NewStateData = + state_data() + + StateOps = + [state_op()] + + + +

Whenever a gen_statem receives an event from + gen_statem:call/2, + gen_statem:cast/2 or + as a normal process message this function is called. + If the EventType is + {call,Client} + the client is waiting for a reply. The reply can be sent + from this or from any other + state function + by returning with {reply,Client,Reply} in + StateOps + or by calling + + gen_statem:reply(Client, Reply) + . +

+

State + is the internal state of the gen_statem which + when State is an atom() + is the same as this function's name, so it is seldom useful, + except for example when comparing with PrevState + that is the gen_statem's previous state, or in + + Module:handle_event/5 + since that function is common for all states + that are not an atom(). +

+

If this function returns with + NewState =/= State + all postponed events will be retried in the new state. +

+

See state_op() + for the operations that can be done by gen_statem + after returning from this function. +

+ + + + + Module:terminate(Reason, State, StateData) + Clean up before termination + + Reason = normal | shutdown | {shutdown,term()} | term() + State = state() + StateData = + + state_data() + + + + +

This function is called by a gen_statem when it is about to + terminate. It should be the opposite of + Module:init/1 + and do any necessary cleaning up. When it returns, + the gen_statem terminates with Reason. The return + value is ignored.

+

Reason is a term denoting the stop reason and + State + is the internal state of the gen_statem. +

+

Reason depends on why the gen_statem is terminating. + If it is because another callback function has returned a + stop tuple {stop,Reason} in + StateOps, + Reason will have the value specified in that tuple. + If it is due to a failure, Reason is the error reason. +

+

If the gen_statem is part of a supervision tree and is + ordered by its supervisor to terminate, this function will be + called with Reason = shutdown if the following + conditions apply:

+ + the gen_statem has been set to trap exit signals, and + the shutdown strategy as defined in the supervisor's + child specification is an integer timeout value, not + brutal_kill. + + +

Even if the gen_statem is not part of a supervision tree, + this function will be called if it receives an 'EXIT' + message from its parent. Reason will be the same as in + the 'EXIT' message. +

+

Otherwise, the gen_statem will be immediately terminated. +

+

Note that for any other reason than normal, + shutdown, or {shutdown,Term} the gen_statem is + assumed to terminate due to an error and + an error report is issued using + + error_logger:format/2 + . +

+ + + + + Module:code_change(OldVsn, OldState, OldStateData, Extra) -> + Result + + Update the internal state during upgrade/downgrade + + OldVsn = Vsn | {down,Vsn} +   Vsn = term() + OldState = NewState = term() + Extra = term() + Result = {ok,{NewState,NewStateData}} | Reason + OldState = NewState = + state() + + OldStateData = NewStateData = + state_data() + + Reason = term() + + +

This function is called by a gen_statem when it should + update its internal state during a release upgrade/downgrade, + i.e. when the instruction {update,Module,Change,...} + where Change={advanced,Extra} is given in + the appup file. See + + OTP Design Principles + + for more information. +

+

In the case of an upgrade, OldVsn is Vsn, and + in the case of a downgrade, OldVsn is + {down,Vsn}. Vsn is defined by the vsn + attribute(s) of the old version of the callback module + Module. If no such attribute is defined, the version + is the checksum of the BEAM file. +

+

OldState and OldStateData is the internal state + of the gen_statem. +

+

Extra is passed as-is from the {advanced,Extra} + part of the update instruction. +

+

If successful, the function shall return the updated + internal state in an + {ok,{NewState,NewStateData}} tuple. +

+

If the function returns Reason, the ongoing + upgrade will fail and roll back to the old release.

+ + + + + Module:format_status(Opt, [PDict,State,StateData]) -> + Status + + Optional function for providing a term describing the + current gen_statem status + + Opt = normal | terminate + PDict = [{Key, Value}] + State = + state() + + StateData = + state_data() + + Key = term() + Value = term() + Status = term() + + + +

This callback is optional, so callback modules need not + export it. The gen_statem module provides a default + implementation of this function that returns the callback + module state. +

+ +

This function is called by a gen_statem process when:

+ + One of + + sys:get_status/1,2 + + is invoked to get the gen_statem status. Opt is set + to the atom normal for this case. + + The gen_statem terminates abnormally and logs an error. + Opt is set to the atom terminate for this case. + + +

This function is useful for customising the form and + appearance of the gen_statem status for these cases. A + callback module wishing to customise the + + sys:get_status/1,2 + return value as well as how + its status appears in termination error logs exports an + instance of format_status/2 that returns a term + describing the current status of the gen_statem. +

+

PDict is the current value of the gen_statem's + process dictionary. +

+

State + is the internal state of the gen_statem. +

+

The function should return Status, a term that + customises the details of the current state and status of + the gen_statem. There are no restrictions on the + form Status can take, but for the + + sys:get_status/1,2 + case (when Opt + is normal), the recommended form for + the Status value is [{data, [{"State", + Term}]}] where Term provides relevant details of + the gen_statem state. Following this recommendation isn't + required, but doing so will make the callback module status + consistent with the rest of the + + sys:get_status/1,2 + return value. +

+

One use for this function is to return compact alternative + state representations to avoid having large state terms + printed in logfiles. +

+ + + + + +
+ SEE ALSO +

gen_event, + gen_fsm, + gen_server, + supervisor, + proc_lib, + sys

+
+ diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml index 82ad78e675..404873ea32 100644 --- a/lib/stdlib/doc/src/ref_man.xml +++ b/lib/stdlib/doc/src/ref_man.xml @@ -4,7 +4,7 @@
- 19962015 + 19962016 Ericsson AB. All Rights Reserved. @@ -66,6 +66,7 @@ + diff --git a/lib/stdlib/doc/src/specs.xml b/lib/stdlib/doc/src/specs.xml index 0418bf7b22..45b207b13d 100644 --- a/lib/stdlib/doc/src/specs.xml +++ b/lib/stdlib/doc/src/specs.xml @@ -30,6 +30,7 @@ + diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 9f4a446ea0..302834f9d0 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2015. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -85,6 +85,7 @@ MODULES= \ gen_event \ gen_fsm \ gen_server \ + gen_statem \ io \ io_lib \ io_lib_format \ diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl new file mode 100644 index 0000000000..9bb5ed013b --- /dev/null +++ b/lib/stdlib/src/gen_statem.erl @@ -0,0 +1,1095 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(gen_statem). + +%% API +-export( + [start/3,start/4,start_link/3,start_link/4, + stop/1,stop/3, + cast/2,call/2,call/3, + enter_loop/4,enter_loop/5,enter_loop/6, + reply/2]). + +%% gen callbacks +-export( + [init_it/6]). + +%% sys callbacks +-export( + [system_continue/3, + system_terminate/4, + system_code_change/4, + system_get_state/1, + system_replace_state/2, + format_status/2]). + +%% Internal callbacks +-export( + [wakeup_from_hibernate/3]). + +%%%========================================================================== +%%% Interface functions. +%%%========================================================================== + +-type client() :: + {To :: pid(), Tag :: term()}. % Reply-to specifier for call +-type state() :: + atom() | % Calls state callback function State/5 + term(). % Calls state callback function handle_event/5 +-type state_data() :: term(). +-type event_type() :: + {'call',Client :: client()} | 'cast' | + 'info' | 'timeout' | 'internal'. +-type event_predicate() :: % Return true for the event in question + fun((event_type(), term()) -> boolean()). +-type state_op() :: + %% First NewState and NewStateData are set, + %% then all state_operations() are executed in order of + %% apperance. Postponing the current event is performed + %% (iff state_option() 'retry' is 'true'). + %% Lastly pending events are processed or if there are + %% no pending events the server goes into receive + %% or hibernate (iff state_option() 'hibernate' is 'true') + state_option() | state_operation(). +-type state_option() :: + %% The first of each kind in the state_op() list takes precedence + 'retry' | % Postpone the current event to a different (=/=) state + {'retry', Retry :: boolean()} | + 'hibernate' | % Hibernate the server instead of going into receive + {'hibernate', Hibernate :: boolean()} | + {'timeout', % Generate a ('timeout', Msg, ...) event after Time + Time :: timeout(), Msg :: term()}. +-type state_operation() :: + %% These can occur multiple times and are executed in order + %% of appearence in the state_op() list + {'reply', % Reply to a client + Client :: client(), Reply :: term()} | + {'stop', Reason :: term()} | % Stop the server + {'insert_event', % Insert event as the next to handle + EventType :: event_type(), + EventContent :: term()} | + {'remove_event', % Remove the oldest matching (=:=) event + EventType :: event_type(), EventContent :: term()} | + {'remove_event', % Remove the oldest event satisfying predicate + EventPredicate :: event_predicate()} | + {'cancel_timer', % Cancel timer and clean up mess(ages) + TimerRef :: reference()} | + {'demonitor', % Demonitor and clean up mess(ages) + MonitorRef :: reference()} | + {'unlink', % Unlink and clean up mess(ages) + Id :: pid() | port()}. + +%% The state machine init function. It is called only once and +%% the server is not running until this function has returned +%% an {ok, ...} tuple. Thereafter the state callbacks are called +%% for all events to this server. +-callback init(Args :: term()) -> + {'ok', state(), state_data()} | + {'ok', state(), state_data(), [state_op()]} | + 'ignore' | + {'stop', Reason :: term()}. + +%% An example callback for a fictive state 'handle_event' +%% that you should avoid having. See below. +%% +%% Note that state callbacks and only state callbacks have arity 5 +%% and that is intended. +%% +%% You should not actually use 'handle_event' as a state name, +%% since it is the callback function that is used if you would use +%% a State that is not an atom(). This is because since there is +%% no obvious way to decide on a state function name from any term(). +-callback handle_event( + event_type(), + EventContent :: term(), + PrevState :: state(), + State :: state(), % Current state + StateData :: state_data()) -> + [state_op()] | % {State,StateData,[state_op()]} + {} | % {State,StateData,[]} + {NewStateData :: state_data()} | % {State,NewStateData,[retry]} + {NewState :: state(), + NewStateData :: state_data()} | % {NewState,NewStateData,[]} + {NewState :: state(), NewStateData :: state_data(), [state_op()]}. + +%% Clean up before the server terminates. +-callback terminate( + Reason :: 'normal' | 'shutdown' | {'shutdown', term()} + | term(), + State :: state(), + StateData :: state_data()) -> + any(). + +%% Note that the new code can expect to get an OldState from +%% the old code version not only in code_change/4 but in the first +%% state callback function called thereafter +-callback code_change( + OldVsn :: term() | {'down', term()}, + OldState :: state(), + OldStateData :: state_data(), + Extra :: term()) -> + {ok, {NewState :: state(), NewStateData :: state_data()}}. + +%% Format the callback module state in some sensible that is +%% often condensed way. For StatusOption =:= 'normal' the perferred +%% return term is [{data,[{"State",FormattedState}]}], and for +%% StatusOption =:= 'terminate' it is just FormattedState. +-callback format_status( + StatusOption, + [ [{Key :: term(), Value :: term()}] | + state() | + state_data()]) -> + Status :: term() when + StatusOption :: 'normal' | 'terminate'. + +-optional_callbacks( + [format_status/2, % Has got a default implementation + handle_event/5]). % Only needed for State not an atom() +%% For every atom() State there has to be a State/5 callback function + +%% Type validation functions +client({Pid,Tag}) when is_pid(Pid), is_reference(Tag) -> + true; +client(_) -> + false. +%% +event_type({call,Client}) -> + client(Client); +event_type(Type) -> + case Type of + cast -> + true; + info -> + true; + timeout -> + true; + internal -> + true; + _ -> + false + end. + +%%%========================================================================== +%%% API + +-type server_name() :: + {'global', GlobalName :: term()} + | {'via', RegMod :: module(), Name :: term()} + | {'local', atom()}. +-type server_ref() :: + {'global', GlobalName :: term()} + | {'via', RegMod :: module(), ViaName :: term()} + | (LocalName :: atom()) + | {Name :: atom(), Node :: atom()} + | pid(). +-type debug_opt() :: + {'debug', + Dbgs :: + ['trace' | 'log' | 'statistics' | 'debug' + | {'logfile', string()}]}. +-type start_opt() :: + debug_opt() + | {'timeout', Time :: timeout()} + | {'spawn_opt', SOpts :: [proc_lib:spawn_option()]}. +-type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}. + + + +%% Start a state machine +-spec start( + Module :: module(), Args :: term(), Options :: [start_opt()]) -> + start_ret(). +start(Module, Args, Options) -> + gen:start(?MODULE, nolink, Module, Args, Options). +%% +-spec start( + ServerName :: server_name(), + Module :: module(), Args :: term(), Options :: [start_opt()]) -> + start_ret(). +start(ServerName, Module, Args, Options) -> + gen:start(?MODULE, nolink, ServerName, Module, Args, Options). + +%% Start and link to a state machine +-spec start_link( + Module :: module(), Args :: term(), Options :: [start_opt()]) -> + start_ret(). +start_link(Module, Args, Options) -> + gen:start(?MODULE, link, Module, Args, Options). +%% +-spec start_link( + ServerName :: server_name(), + Module :: module(), Args :: term(), Options :: [start_opt()]) -> + start_ret(). +start_link(ServerName, Module, Args, Options) -> + gen:start(?MODULE, link, ServerName, Module, Args, Options). + +%% Stop a state machine +-spec stop(ServerRef :: server_ref()) -> ok. +stop(ServerRef) -> + gen:stop(ServerRef). +%% +-spec stop( + ServerRef :: server_ref(), + Reason :: term(), + Timeout :: timeout()) -> ok. +stop(ServerRef, Reason, Timeout) -> + gen:stop(ServerRef, Reason, Timeout). + +%% Send an event to a state machine that arrives with type 'event' +-spec cast(ServerRef :: server_ref(), Msg :: term()) -> ok. +cast({global,Name}, Msg) -> + try global:send(Name, cast(Msg)) of + _ -> ok + catch + _:_ -> ok + end; +cast({via,RegMod,Name}, Msg) -> + try RegMod:send(Name, cast(Msg)) of + _ -> ok + catch + _:_ -> ok + end; +cast({Name,Node} = ServerRef, Msg) when is_atom(Name), is_atom(Node) -> + do_send(ServerRef, cast(Msg)); +cast(ServerRef, Msg) when is_atom(ServerRef) -> + do_send(ServerRef, cast(Msg)); +cast(ServerRef, Msg) when is_pid(ServerRef) -> + do_send(ServerRef, cast(Msg)). + +%% Call a state machine (synchronous; a reply is expected) that +%% arrives with type {call,Client} +-spec call(ServerRef :: server_ref(), Request :: term()) -> Reply :: term(). +call(ServerRef, Request) -> + call(ServerRef, Request, infinity). +%% +-spec call( + ServerRef :: server_ref(), + Request :: term(), + Timeout :: timeout()) -> + Reply :: term(). +call(ServerRef, Request, infinity) -> + try gen:call(ServerRef, '$gen_call', Request, infinity) of + {ok,Reply} -> + Reply + catch + Class:Reason -> + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,infinity]}}, + erlang:get_stacktrace()) + end; +call(ServerRef, Request, Timeout) -> + %% Call server through proxy process to dodge any late reply + Ref = make_ref(), + Self = self(), + Pid = spawn( + fun () -> + Self ! + try gen:call( + ServerRef, '$gen_call', Request, Timeout) of + Result -> + {Ref,Result} + catch Class:Reason -> + {Ref,Class,Reason,erlang:get_stacktrace()} + end + end), + Mref = monitor(process, Pid), + receive + {Ref,Result} -> + demonitor(Mref, [flush]), + case Result of + {ok,Reply} -> + Reply + end; + {Ref,Class,Reason,Stacktrace} -> + demonitor(Mref, [flush]), + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, + Stacktrace); + {'DOWN',Mref,_,_,Reason} -> + %% There is just a theoretical possibility that the + %% proxy process gets killed between try--of and ! + %% so this clause is in case of that + exit(Reason) + end. + +%% Reply from a state machine callback to whom awaits in call/2 +-spec reply(Client :: client(), Reply :: term()) -> ok. +reply({To,Tag}, Reply) -> + Msg = {Tag,Reply}, + try To ! Msg of + _ -> + ok + catch + _:_ -> ok + end. + +%% Instead of starting the state machine through start/3,4 +%% or start_link/3,4 turn the current process presumably +%% started by proc_lib into a state machine using +%% the same arguments as you would have returned from init/1 +-spec enter_loop( + Module :: module(), Options :: [debug_opt()], + State :: state(), StateData :: state_data()) -> + no_return(). +enter_loop(Module, Options, State, StateData) -> + enter_loop(Module, Options, State, StateData, self()). +%% +-spec enter_loop( + Module :: module(), Options :: [debug_opt()], + State :: state(), StateData :: state_data(), + Server_or_StateOps :: server_name() | pid() | [state_op()]) -> + no_return(). +enter_loop(Module, Options, State, StateData, Server_or_StateOps) -> + if + is_list(Server_or_StateOps) -> + enter_loop( + Module, Options, State, StateData, + self(), Server_or_StateOps); + true -> + enter_loop( + Module, Options, State, StateData, + Server_or_StateOps, []) + end. +%% +-spec enter_loop( + Module :: module(), Options :: [debug_opt()], + State :: state(), StateData :: state_data(), + Server :: server_name() | pid(), + StateOps :: [state_op()]) -> + no_return(). +enter_loop(Module, Options, State, StateData, Server, StateOps) -> + Parent = gen:get_parent(), + enter(Module, Options, State, StateData, Server, StateOps, Parent). + +%%--------------------------------------------------------------------------- +%% API helpers + +cast(Event) -> + {'$gen_cast',Event}. + +%% Might actually not send the message in case of caught exception +do_send(Proc, Msg) -> + try erlang:send(Proc, Msg, [noconnect]) of + noconnect -> + _ = spawn(erlang, send, [Proc,Msg]), + ok; + ok -> + ok + catch + _:_ -> + ok + end. + +%% Here init_it and all enter_loop functions converge +enter(Module, Options, State, StateData, Server, StateOps, Parent) -> + Name = gen:get_proc_name(Server), + Debug = gen:debug_options(Name, Options), + PrevState = make_ref(), + S = #{ + module => Module, + name => Name, + prev_state => PrevState, + state => PrevState, + state_data => StateData, + timer => undefined, + postponed => [], + hibernate => false}, + loop_event_state_ops( + Parent, Debug, S, [], {event,undefined}, + State, StateData, [{retry,false}|StateOps]). + +%%%========================================================================== +%%% gen callbacks + +init_it(Starter, Parent, ServerRef, Module, Args, Options) -> + try Module:init(Args) of + Result -> + init_result(Starter, Parent, ServerRef, Module, Result, Options) + catch + Result -> + init_result(Starter, Parent, ServerRef, Module, Result, Options); + Class:Reason -> + gen:unregister_name(ServerRef), + proc_lib:init_ack(Starter, {error,Reason}), + erlang:raise(Class, Reason, erlang:get_stacktrace()) + end. + +%%--------------------------------------------------------------------------- +%% gen callbacks helpers + +init_result(Starter, Parent, ServerRef, Module, Result, Options) -> + case Result of + {ok,State,StateData} -> + proc_lib:init_ack(Starter, {ok,self()}), + enter( + Module, Options, State, StateData, ServerRef, + [], Parent); + {ok,State,StateData,StateOps} -> + proc_lib:init_ack(Starter, {ok,self()}), + enter( + Module, Options, State, StateData, ServerRef, + StateOps, Parent); + {stop,Reason} -> + gen:unregister_name(ServerRef), + proc_lib:init_ack(Starter, {error,Reason}), + exit(Reason); + ignore -> + gen:unregister_name(ServerRef), + proc_lib:init_ack(Starter, ignore), + exit(normal); + Other -> + Error = {bad_return_value,Other}, + proc_lib:init_ack(Starter, {error,Error}), + exit(Error) + end. + +%%%========================================================================== +%%% sys callbacks + +system_continue(Parent, Debug, S) -> + loop(Parent, Debug, S). + +system_terminate(Reason, _Parent, Debug, S) -> + terminate(Reason, Debug, S, []). + +system_code_change( + #{module := Module, + state := State, + state_data := StateData} = S, + _Mod, OldVsn, Extra) -> + case + try Module:code_change(OldVsn, State, StateData, Extra) + catch + Result -> Result + end + of + {ok,{NewState,NewStateData}} -> + {ok, + S#{ + state := NewState, + state_data := NewStateData}}; + Error -> + Error + end. + +system_get_state(#{state := State, state_data := StateData}) -> + {ok,{State,StateData}}. + +system_replace_state( + StateFun, + #{state := State, + state_data := StateData} = S) -> + {NewState,NewStateData} = Result = StateFun({State,StateData}), + {ok,Result,S#{state := NewState, state_data := NewStateData}}. + +format_status( + Opt, + [PDict,SysState,Parent,Debug, + #{name := Name, postponed := P} = S]) -> + Header = gen:format_status_header("Status for state machine", Name), + Log = sys:get_debug(log, Debug, []), + [{header,Header}, + {data, + [{"Status",SysState}, + {"Parent",Parent}, + {"Logged Events",Log}, + {"Postponed",P}]} | + case format_status(Opt, PDict, S) of + L when is_list(L) -> L; + T -> [T] + end]. + +%%--------------------------------------------------------------------------- +%% Format debug messages. Print them as the call-back module sees +%% them, not as the real erlang messages. Use trace for that. +%%--------------------------------------------------------------------------- + +print_event(Dev, {in,Event}, #{name := Name}) -> + io:format( + Dev, "*DBG* ~p received ~s~n", + [Name,event_string(Event)]); +print_event(Dev, {out,Reply,{To,_Tag}}, #{name := Name}) -> + io:format( + Dev, "*DBG* ~p sent ~p to ~p~n", + [Name,Reply,To]); +print_event(Dev, {Tag,Event,NewState}, #{name := Name, state := State}) -> + StateString = + case NewState of + State -> + io_lib:format("~p", [State]); + _ -> + io_lib:format("~p => ~p", [State,NewState]) + end, + io:format( + Dev, "*DBG* ~p ~w ~s in state ~s~n", + [Name,Tag,event_string(Event),StateString]). + +event_string(Event) -> + case Event of + {{call,{Pid,_Tag}},Request} -> + io_lib:format("call ~p from ~w", [Request,Pid]); + {Tag,Content} -> + io_lib:format("~w ~p", [Tag,Content]) + end. + +sys_debug(Debug, S, Entry) -> + case Debug of + [] -> + Debug; + _ -> + sys:handle_debug(Debug, fun print_event/3, S, Entry) + end. + +%%%========================================================================== +%%% Internal callbacks + +wakeup_from_hibernate(Parent, Debug, S) -> + %% It is a new message that woke us up so we have to receive it now + loop_receive(Parent, Debug, S). + +%%%========================================================================== +%%% STate Machine engine implementation of proc_lib/gen server + +%% Server loop, consists of all loop* functions +%% and some detours through sys and proc_lib + +%% Entry point for system_continue/3 +loop(Parent, Debug, #{hibernate := Hib} = S) -> + case Hib of + true -> + loop_hibernate(Parent, Debug, S); + false -> + loop_receive(Parent, Debug, S) + end. + +loop_hibernate(Parent, Debug, S) -> + %% Does not return but restarts process at + %% wakeup_from_hibernate/3 that jumps to loop_receive/3 + proc_lib:hibernate( + ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]), + error( + {should_not_have_arrived_here_but_instead_in, + {wakeup_from_hibernate,3}}). + +%% Entry point for wakeup_from_hibernate/3 +loop_receive(Parent, Debug, #{timer := Timer} = S) -> + receive + Msg -> + case Msg of + {system,Pid,Req} -> + %% Does not return but tail recursively calls + %% system_continue/3 that jumps to loop/3 + sys:handle_system_msg( + Req, Pid, Parent, ?MODULE, Debug, S, + maps:get(hibernate, S)); + {'EXIT',Parent,Reason} = EXIT -> + %% EXIT is not a 2-tuple and therefore + %% not an event and has no event_type(), + %% but this will stand out in the crash report... + terminate(Reason, Debug, S, [EXIT]); + {timeout,Timer,Content} when Timer =/= undefined -> + loop_receive( + Parent, Debug, S, {timeout,Content}, undefined); + _ -> + Event = + case Msg of + {'$gen_call',Client,Request} -> + {{call,Client},Request}; + {'$gen_cast',E} -> + {cast,E}; + _ -> + {info,Msg} + end, + loop_receive(Parent, Debug, S, Event, Timer) + end + end. + +loop_receive(Parent, Debug, S, Event, Timer) -> + NewDebug = sys_debug(Debug, S, {in,Event}), + %% Here the queue of not yet processed events is created + loop_events(Parent, NewDebug, S, [Event], Timer). + +%% Process first event in queue, or if there is none receive a new +%% +%% The loop_event* functions optimize S map handling by dismantling it, +%% passing the parts in arguments to avoid map lookups and construct the +%% new S map in one go on exit. Premature optimization, I know, but +%% the code was way to readable and there were quite some map lookups +%% repeated in different functions. +loop_events(Parent, Debug, S, [], _Timer) -> + loop(Parent, Debug, S); +loop_events( + Parent, Debug, + #{module := Module, + prev_state := PrevState, + state := State, + state_data := StateData} = S, + [{Type,Content} = Event|Events] = Q, Timer) -> + _ = (Timer =/= undefined) andalso + cancel_timer(Timer), + Func = + if + is_atom(State) -> + State; + true -> + handle_event + end, + try Module:Func(Type, Content, PrevState, State, StateData) of + Result -> + loop_event_result( + Parent, Debug, S, Events, Event, Result) + catch + Result -> + loop_event_result( + Parent, Debug, S, Events, Event, Result); + error:undef -> + %% Process an undef to check for the simple mistake + %% of calling a nonexistent state function + case erlang:get_stacktrace() of + [{Module,State,[Event,StateData]=Args,_}|Stacktrace] -> + terminate( + error, + {undef_state_function,{Module,State,Args}}, + Stacktrace, + Debug, S, Q); + Stacktrace -> + terminate(error, undef, Stacktrace, Debug, S, Q) + end; + Class:Reason -> + Stacktrace = erlang:get_stacktrace(), + terminate(Class, Reason, Stacktrace, Debug, S, Q) + end. + +%% Interprete all callback return value variants +loop_event_result( + Parent, Debug, + #{state := State, state_data := StateData} = S, + Events, Event, Result) -> + case Result of + {} -> % Ignore + loop_event_state_ops( + Parent, Debug, S, Events, Event, + State, StateData, []); + {NewStateData} -> % Retry + loop_event_state_ops( + Parent, Debug, S, Events, Event, + State, NewStateData, [retry]); + {NewState,NewStateData} -> % Consume + loop_event_state_ops( + Parent, Debug, S, Events, Event, + NewState, NewStateData, []); + {NewState,NewStateData,StateOps} when is_list(StateOps) -> + loop_event_state_ops( + Parent, Debug, S, Events, Event, + NewState, NewStateData, StateOps); + StateOps when is_list(StateOps) -> % Stay in state + loop_event_state_ops( + Parent, Debug, S, Events, Event, + State, StateData, StateOps); + BadReturn -> + terminate( + {bad_return_value,BadReturn}, Debug, S, [Event|Events]) + end. + +loop_event_state_ops( + Parent, Debug0, #{state := State, postponed := P0} = S, Events, Event, + NewState, NewStateData, StateOps) -> + case collect_state_options(StateOps) of + {Retry,Hibernate,Timeout,Operations} -> + P1 = % Move current event to postponed if Retry + case Retry of + true -> + [Event|P0]; + false -> + P0 + end, + {Q2,P2} = % Move all postponed events to queue if state change + if + NewState =:= State -> + {Events,P1}; + true -> + {lists:reverse(P1, Events),[]} + end, + %% + case process_state_operations( + Operations, Debug0, S, Q2, P2) of + {Debug,Q3,P} -> + NewDebug = + sys_debug( + Debug, S, + case Retry of + true -> + {retry,Event,NewState}; + false -> + {consume,Event,NewState} + end), + {Timer,Q} = + case Timeout of + undefined -> + {undefined,Q3}; + {timeout,0,Msg} -> + %% Pretend the timeout has just been received + {undefined,Q3 ++ [{timeout,Msg}]}; + {timeout,Time,Msg} -> + {erlang:start_timer(Time, self(), Msg),Q3} + end, + loop_events( + Parent, NewDebug, + S#{ + prev_state := State, + state := NewState, + state_data := NewStateData, + timer := Timer, + hibernate := Hibernate, + postponed := P}, + Q, Timer); + [Reason,Debug] -> + terminate(Reason, Debug, S, [Event|Events]); + [Class,Reason,Stacktrace,Debug] -> + terminate( + Class, Reason, Stacktrace, Debug, S, [Event|Events]) + end; + %% + [Reason] -> + terminate(Reason, Debug0, S, [Event|Events]) + end. + +%%--------------------------------------------------------------------------- +%% Server helpers + +collect_state_options(StateOps) -> + collect_state_options( + lists:reverse(StateOps), false, false, undefined, []). +%% Keep the last of each kind +collect_state_options( + [], Retry, Hibernate, Timeout, Operations) -> + {Retry,Hibernate,Timeout,Operations}; +collect_state_options( + [StateOp|StateOps] = SOSOs, Retry, Hibernate, Timeout, Operations) -> + case StateOp of + retry -> + collect_state_options( + StateOps, true, Hibernate, Timeout, Operations); + {retry,NewRetry} when is_boolean(NewRetry) -> + collect_state_options( + StateOps, NewRetry, Hibernate, Timeout, Operations); + {retry,_} -> + [{bad_state_ops,SOSOs}]; + hibernate -> + collect_state_options( + StateOps, Retry, true, Timeout, Operations); + {hibernate,NewHibernate} when is_boolean(NewHibernate) -> + collect_state_options( + StateOps, Retry, NewHibernate, Timeout, Operations); + {hibernate,_} -> + [{bad_state_ops,SOSOs}]; + {timeout,infinity,_} -> % Ignore since it will never time out + collect_state_options( + StateOps, Retry, Hibernate, undefined, Operations); + {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 -> + collect_state_options( + StateOps, Retry, Hibernate, NewTimeout, Operations); + {timeout,_,_} -> + [{bad_state_ops,SOSOs}]; + _ -> % Collect others as operations + collect_state_options( + StateOps, Retry, Hibernate, Timeout, [StateOp|Operations]) + end. + +process_state_operations([], Debug, _S, Q, P) -> + {Debug,Q,P}; +process_state_operations([Operation|Operations] = OOs, Debug, S, Q, P) -> + case Operation of + {reply,{_To,_Tag}=Client,Reply} -> + reply(Client, Reply), + NewDebug = sys_debug(Debug, S, {out,Reply,Client}), + process_state_operations(Operations, NewDebug, S, Q, P); + {stop,Reason} -> + [Reason,Debug]; + {insert_event,Type,Content} -> + case event_type(Type) of + true -> + process_state_operations( + Operations, Debug, S, [{Type,Content}|Q], P); + false -> + [{bad_state_ops,OOs},Debug] + end; + _ -> + %% All others are remove operations + case remove_fun(Operation) of + false -> + process_state_operations( + Operations, Debug, S, Q, P); + undefined -> + [{bad_state_ops,OOs},Debug]; + RemoveFun when is_function(RemoveFun, 2) -> + case remove_event(RemoveFun, Q, P) of + {NewQ,NewP} -> + process_state_operations( + Operations, Debug, S, NewQ, NewP); + Error -> + Error ++ [Debug] + end; + Error -> + Error ++ [Debug] + end + end. + +%% Remove oldest matching event from the queue(s) +remove_event(RemoveFun, Q, P) -> + try + case remove_tail_event(RemoveFun, P) of + false -> + case remove_head_event(RemoveFun, Q) of + false -> + {P,Q}; + NewQ -> + {P,NewQ} + end; + NewP -> + {NewP,Q} + end + catch + Class:Reason -> + [Class,Reason,erlang:get_stacktrace()] + end. + +%% Do the given state operation and create an event removal predicate fun() +remove_fun({remove_event,Type,Content}) -> + fun (T, C) when T =:= Type, C =:= Content -> true; + (_, _) -> false + end; +remove_fun({remove_event,RemoveFun}) when is_function(RemoveFun, 2) -> + RemoveFun; +remove_fun({cancel_timer,TimerRef}) -> + try cancel_timer(TimerRef) of + false -> + false; + true -> + fun + (info, {timeout,TRef,_}) + when TRef =:= TimerRef -> + true; + (_, _) -> + false + end + catch + Class:Reason -> + [Class,Reason,erlang:get_stacktrace()] + end; +remove_fun({demonitor,MonitorRef}) -> + try erlang:demonitor(MonitorRef, [flush,info]) of + false -> + false; + true -> + fun (info, {'DOWN',MRef,_,_,_}) + when MRef =:= MonitorRef-> + true; + (_, _) -> + false + end + catch + Class:Reason -> + [Class,Reason,erlang:get_stacktrace()] + end; +remove_fun({unlink,Id}) -> + try unlink(Id) of + true -> + receive + {'EXIT',Id,_} -> + ok + after 0 -> + ok + end, + fun (info, {'EXIT',I,_}) + when I =:= Id -> + true; + (_, _) -> + false + end + catch + Class:Reason -> + {Class,Reason,erlang:get_stacktrace()} + end; +remove_fun(_) -> + undefined. + + +%% Cancel a timer and clense the process mailbox returning +%% false if no such timer message can arrive after this or +%% true otherwise +cancel_timer(TimerRef) -> + case erlang:cancel_timer(TimerRef) of + TimeLeft when is_integer(TimeLeft) -> + false; + false -> + receive + {timeout,TimerRef,_} -> + false + after 0 -> + true + end + end. + + +terminate(Reason, Debug, S, Q) -> + terminate(exit, Reason, [], Debug, S, Q). +%% +terminate( + Class, Reason, Stacktrace, Debug, + #{name := Name, module := Module, + state := State, state_data := StateData} = S, + Q) -> + try Module:terminate(Reason, State, StateData) of + _ -> ok + catch + _ -> ok; + C:R -> + ST = erlang:get_stacktrace(), + error_info( + C, R, ST, Debug, Name, Q, + format_status(terminate, get(), S)), + erlang:raise(C, R, ST) + end, + case Reason of + normal -> ok; + shutdown -> ok; + {shutdown,_} -> ok; + _ -> + error_info( + Class, Reason, Stacktrace, Debug, Name, Q, + format_status(terminate, get(), S)) + end, + case Stacktrace of + [] -> + erlang:Class(Reason); + _ -> + erlang:raise(Class, Reason, Stacktrace) + end. + +error_info( + Class, Reason, Stacktrace, Debug, Name, Q, FmtStateData) -> + {FixedReason,FixedStacktrace} = + case Stacktrace of + [{M,F,Args,_}|ST] + when Class =:= error, Reason =:= undef -> + case code:is_loaded(M) of + false -> + {{'module could not be loaded',M},ST}; + _ -> + Arity = length(Args), + case erlang:function_exported(M, F, Arity) of + true -> + {Reason,Stacktrace}; + false -> + {{'function not exported',{M,F,Arity}}, + ST} + end + end; + _ -> {Reason,Stacktrace} + end, + error_logger:format( + "** State machine ~p terminating~n" ++ + case Q of + [] -> + ""; + _ -> + "** Last event = ~p~n" + end ++ + "** When Server state = ~p~n" ++ + "** Reason for termination = ~w:~p~n" ++ + case FixedStacktrace of + [] -> + ""; + _ -> + "** Stacktrace =~n" + "** ~p~n" + end, + [Name | + case Q of + [] -> + [FmtStateData,Class,FixedReason]; + [Event|_] -> + [Event,FmtStateData,Class,FixedReason] + end] ++ + case FixedStacktrace of + [] -> + []; + _ -> + [FixedStacktrace] + end), + sys:print_log(Debug), + ok. + + +%% Call Module:format_status/2 or return a default value +format_status( + Opt, PDict, + #{module := Module, state := State, state_data := StateData}) -> + case erlang:function_exported(Module, format_status, 2) of + true -> + try Module:format_status(Opt, [PDict,State,StateData]) + catch + Result -> Result; + _:_ -> + format_status_default(Opt, State, StateData) + end; + false -> + format_status_default(Opt, State, StateData) + end. + +%% The default Module:format_status/2 +format_status_default(Opt, State, StateData) -> + SSD = {State,StateData}, + case Opt of + terminate -> + SSD; + _ -> + [{data,[{"State",SSD}]}] + end. + +%%--------------------------------------------------------------------------- +%% Farily general helpers + +%% Return the modified list where the first element that satisfies +%% the RemoveFun predicate is removed, or false if no such element exists. +remove_head_event(_RemoveFun, []) -> + false; +remove_head_event(RemoveFun, [{Tag,Content}|Events]) -> + case RemoveFun(Tag, Content) of + false -> + remove_head_event(RemoveFun, Events); + true -> + Events + end. + +%% Return the modified list where the last element that satisfies +%% the RemoveFun predicate is removed, or false if no such element exists. +remove_tail_event(_RemoveFun, []) -> + false; +remove_tail_event(RemoveFun, [{Tag,Content} = Event|Events]) -> + case remove_tail_event(RemoveFun, Events) of + false -> + RemoveFun(Tag, Content) andalso Events; + NewEvents -> + [Event|NewEvents] + end. diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index 10c476a6f5..3f79ed0f87 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -472,13 +472,15 @@ trans_init(gen,init_it,[gen_server,_,_,supervisor_bridge,[Module|_],_]) -> {supervisor_bridge,Module,1}; trans_init(gen,init_it,[gen_server,_,_,_,supervisor_bridge,[Module|_],_]) -> {supervisor_bridge,Module,1}; -trans_init(gen,init_it,[gen_server,_,_,Module,_,_]) -> +trans_init(gen,init_it,[GenMod,_,_,Module,_,_]) + when GenMod =:= gen_server; + GenMod =:= gen_statem; + GenMod =:= gen_fsm -> {Module,init,1}; -trans_init(gen,init_it,[gen_server,_,_,_,Module|_]) -> - {Module,init,1}; -trans_init(gen,init_it,[gen_fsm,_,_,Module,_,_]) -> - {Module,init,1}; -trans_init(gen,init_it,[gen_fsm,_,_,_,Module|_]) -> +trans_init(gen,init_it,[GenMod,_,_,_,Module|_]) + when GenMod =:= gen_server; + GenMod =:= gen_statem; + GenMod =:= gen_fsm -> {Module,init,1}; trans_init(gen,init_it,[gen_event|_]) -> {gen_event,init_it,6}; diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 7f9bbbf649..dc17a44150 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -65,6 +65,7 @@ gen_event, gen_fsm, gen_server, + gen_statem, io, io_lib, io_lib_format, diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index e366c2b755..427d7fcaea 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -46,6 +46,7 @@ MODULES= \ gen_event_SUITE \ gen_fsm_SUITE \ gen_server_SUITE \ + gen_statem_SUITE \ id_transform_SUITE \ io_SUITE \ io_proto_SUITE \ diff --git a/lib/stdlib/test/error_logger_forwarder.erl b/lib/stdlib/test/error_logger_forwarder.erl index 7ac2cfce82..d34dde9def 100644 --- a/lib/stdlib/test/error_logger_forwarder.erl +++ b/lib/stdlib/test/error_logger_forwarder.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,7 +20,7 @@ -module(error_logger_forwarder). %% API. --export([register/0]). +-export([register/0, unregister/0]). %% Internal export for error_logger. -export([init/1, @@ -33,6 +33,10 @@ register() -> error_logger:add_report_handler(?MODULE, self()). +unregister() -> + Self = self(), + Self = error_logger:delete_report_handler(?MODULE). + init(Tester) -> {ok,Tester}. diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl new file mode 100644 index 0000000000..342be32acb --- /dev/null +++ b/lib/stdlib/test/gen_statem_SUITE.erl @@ -0,0 +1,1250 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(gen_statem_SUITE). + +-include_lib("test_server/include/test_server.hrl"). + +-compile(export_all). +-behaviour(gen_statem). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [{group, start}, + {group, abnormal}, + shutdown, + {group, sys}, hibernate, enter_loop]. + +groups() -> + [{start, [], + [start1, start2, start3, start4, start5, start6, start7, + start8, start9, start10, start11, start12]}, + {stop, [], + [stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10]}, + {abnormal, [], [abnormal1, abnormal2]}, + {sys, [], + [sys1, + call_format_status, + error_format_status, terminate_crash_format, + get_state, replace_state]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_testcase(_CaseName, Config) -> + ?t:messages_get(), + Dog = ?t:timetrap(?t:minutes(1)), +%%% dbg:tracer(), +%%% dbg:p(all, c), +%%% dbg:tpl(gen_statem, cx), + [{watchdog, Dog} | Config]. + +end_per_testcase(_CaseName, Config) -> +%%% dbg:stop(), + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + Config. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-define(EXPECT_FAILURE(Code, Reason), + try begin Code end of + _ -> + ?t:fail() + catch + error:Reason -> Reason; + exit:Reason -> Reason + end). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% anonymous +start1(Config) when is_list(Config) -> + %%OldFl = process_flag(trap_exit, true), + + {ok,Pid0} = gen_statem:start_link(?MODULE, [], []), + ok = do_func_test(Pid0), + ok = do_sync_func_test(Pid0), + stop_it(Pid0), +%% stopped = gen_statem:call(Pid0, stop), +%% timeout = +%% ?EXPECT_FAILURE(gen_statem:call(Pid0, hej), Reason), + + %%process_flag(trap_exit, OldFl), + ok = verify_empty_msgq(). + +%% anonymous w. shutdown +start2(Config) when is_list(Config) -> + %% Dont link when shutdown + {ok,Pid0} = gen_statem:start(?MODULE, [], []), + ok = do_func_test(Pid0), + ok = do_sync_func_test(Pid0), + stopped = gen_statem:call(Pid0, {stop,shutdown}), + check_stopped(Pid0), + ok = verify_empty_msgq(). + +%% anonymous with timeout +start3(Config) when is_list(Config) -> + %%OldFl = process_flag(trap_exit, true), + + {ok,Pid0} = gen_statem:start(?MODULE, [], [{timeout,5}]), + ok = do_func_test(Pid0), + ok = do_sync_func_test(Pid0), + stop_it(Pid0), + + {error,timeout} = gen_statem:start(?MODULE, sleep, + [{timeout,5}]), + + %%process_flag(trap_exit, OldFl), + ok = verify_empty_msgq(). + +%% anonymous with ignore +start4(Config) when is_list(Config) -> + OldFl = process_flag(trap_exit, true), + + ignore = gen_statem:start(?MODULE, ignore, []), + + process_flag(trap_exit, OldFl), + ok = verify_empty_msgq(). + +%% anonymous with stop +start5(suite) -> []; +start5(Config) when is_list(Config) -> + OldFl = process_flag(trap_exit, true), + + {error,stopped} = gen_statem:start(?MODULE, stop, []), + + process_flag(trap_exit, OldFl), + ok = verify_empty_msgq(). + +%% anonymous linked +start6(Config) when is_list(Config) -> + {ok,Pid} = gen_statem:start_link(?MODULE, [], []), + ok = do_func_test(Pid), + ok = do_sync_func_test(Pid), + stop_it(Pid), + + ok = verify_empty_msgq(). + +%% global register linked +start7(Config) when is_list(Config) -> + STM = {global,my_stm}, + + {ok,Pid} = + gen_statem:start_link(STM, ?MODULE, [], []), + {error,{already_started,Pid}} = + gen_statem:start_link(STM, ?MODULE, [], []), + {error,{already_started,Pid}} = + gen_statem:start(STM, ?MODULE, [], []), + + ok = do_func_test(Pid), + ok = do_sync_func_test(Pid), + ok = do_func_test(STM), + ok = do_sync_func_test(STM), + stop_it(STM), + + ok = verify_empty_msgq(). + + +%% local register +start8(Config) when is_list(Config) -> + %%OldFl = process_flag(trap_exit, true), + Name = my_stm, + STM = {local,Name}, + + {ok,Pid} = + gen_statem:start(STM, ?MODULE, [], []), + {error,{already_started,Pid}} = + gen_statem:start(STM, ?MODULE, [], []), + + ok = do_func_test(Pid), + ok = do_sync_func_test(Pid), + ok = do_func_test(Name), + ok = do_sync_func_test(Name), + stop_it(Pid), + + %%process_flag(trap_exit, OldFl), + ok = verify_empty_msgq(). + +%% local register linked +start9(Config) when is_list(Config) -> + %%OldFl = process_flag(trap_exit, true), + Name = my_stm, + STM = {local,Name}, + + {ok,Pid} = + gen_statem:start_link(STM, ?MODULE, [], []), + {error,{already_started,Pid}} = + gen_statem:start(STM, ?MODULE, [], []), + + ok = do_func_test(Pid), + ok = do_sync_func_test(Pid), + ok = do_func_test(Name), + ok = do_sync_func_test(Name), + stop_it(Pid), + + %%process_flag(trap_exit, OldFl), + ok = verify_empty_msgq(). + +%% global register +start10(Config) when is_list(Config) -> + STM = {global,my_stm}, + + {ok,Pid} = + gen_statem:start(STM, ?MODULE, [], []), + {error,{already_started,Pid}} = + gen_statem:start(STM, ?MODULE, [], []), + {error,{already_started,Pid}} = + gen_statem:start_link(STM, ?MODULE, [], []), + + ok = do_func_test(Pid), + ok = do_sync_func_test(Pid), + ok = do_func_test(STM), + ok = do_sync_func_test(STM), + stop_it(STM), + + ok = verify_empty_msgq(). + +%% Stop registered processes +start11(Config) when is_list(Config) -> + Name = my_stm, + LocalSTM = {local,Name}, + GlobalSTM = {global,Name}, + + {ok,Pid} = + gen_statem:start_link(LocalSTM, ?MODULE, [], []), + stop_it(Pid), + + {ok,_Pid1} = + gen_statem:start_link(LocalSTM, ?MODULE, [], []), + stop_it(Name), + + {ok,Pid2} = + gen_statem:start(GlobalSTM, ?MODULE, [], []), + stop_it(Pid2), + receive after 1 -> true end, + Result = + gen_statem:start(GlobalSTM, ?MODULE, [], []), + io:format("Result = ~p~n",[Result]), + {ok,_Pid3} = Result, + stop_it(GlobalSTM), + + ok = verify_empty_msgq(). + +%% Via register linked +start12(Config) when is_list(Config) -> + dummy_via:reset(), + VIA = {via,dummy_via,my_stm}, + + {ok,Pid} = + gen_statem:start_link(VIA, ?MODULE, [], []), + {error,{already_started,Pid}} = + gen_statem:start_link(VIA, ?MODULE, [], []), + {error,{already_started,Pid}} = + gen_statem:start(VIA, ?MODULE, [], []), + + ok = do_func_test(Pid), + ok = do_sync_func_test(Pid), + ok = do_func_test(VIA), + ok = do_sync_func_test(VIA), + stop_it(VIA), + + ok = verify_empty_msgq(). + + +%% Anonymous, reason 'normal' +stop1(_Config) -> + {ok,Pid} = gen_statem:start(?MODULE, [], []), + ok = gen_statem:stop(Pid), + false = erlang:is_process_alive(Pid), + noproc = + ?EXPECT_FAILURE(gen_statem:stop(Pid), Reason). + +%% Anonymous, other reason +stop2(_Config) -> + {ok,Pid} = gen_statem:start(?MODULE, [], []), + ok = gen_statem:stop(Pid, other_reason, infinity), + false = erlang:is_process_alive(Pid), + ok. + +%% Anonymous, invalid timeout +stop3(_Config) -> + {ok,Pid} = gen_statem:start(?MODULE, [], []), + _ = + ?EXPECT_FAILURE( + gen_statem:stop(Pid, other_reason, invalid_timeout), + Reason), + true = erlang:is_process_alive(Pid), + ok = gen_statem:stop(Pid), + false = erlang:is_process_alive(Pid), + ok. + +%% Registered name +stop4(_Config) -> + {ok,Pid} = gen_statem:start({local,to_stop},?MODULE, [], []), + ok = gen_statem:stop(to_stop), + false = erlang:is_process_alive(Pid), + noproc = + ?EXPECT_FAILURE(gen_statem:stop(to_stop), Reason), + ok. + +%% Registered name and local node +stop5(_Config) -> + Name = to_stop, + {ok,Pid} = gen_statem:start({local,Name},?MODULE, [], []), + ok = gen_statem:stop({Name,node()}), + false = erlang:is_process_alive(Pid), + noproc = + ?EXPECT_FAILURE(gen_statem:stop({Name,node()}), Reason), + ok. + +%% Globally registered name +stop6(_Config) -> + STM = {global,to_stop}, + {ok,Pid} = gen_statem:start(STM, ?MODULE, [], []), + ok = gen_statem:stop(STM), + false = erlang:is_process_alive(Pid), + noproc = + ?EXPECT_FAILURE(gen_statem:stop(STM), Reason), + ok. + +%% 'via' registered name +stop7(_Config) -> + VIA = {via,dummy_via,to_stop}, + dummy_via:reset(), + {ok,Pid} = gen_statem:start(VIA, + ?MODULE, [], []), + ok = gen_statem:stop(VIA), + false = erlang:is_process_alive(Pid), + noproc = + ?EXPECT_FAILURE(gen_statem:stop(VIA), Reason), + ok. + +%% Anonymous on remote node +stop8(_Config) -> + {ok,Node} = ?t:start_node(gen_statem_stop8, slave, []), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(Node, code, add_path, [Dir]), + {ok,Pid} = rpc:call(Node, gen_statem,start, [?MODULE,[],[]]), + ok = gen_statem:stop(Pid), + false = rpc:call(Node, erlang, is_process_alive, [Pid]), + noproc = + ?EXPECT_FAILURE(gen_statem:stop(Pid), Reason1), + true = ?t:stop_node(Node), + {nodedown,Node} = + ?EXPECT_FAILURE(gen_statem:stop(Pid), Reason2), + ok. + +%% Registered name on remote node +stop9(_Config) -> + Name = to_stop, + LocalSTM = {local,Name}, + {ok,Node} = ?t:start_node(gen_statem__stop9, slave, []), + STM = {Name,Node}, + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(Node, code, add_path, [Dir]), + {ok,Pid} = rpc:call(Node, gen_statem, start, [LocalSTM,?MODULE,[],[]]), + ok = gen_statem:stop(STM), + undefined = rpc:call(Node,erlang,whereis,[Name]), + false = rpc:call(Node,erlang,is_process_alive,[Pid]), + noproc = + ?EXPECT_FAILURE(gen_statem:stop(STM), Reason1), + true = ?t:stop_node(Node), + {nodedown,Node} = + ?EXPECT_FAILURE(gen_statem:stop(STM), Reason2), + ok. + +%% Globally registered name on remote node +stop10(_Config) -> + STM = {global,to_stop}, + {ok,Node} = ?t:start_node(gen_statem_stop10, slave, []), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(Node,code,add_path,[Dir]), + {ok,Pid} = rpc:call(Node, gen_statem, start, [STM,?MODULE,[],[]]), + global:sync(), + ok = gen_statem:stop(STM), + false = rpc:call(Node, erlang, is_process_alive, [Pid]), + noproc = + ?EXPECT_FAILURE(gen_statem:stop(STM), Reason1), + true = ?t:stop_node(Node), + noproc = + ?EXPECT_FAILURE(gen_statem:stop(STM), Reason2), + ok. + +%% Check that time outs in calls work +abnormal1(Config) when is_list(Config) -> + Name = abnormal1, + LocalSTM = {local,Name}, + + {ok, _Pid} = gen_statem:start(LocalSTM, ?MODULE, [], []), + + %% timeout call. + delayed = gen_statem:call(Name, {delayed_answer,1}, 100), + {timeout,_} = + ?EXPECT_FAILURE( + gen_statem:call(Name, {delayed_answer,1000}, 10), + Reason), + ok = verify_empty_msgq(). + +%% Check that bad return values makes the stm crash. Note that we must +%% trap exit since we must link to get the real bad_return_ error +abnormal2(Config) when is_list(Config) -> + OldFl = process_flag(trap_exit, true), + {ok,Pid} = gen_statem:start_link(?MODULE, [], []), + + %% bad return value in the gen_statem loop + {{bad_return_value,badreturn},_} = + ?EXPECT_FAILURE(gen_statem:call(Pid, badreturn), Reason), + receive + {'EXIT',Pid,{bad_return_value,badreturn}} -> ok + after 5000 -> + ?t:fail(gen_statem_did_not_die) + end, + + process_flag(trap_exit, OldFl), + ok = verify_empty_msgq(). + +shutdown(Config) when is_list(Config) -> + process_flag(trap_exit, true), + + {ok,Pid0} = gen_statem:start_link(?MODULE, [], []), + ok = do_func_test(Pid0), + ok = do_sync_func_test(Pid0), + stopped = gen_statem:call(Pid0, {stop,{shutdown,reason}}), + receive {'EXIT',Pid0,{shutdown,reason}} -> ok end, + process_flag(trap_exit, false), + + {noproc,_} = + ?EXPECT_FAILURE(gen_statem:call(Pid0, hej), Reason), + + receive + Any -> + io:format("Unexpected: ~p", [Any]), + ?t:fail() + after 500 -> + ok + end. + + + +sys1(Config) when is_list(Config) -> + {ok,Pid} = gen_statem:start(?MODULE, [], []), + {status, Pid, {module,gen_statem}, _} = sys:get_status(Pid), + sys:suspend(Pid), + Parent = self(), + Tag = make_ref(), + Caller = + spawn( + fun () -> + Parent ! {Tag,gen_statem:call(Pid, hej)} + end), + receive + {Tag,_} -> + ?t:fail() + after 3000 -> + exit(Caller, ok) + end, + + %% {timeout,_} = + %% ?EXPECT_FAILURE(gen_statem:call(Pid, hej), Reason), + sys:resume(Pid), + stop_it(Pid). + +call_format_status(Config) when is_list(Config) -> + {ok,Pid} = gen_statem:start(?MODULE, [], []), + Status = sys:get_status(Pid), + {status,Pid,_Mod,[_PDict,running,_,_, Data]} = Status, + [format_status_called|_] = lists:reverse(Data), + stop_it(Pid), + + %% check that format_status can handle a name being an atom (pid is + %% already checked by the previous test) + {ok, Pid2} = gen_statem:start({local, gstm}, ?MODULE, [], []), + Status2 = sys:get_status(gstm), + {status,Pid2,_Mod,[_PDict2,running,_,_,Data2]} = Status2, + [format_status_called|_] = lists:reverse(Data2), + stop_it(Pid2), + + %% check that format_status can handle a name being a term other than a + %% pid or atom + GlobalName1 = {global,"CallFormatStatus"}, + {ok,Pid3} = gen_statem:start(GlobalName1, ?MODULE, [], []), + Status3 = sys:get_status(GlobalName1), + {status,Pid3,_Mod,[_PDict3,running,_,_,Data3]} = Status3, + [format_status_called|_] = lists:reverse(Data3), + stop_it(Pid3), + GlobalName2 = {global,{name, "term"}}, + {ok,Pid4} = gen_statem:start(GlobalName2, ?MODULE, [], []), + Status4 = sys:get_status(GlobalName2), + {status,Pid4,_Mod,[_PDict4,running,_,_, Data4]} = Status4, + [format_status_called|_] = lists:reverse(Data4), + stop_it(Pid4), + + %% check that format_status can handle a name being a term other than a + %% pid or atom + dummy_via:reset(), + ViaName1 = {via,dummy_via,"CallFormatStatus"}, + {ok,Pid5} = gen_statem:start(ViaName1, ?MODULE, [], []), + Status5 = sys:get_status(ViaName1), + {status,Pid5,_Mod, [_PDict5,running,_,_, Data5]} = Status5, + [format_status_called|_] = lists:reverse(Data5), + stop_it(Pid5), + ViaName2 = {via,dummy_via,{name,"term"}}, + {ok, Pid6} = gen_statem:start(ViaName2, ?MODULE, [], []), + Status6 = sys:get_status(ViaName2), + {status,Pid6,_Mod,[_PDict6,running,_,_,Data6]} = Status6, + [format_status_called|_] = lists:reverse(Data6), + stop_it(Pid6). + + + +error_format_status(Config) when is_list(Config) -> + error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + StateData = "called format_status", + {ok,Pid} = gen_statem:start(?MODULE, {state_data,StateData}, []), + %% bad return value in the gen_statem loop + {{bad_return_value,badreturn},_} = + ?EXPECT_FAILURE(gen_statem:call(Pid, badreturn), Reason), + receive + {error,_, + {Pid, + "** State machine"++_, + [Pid,{{call,_},badreturn}, + {formatted,idle,StateData}, + exit,{bad_return_value,badreturn}|_]}} -> + ok; + Other when is_tuple(Other), element(1, Other) =:= error -> + error_logger_forwarder:unregister(), + ?t:fail({unexpected,Other}) + after 1000 -> + error_logger_forwarder:unregister(), + ?t:fail() + end, + process_flag(trap_exit, OldFl), + error_logger_forwarder:unregister(), + receive + %% Comes with SASL + {error_report,_,{Pid,crash_report,_}} -> + ok + after 500 -> + ok + end, + ok = verify_empty_msgq(). + +terminate_crash_format(Config) when is_list(Config) -> + error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + StateData = crash_terminate, + {ok,Pid} = gen_statem:start(?MODULE, {state_data,StateData}, []), + stop_it(Pid), + Self = self(), + receive + {error,_GroupLeader, + {Pid, + "** State machine"++_, + [Pid, + {{call,{Self,_}},stop}, + {formatted,idle,StateData}, + exit,{crash,terminate}|_]}} -> + ok; + Other when is_tuple(Other), element(1, Other) =:= error -> + error_logger_forwarder:unregister(), + ?t:fail({unexpected,Other}) + after 1000 -> + error_logger_forwarder:unregister(), + ?t:fail() + end, + process_flag(trap_exit, OldFl), + error_logger_forwarder:unregister(), + receive + %% Comes with SASL + {error_report,_,{Pid,crash_report,_}} -> + ok + after 500 -> + ok + end, + ok = verify_empty_msgq(). + + +get_state(Config) when is_list(Config) -> + State = self(), + {ok,Pid} = gen_statem: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_statem:start({local,gstm}, ?MODULE, {state_data,State}, []), + {idle,State} = sys:get_state(gstm), + {idle,State} = sys:get_state(gstm, 5000), + stop_it(Pid2), + + %% check that get_state works when pid is sys suspended + {ok,Pid3} = gen_statem:start(?MODULE, {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 = verify_empty_msgq(). + +replace_state(Config) when is_list(Config) -> + State = self(), + {ok, Pid} = gen_statem: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, + {callback_failed, + {gen_statem,system_replace_state},{error,fail}} = + ?EXPECT_FAILURE(sys:replace_state(Pid, Replace3), Reason), + {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 = verify_empty_msgq(). + +%% Hibernation +hibernate(Config) when is_list(Config) -> + OldFl = process_flag(trap_exit, true), + + {ok,Pid0} = gen_statem:start_link(?MODULE, hiber_now, []), + is_in_erlang_hibernate(Pid0), + stop_it(Pid0), + receive + {'EXIT',Pid0,normal} -> ok + after 5000 -> + ?t:fail(gen_statem_did_not_die) + end, + + {ok,Pid} = gen_statem:start_link(?MODULE, hiber, []), + true = ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid,current_function)), + hibernating = gen_statem:call(Pid, hibernate_sync), + is_in_erlang_hibernate(Pid), + good_morning = gen_statem:call(Pid, wakeup_sync), + is_not_in_erlang_hibernate(Pid), + hibernating = gen_statem:call(Pid, hibernate_sync), + is_in_erlang_hibernate(Pid), + please_just_five_more = gen_statem:call(Pid, snooze_sync), + is_in_erlang_hibernate(Pid), + good_morning = gen_statem:call(Pid, wakeup_sync), + is_not_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, hibernate_async), + is_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, wakeup_async), + is_not_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, hibernate_async), + is_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, snooze_async), + is_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, wakeup_async), + is_not_in_erlang_hibernate(Pid), + + Pid ! hibernate_later, + true = + ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid, current_function)), + is_in_erlang_hibernate(Pid), + + 'alive!' = gen_statem:call(Pid, 'alive?'), + true = + ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid, current_function)), + Pid ! hibernate_now, + is_in_erlang_hibernate(Pid), + + 'alive!' = gen_statem:call(Pid, 'alive?'), + true = + ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid, current_function)), + + hibernating = gen_statem:call(Pid, hibernate_sync), + is_in_erlang_hibernate(Pid), + good_morning = gen_statem:call(Pid, wakeup_sync), + is_not_in_erlang_hibernate(Pid), + hibernating = gen_statem:call(Pid, hibernate_sync), + is_in_erlang_hibernate(Pid), + please_just_five_more = gen_statem:call(Pid, snooze_sync), + is_in_erlang_hibernate(Pid), + good_morning = gen_statem:call(Pid, wakeup_sync), + is_not_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, hibernate_async), + is_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, wakeup_async), + is_not_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, hibernate_async), + is_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, snooze_async), + is_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, wakeup_async), + is_not_in_erlang_hibernate(Pid), + + hibernating = gen_statem:call(Pid, hibernate_sync), + is_in_erlang_hibernate(Pid), + sys:suspend(Pid), + is_in_erlang_hibernate(Pid), + sys:resume(Pid), + is_in_erlang_hibernate(Pid), + receive after 1000 -> ok end, + is_in_erlang_hibernate(Pid), + + good_morning = gen_statem:call(Pid, wakeup_sync), + is_not_in_erlang_hibernate(Pid), + stop_it(Pid), + process_flag(trap_exit, OldFl), + receive + {'EXIT',Pid,normal} -> ok + after 5000 -> + ?t:fail(gen_statem_did_not_die) + end, + ok = verify_empty_msgq(). + +is_in_erlang_hibernate(Pid) -> + receive after 1 -> ok end, + is_in_erlang_hibernate_1(200, Pid). + +is_in_erlang_hibernate_1(0, Pid) -> + io:format("~p\n", [erlang:process_info(Pid, current_function)]), + ?t:fail(not_in_erlang_hibernate_3); +is_in_erlang_hibernate_1(N, Pid) -> + {current_function,MFA} = erlang:process_info(Pid, current_function), + case MFA of + {erlang,hibernate,3} -> + ok; + _ -> + receive after 10 -> ok end, + is_in_erlang_hibernate_1(N-1, Pid) + end. + +is_not_in_erlang_hibernate(Pid) -> + receive after 1 -> ok end, + is_not_in_erlang_hibernate_1(200, Pid). + +is_not_in_erlang_hibernate_1(0, Pid) -> + io:format("~p\n", [erlang:process_info(Pid, current_function)]), + ?t:fail(not_in_erlang_hibernate_3); +is_not_in_erlang_hibernate_1(N, Pid) -> + {current_function,MFA} = erlang:process_info(Pid, current_function), + case MFA of + {erlang,hibernate,3} -> + receive after 10 -> ok end, + is_not_in_erlang_hibernate_1(N-1, Pid); + _ -> + ok + end. + +%%sys1(suite) -> []; +%%sys1(_) -> + +enter_loop(Config) when is_list(Config) -> + OldFlag = process_flag(trap_exit, true), + + dummy_via:reset(), + + %% Locally registered process + {local,Name} + {ok,Pid1a} = + proc_lib:start_link(?MODULE, enter_loop, [local,local]), + yes = gen_statem:call(Pid1a, 'alive?'), + stopped = gen_statem:call(Pid1a, stop), + receive + {'EXIT',Pid1a,normal} -> + ok + after 5000 -> + ?t:fail(gen_statem_did_not_die) + end, + + %% Unregistered process + {local,Name} + {ok,Pid1b} = + proc_lib:start_link(?MODULE, enter_loop, [anon,local]), + receive + {'EXIT',Pid1b,process_not_registered} -> + ok + after 5000 -> + ?t:fail(gen_statem_did_not_die) + end, + + %% Globally registered process + {global,Name} + {ok,Pid2a} = + proc_lib:start_link(?MODULE, enter_loop, [global,global]), + yes = gen_statem:call(Pid2a, 'alive?'), + stopped = gen_statem:call(Pid2a, stop), + receive + {'EXIT',Pid2a,normal} -> + ok + after 5000 -> + ?t:fail(gen_statem_did_not_die) + end, + + %% Unregistered process + {global,Name} + {ok,Pid2b} = + proc_lib:start_link(?MODULE, enter_loop, [anon,global]), + receive + {'EXIT',Pid2b,process_not_registered_globally} -> + ok + after 5000 -> + ?t:fail(gen_statem_did_not_die) + end, + + %% Unregistered process + no name + {ok,Pid3} = + proc_lib:start_link(?MODULE, enter_loop, [anon,anon]), + yes = gen_statem:call(Pid3, 'alive?'), + stopped = gen_statem:call(Pid3, stop), + receive + {'EXIT',Pid3,normal} -> + ok + after 5000 -> + ?t:fail(gen_statem_did_not_die) + end, + + %% Process not started using proc_lib + Pid4 = + spawn_link(gen_statem, enter_loop, [?MODULE,[],state0,[]]), + receive + {'EXIT',Pid4,process_was_not_started_by_proc_lib} -> + ok + after 5000 -> + ?t:fail(gen_statem_did_not_die) + end, + + %% Make sure I am the parent, ie that ordering a shutdown will + %% result in the process terminating with Reason==shutdown + {ok,Pid5} = + proc_lib:start_link(?MODULE, enter_loop, [anon,anon]), + yes = gen_statem:call(Pid5, 'alive?'), + exit(Pid5, shutdown), + receive + {'EXIT',Pid5,shutdown} -> + ok + after 5000 -> + ?t:fail(gen_statem_did_not_die) + end, + + %% Make sure gen_statem:enter_loop does not accept {local,Name} + %% when it's another process than the calling one which is + %% registered under that name + register(armitage, self()), + {ok,Pid6a} = + proc_lib:start_link(?MODULE, enter_loop, [anon,local]), + receive + {'EXIT',Pid6a,process_not_registered} -> + ok + after 1000 -> + ?t:fail(gen_statem_started) + end, + unregister(armitage), + + %% Make sure gen_statem:enter_loop does not accept {global,Name} + %% when it's another process than the calling one which is + %% registered under that name + global:register_name(armitage, self()), + {ok,Pid6b} = + proc_lib:start_link(?MODULE, enter_loop, [anon,global]), + receive + {'EXIT',Pid6b,process_not_registered_globally} -> + ok + after 1000 -> + ?t:fail(gen_statem_started) + end, + global:unregister_name(armitage), + + dummy_via:register_name(armitage, self()), + {ok,Pid6c} = + proc_lib:start_link(?MODULE, enter_loop, [anon,via]), + receive + {'EXIT',Pid6c,{process_not_registered_via,dummy_via}} -> + ok + after 1000 -> + ?t:fail( + {gen_statem_started, + process_info(self(), messages)}) + end, + dummy_via:unregister_name(armitage), + + process_flag(trap_exit, OldFlag), + ok = verify_empty_msgq(). + +enter_loop(Reg1, Reg2) -> + process_flag(trap_exit, true), + case Reg1 of + local -> register(armitage, self()); + global -> global:register_name(armitage, self()); + via -> dummy_via:register_name(armitage, self()); + anon -> ignore + end, + proc_lib:init_ack({ok, self()}), + case Reg2 of + local -> + gen_statem:enter_loop(?MODULE, [], state0, [], {local,armitage}); + global -> + gen_statem:enter_loop(?MODULE, [], state0, [], {global,armitage}); + via -> + gen_statem:enter_loop(?MODULE, [], state0, [], + {via, dummy_via, armitage}); + anon -> + gen_statem:enter_loop(?MODULE, [], state0, []) + end. + +%% +%% Functionality check +%% + +wfor(Msg) -> + receive + Msg -> ok + after 5000 -> + error(timeout) + end. + + +stop_it(STM) -> + stopped = gen_statem:call(STM, stop), + check_stopped(STM). + + +check_stopped(STM) -> + Call = there_you_are, + {_,{gen_statem,call,[_,Call,infinity]}} = + ?EXPECT_FAILURE(gen_statem:call(STM, Call), Reason), + ok. + + +do_func_test(STM) -> + ok = gen_statem:cast(STM, {'alive?',self()}), + wfor(yes), + ok = do_connect(STM), + ok = gen_statem:cast(STM, {'alive?',self()}), + wfor(yes), + ?t:do_times(3, ?MODULE, do_msg, [STM]), + ok = gen_statem:cast(STM, {'alive?',self()}), + wfor(yes), + ok = do_disconnect(STM), + ok = gen_statem:cast(STM, {'alive?',self()}), + wfor(yes), + ok. + + +do_connect(STM) -> + check_state(STM, idle), + gen_statem:cast(STM, {connect,self()}), + wfor(accept), + check_state(STM, wfor_conf), + gen_statem:cast(STM, confirm), + check_state(STM, connected), + ok. + +do_msg(STM) -> + check_state(STM, connected), + R = make_ref(), + ok = gen_statem:cast(STM, {msg,self(),R}), + wfor({ack,R}). + + +do_disconnect(STM) -> + ok = gen_statem:cast(STM, disconnect), + check_state(STM, idle). + +check_state(STM, State) -> + case gen_statem:call(STM, get) of + {state, State, _} -> ok + end. + +do_sync_func_test(STM) -> + yes = gen_statem:call(STM, 'alive?'), + ok = do_sync_connect(STM), + yes = gen_statem:call(STM, 'alive?'), + ?t:do_times(3, ?MODULE, do_sync_msg, [STM]), + yes = gen_statem:call(STM, 'alive?'), + ok = do_sync_disconnect(STM), + yes = gen_statem:call(STM, 'alive?'), + check_state(STM, idle), + ok = gen_statem:call(STM, {timeout,200}), + yes = gen_statem:call(STM, 'alive?'), + check_state(STM, idle), + ok. + + +do_sync_connect(STM) -> + check_state(STM, idle), + accept = gen_statem:call(STM, connect), + check_state(STM, wfor_conf), + yes = gen_statem:call(STM, confirm), + check_state(STM, connected), + ok. + +do_sync_msg(STM) -> + check_state(STM, connected), + R = make_ref(), + {ack,R} = gen_statem:call(STM, {msg,R}), + ok. + +do_sync_disconnect(STM) -> + yes = gen_statem:call(STM, disconnect), + check_state(STM, idle). + + +verify_empty_msgq() -> + receive after 500 -> ok end, + [] = ?t:messages_get(), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% The State Machine +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +init(ignore) -> + ignore; +init(stop) -> + {stop,stopped}; +init(stop_shutdown) -> + {stop,shutdown}; +init(sleep) -> + ?t:sleep(1000), + {ok,idle,data}; +init(hiber) -> + {ok,hiber_idle,[]}; +init(hiber_now) -> + {ok,hiber_idle,[],[hibernate]}; +init({state_data, StateData}) -> + {ok,idle,StateData}; +init(_) -> + {ok,idle,state_data}. + +terminate(_, _State, crash_terminate) -> + exit({crash,terminate}); +terminate({From,stopped}, State, _Data) -> + From ! {self(),{stopped,State}}, + ok; +terminate(_Reason, _State, _Data) -> + ok. + + +%% State functions + +idle(cast, {connect,Pid}, _, _, Data) -> + Pid ! accept, + {wfor_conf,Data}; +idle({call,From}, connect, _, _, Data) -> + {wfor_conf,Data,[{reply,From,accept}]}; +idle(cast, badreturn, _, _, _Data) -> + badreturn; +idle({call,_From}, badreturn, _, _, _Data) -> + badreturn; +idle({call,From}, {delayed_answer,T}, _, _, _Data) -> + receive + after T -> + [{reply,From,delayed}] + end; +idle({call,From}, {timeout,Time}, _, State, _Data) -> + {timeout, {From,Time}, [{timeout,Time,State}]}; +idle(Type, Content, PrevState, State, Data) -> + case handle_common_events(Type, Content, PrevState, State, Data) of + [] -> + case Type of + {call,From} -> + {State,Data,[{reply,From,'eh?'}]}; + _ -> + {State,Data, + [{stop,{unexpected,State,PrevState,Type,Content}}]} + end; + Result -> + Result + end. + +timeout(timeout, idle, idle, timeout, {From,Time}) -> + TRef2 = erlang:start_timer(Time, self(), ok), + TRefC1 = erlang:start_timer(Time, self(), cancel1), + TRefC2 = erlang:start_timer(Time, self(), cancel2), + {timeout2, + {From, Time, TRef2}, + [{cancel_timer, TRefC1}, + {insert_event,internal,{cancel_timer,TRefC2}}]}; +timeout(_, _, _, _, Data) -> + {Data}. + +timeout2( + internal, {cancel_timer,TRefC2}, timeout, _, {From,Time,TRef2}) -> + Time4 = Time * 4, + receive after Time4 -> ok end, + {timeout3,{From,TRef2},[{cancel_timer,TRefC2}]}; +timeout2(_, _, _, _, Data) -> + {Data}. + +timeout3(info, {timeout,TRef2,Result}, _, _, {From,TRef2}) -> + {idle,state,[{reply,From,Result}]}; +timeout3(_, _, _, _, Data) -> + {Data}. + +wfor_conf({call,From}, confirm, _, _, Data) -> + {connected,Data,[{reply,From,yes}]}; +wfor_conf(cast, confirm, _, _, Data) -> + {connected,Data}; +wfor_conf(Type, Content, PrevState, State, Data) -> + case handle_common_events(Type, Content, PrevState, State, Data) of + [] -> + case Type of + {call,From} -> + {idle,Data,[{reply,From,'eh?'}]}; + _ -> + {Data} + end; + Result -> + Result + end. + +connected({call,From}, {msg,Ref}, _, State, Data) -> + {State,Data,[{reply,From,{ack,Ref}}]}; +connected(cast, {msg,From,Ref}, _, _, _Data) -> + From ! {ack,Ref}, + {}; +connected({call,From}, disconnect, _, _, Data) -> + {idle,Data,[{reply,From,yes}]}; +connected(cast, disconnect, _, _, Data) -> + {idle,Data}; +connected(Type, Content, PrevState, State, Data) -> + case handle_common_events(Type, Content, PrevState, State, Data) of + [] -> + case Type of + {call,From} -> + [{reply,From,'eh?'}]; + _ -> + {Data} + end; + Result -> + Result + end. + +state0({call,From}, stop, _, State, Data) -> + {State,Data, + [{reply,From,stopped}, + {stop,normal}]}; +state0(Type, Content, PrevState, State, Data) -> + case handle_common_events(Type, Content, PrevState, State, Data) of + [] -> + {Data}; + Result -> + Result + end. + +hiber_idle({call,From}, 'alive?', _, _, _) -> + [{reply,From,'alive!'}]; +hiber_idle({call,From}, hibernate_sync, _, _, Data) -> + {hiber_wakeup,Data, + [{reply,From,hibernating}, + hibernate]}; +hiber_idle(info, hibernate_later, _, State, _) -> + Tref = erlang:start_timer(1000, self(), hibernate), + {State,Tref}; +hiber_idle(info, hibernate_now, _, State, Data) -> + {State,Data,[hibernate]}; +hiber_idle(info, {timeout,Tref,hibernate}, _, State, Tref) -> + {State,[], + [hibernate]}; +hiber_idle(cast, hibernate_async, _, _, Data) -> + {hiber_wakeup,Data, + [hibernate]}; +hiber_idle(Type, Content, PrevState, State, Data) -> + case handle_common_events(Type, Content, PrevState, State, Data) of + [] -> + {Data}; + Result -> + Result + end. + +hiber_wakeup({call,From}, wakeup_sync, _, _, Data) -> + {hiber_idle,Data,[{reply,From,good_morning}]}; +hiber_wakeup({call,From}, snooze_sync, _, State, Data) -> + {State,Data, + [{reply,From,please_just_five_more}, + hibernate]}; +hiber_wakeup(cast, wakeup_async, _, _, Data) -> + {hiber_idle,Data}; +hiber_wakeup(cast, snooze_async, _, _, _Data) -> + [hibernate]; +hiber_wakeup(Type, Content, PrevState, State, Data) -> + case handle_common_events(Type, Content, PrevState, State, Data) of + [] -> + {Data}; + Result -> + Result + end. + + +handle_common_events({call,From}, get, _, State, Data) -> + [{reply,From,{state,State,Data}}]; +handle_common_events(cast, {get,Pid}, _, State, Data) -> + Pid ! {state,State,Data}, + {}; +handle_common_events({call,From}, stop, _, _, _) -> + [{reply,From,stopped}, + {stop,normal}]; +handle_common_events(cast, stop, _, State, Data) -> + {State,Data, + [{stop,normal}]}; +handle_common_events({call,From}, {stop,Reason}, _, State, Data) -> + {State,Data, + [{reply,From,stopped}, + {stop,Reason}]}; +handle_common_events(cast, {stop,Reason}, _, _, _) -> + [{stop,Reason}]; +handle_common_events({call,From}, 'alive?', _, State, Data) -> + {State,Data, + [{reply,From,yes}]}; +handle_common_events(cast, {'alive?',Pid}, _, State, Data) -> + Pid ! yes, + {State,Data}; +handle_common_events(_, _, _, _, _) -> + []. + +code_change(_OldVsn, State, StateData, _Extra) -> + {ok,State,StateData}. + +format_status(terminate, [_Pdict,State,StateData]) -> + {formatted,State,StateData}; +format_status(normal, [_Pdict,_State,_StateData]) -> + [format_status_called]. -- cgit v1.2.3