diff options
| -rw-r--r-- | lib/stdlib/doc/src/Makefile | 3 | ||||
| -rw-r--r-- | lib/stdlib/doc/src/gen_statem.xml | 1131 | ||||
| -rw-r--r-- | lib/stdlib/doc/src/ref_man.xml | 3 | ||||
| -rw-r--r-- | lib/stdlib/doc/src/specs.xml | 1 | ||||
| -rw-r--r-- | lib/stdlib/src/Makefile | 3 | ||||
| -rw-r--r-- | lib/stdlib/src/gen_statem.erl | 1095 | ||||
| -rw-r--r-- | lib/stdlib/src/proc_lib.erl | 16 | ||||
| -rw-r--r-- | lib/stdlib/src/stdlib.app.src | 3 | ||||
| -rw-r--r-- | lib/stdlib/test/Makefile | 1 | ||||
| -rw-r--r-- | lib/stdlib/test/error_logger_forwarder.erl | 8 | ||||
| -rw-r--r-- | lib/stdlib/test/gen_statem_SUITE.erl | 1250 |
11 files changed, 3501 insertions, 13 deletions
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 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2016</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + + </legalnotice> + + <title>gen_statem</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + </header> + <module>gen_statem</module> + <modulesummary>Generic State Machine Behaviour</modulesummary> + <description> + <p>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 + <seealso marker="doc/design_principles:gen_server_concepts"> + OTP Design Principles</seealso> for more information. + </p> + <p>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:</p> + <pre> +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</pre> + <p>Events are of different + <seealso marker="#type-event_type">types</seealso> + so the callback functions can know the origin of an event + and how to respond. + </p> + <p>If a callback function fails or returns a bad value, + the gen_statem will terminate. An exception of class + <seealso marker="erts:erlang#throw/1"><c>throw</c></seealso>, + however, is not regarded as an error but as a valid return. + </p> + <marker id="state_function" /> + <p>The "<em>state function</em>" for a specific + <seealso marker="#type-state">state</seealso> + 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. + </p> + <p>The state machine + <seealso marker="#type-state"><c>State</c></seealso> + is normally an atom in which case the + <seealso marker="#state_function">state function</seealso> + that will be called is + <seealso marker="#Module:State/5"><c>Module:State/5</c></seealso>. + For a + <seealso marker="#type-state"><c>State</c></seealso> + that is <em>not</em> an atom the + <seealso marker="#state_function">state function</seealso> + <seealso marker="#Module:handle_event/5"> + <c>Module:handle_event/5</c> + </seealso> will be called. + If you use <c>handle_event</c> as a + <seealso marker="#type-state">state</seealso> and later + decides to use non-atom states you will then have to + rewrite your code to stop using that state. + </p> + <p>When the using an atom-only + <seealso marker="#type-state">State</seealso> + it becomes fairly obvious in the implementation code + which events are handled in which state + since there are different callback functions for different states. + </p> + <p> + When using a non-atom <seealso marker="#type-state">State</seealso> + all events are handled in the callback function + <seealso marker="#Module:handle_event/5"> + <c>Module:handle_event/5</c> + </seealso> + 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. + </p> + <p>A gen_statem handles system messages as documented in + <seealso marker="sys">sys</seealso>. + The <seealso marker="sys">sys</seealso> module + can be used for debugging a gen_statem. + </p> + <p>Note that a gen_statem does not trap exit signals automatically, + this must be explicitly initiated by the callback module. + </p> + <p>Unless otherwise stated, all functions in this module fail if + the specified gen_statem does not exist or if bad arguments are given. + </p> + <p>The gen_statem process can go into hibernation (see + <seealso marker="erts:erlang#hibernate/3"> + <c>erlang:hibernate/3</c> + </seealso>) if a + <seealso marker="#state_function">state function</seealso> or + <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso> + specifies <c>'hibernate'</c> in the returned + <seealso marker="#type-state_op"><c>StateOps</c></seealso> 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. + </p> + </description> + + <datatypes> + <datatype> + <name name="server_name" /> + <desc> + <p>Name specification to use when starting a gen_statem server. + See <seealso marker="#start_link/3"> + <c>start_link/3</c> + </seealso> and + <seealso marker="#type-server_ref"> + <c>server_ref()</c> + </seealso> below. + </p> + </desc> + </datatype> + <datatype> + <name name="server_ref" /> + <desc> + <p>Server specification to use when addressing a gen_statem server. + See <seealso marker="#call/2">call/2</seealso> and + <seealso marker="#type-server_name"> + <c>server_name()</c> + </seealso> above. + </p> + <p>It can be:</p> + <list type="bulleted"> + <item>the <c>pid()</c>,</item> + <item><c><anno>Name</anno></c>, + if the gen_statem is locally registered, + </item> + <item><c>{<anno>Name</anno>,<anno>Node</anno>}</c>, + if the gen_statem is locally registered at another node, or + </item> + <item><c>{global,<anno>GlobalName</anno>}</c>, + if the gen_statem is globally registered. + </item> + <item><c>{via,<anno>RegMod</anno>,<anno>ViaName</anno>}</c>, + if the gen_statem is registered through + an alternative process registry. + The registry callback module <c>RegMod</c> + should export the functions + <c>register_name/2</c>, <c>unregister_name/1</c>, + <c>whereis_name/1</c> and <c>send/2</c>, + which should behave like the corresponding functions + in <seealso marker="kernel:global"><c>global</c></seealso>. + Thus, <c>{via,global,GlobalName}</c> is the same as + <c>{global,GlobalName}</c>. + </item> + </list> + </desc> + </datatype> + <datatype> + <name name="debug_opt" /> + <desc> + <p>Debug option that can be used when starting + a gen_statem server through for example + <seealso marker="#enter_loop/4">enter_loop/4</seealso>. + </p> + <p>For every entry in <c><anno>Dbgs</anno></c> + the corresponding function in + <seealso marker="sys"><c>sys</c></seealso> will be called. + </p> + </desc> + </datatype> + <datatype> + <name name="start_opt" /> + <desc> + <p>Options that can be used when starting + a gen_statem server through for example + <seealso marker="#start_link/3">start_link/3</seealso>. + </p> + </desc> + </datatype> + <datatype> + <name name="start_ret" /> + <desc> + <p>Return value from the start functions for_example + <seealso marker="#start_link/3">start_link/3</seealso>. + </p> + </desc> + </datatype> + + <datatype> + <name name="client" /> + <desc> + <p>Client address to use when replying through for example the + <seealso marker="#type-state_op">state_op()</seealso> + <c>{reply,Client,Reply}</c> to a client + that has called the gen_statem server using + <seealso marker="#call/2">call/2</seealso>. + </p> + </desc> + </datatype> + <datatype> + <name name="state" /> + <desc> + <p>If the gen_statem <c>State</c> is an <c>atom()</c>, the + <seealso marker="#state_function">state function</seealso> is + <seealso marker="#Module:State/5">Module:State/5</seealso>. + If it is any other <c>term()</c> the + <seealso marker="#state_function">state function</seealso> is + <seealso marker="#Module:handle_event/5"> + Module:handle_event/5 + </seealso>. After a state change (<c>NewState =/= State</c>) + all postponed events are retried. + </p> + </desc> + </datatype> + <datatype> + <name name="state_data" /> + <desc> + <p>A <c>term()</c> in which the state machine implementation + should store any state data it needs. The difference between + this data and the + <seealso marker="#type-state">state()</seealso> + itself is that a change in this data does not cause + postponed events to be retried. + </p> + </desc> + </datatype> + <datatype> + <name name="event_type" /> + <desc> + <p>External events are of 3 different type: + <c>{call,<anno>Client</anno>}</c>, <c>cast</c> or <c>info</c>. + Calls (synchronous) and casts (asynchronous) + originate from the corresponding API functions. + For calls the event contain whom to reply to. + Type <c>info</c> 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 + <c>timeout</c> and <c>internal</c>. + </p> + </desc> + </datatype> + <datatype> + <name name="event_predicate" /> + <desc> + <p>A <c>fun()</c> of arity 2 that takes an event + and returns a boolean. + When used in <c>{remove_event,RemoveEventPredicate}</c> + from <seealso marker="#type-state_op">state_op()</seealso>. + The event for which the predicate returns <c>true</c> will + be removed. + </p> + <p> + The predicate may <em>not</em> use a throw exception + to return its result. + </p> + </desc> + </datatype> + <datatype> + <name name="state_op" /> + <desc> + <p>Either a + <seealso marker="#type-state_option"> + <c>state_option()</c> + </seealso> of which the first occurence + in the containing list takes precedence, or a + <seealso marker="#type-state_operation"> + <c>state_operation()</c> + </seealso> that are performed in order of + the containing list. + </p> + <p>These may be returned from the + <seealso marker="#state_function">state function</seealso> + or from <seealso marker="#Module:init/1">Module:init/1</seealso>. + </p> + <p>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 + <c>{insert_event,EventType,EventContent}</c> that is inserted + as the next event to process. + </p> + <p>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. + </p> + <p>The processing order is:</p> + <list type="ordered"> + <item>If the option <c>retry</c> is <c>true</c> + the current event is enqueued as postponed to be retried. + </item> + <item>If the state changes all postponed events + are transferred to not yet processed to be processed + before other not yet processed events. + </item> + <item>All operations are processed in order of appearance. + </item> + <item>The <c>timeout</c> option is processed if present. + So a state timer may be started or a timeout zero event + may be inserted as if just received. + </item> + <item>The (possibly new) + <seealso marker="#state_function">state function</seealso> + is called with the next not yet processed event + if there is any, otherwise the gen_statem goes into <c>receive</c> + or hibernation (if the option <c>hibernate</c> is <c>true</c>) + to wait for the next message. In hibernation the next + non-system event awakens the gen_statem. + </item> + </list> + </desc> + </datatype> + <datatype> + <name name="state_option" /> + <desc> + <taglist> + <tag><c>retry</c></tag> + <tag><c>{retry,<anno>Retry</anno>}</c></tag> + <item>If <c><anno>Retry</anno> =:= true</c> + or plain <c>retry</c> postpone the current event + to be retried after a state change. + </item> + <tag><c>hibernate</c></tag> + <tag><c>{hibernate,<anno>Hibernate</anno>}</c></tag> + <item>If <c><anno>Hibernate</anno> =:= true</c> + or plain <c>hibernate</c> hibernate the gen_statem by calling + <seealso marker="proc_lib#hibernate/3"> + <c>proc_lib:hibernate/3</c> + </seealso> before <c>receive</c> to wait for a new event. + If there are not yet processed events the + <c>hibernate</c> operation is ignored as if an event + just arrived and awakened the gen_statem. + </item> + <tag> + <c>{timeout,<anno>Time</anno>,<anno>Msg</anno>}</c> + </tag> + <item>Generate an event of + <seealso marker="#type-event_type">type <c>timeout</c></seealso> + after <c><anno>Time</anno></c> milliseconds unless some other + event is received before that time. Note that a retried + event counts just like a new in this respect. + If <c>Time =:= infinity</c> or <c>Time =:= 0</c> + 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 + <seealso marker="#type-state_operation"> + <c>state_operation()</c> + </seealso> <c>cancel_timer</c>. + This timeout is cancelled automatically by any event. + </item> + </taglist> + </desc> + </datatype> + <datatype> + <name name="state_operation" /> + <desc> + <taglist> + <tag> + <c>{reply,<anno>Client</anno>,<anno>Reply</anno>}</c> + </tag> + <item>Reply to a client that called + <seealso marker="#call/2"><c>call/2</c></seealso>. + <c><anno>Client</anno></c> must be the term from the + <seealso marker="#type-event_type"> + <c>{call,<anno>Client</anno>}</c> + </seealso> argument to the + <seealso marker="#state_function">state function</seealso>. + </item> + <tag><c>{stop,<anno>Reason</anno>}</c></tag> + <item>The gen_statem will call + <seealso marker="#Module:terminate/3"> + <c>Module:terminate/3</c> + </seealso> with <c><anno>Reason</anno></c> and terminate. + </item> + <tag> + <c> + {insert_event,<anno>EventType</anno>,<anno>EventContent</anno>} + </c> + </tag> + <item>Insert the given event as the next to process + before any other not yet processed events. + An event of type + <seealso marker="#type-event_type"> + <c>internal</c> + </seealso> should be used when you want to reliably distinguish + an event inserted this way from any external event. + </item> + <tag> + <c> + {remove_event,<anno>EventType</anno>,<anno>EventContent</anno>} + </c> + </tag> + <item>Remove the oldest queued event + that matches equal to the given event. + </item> + <tag> + <c> + {remove_event,<anno>EventPredicate</anno>} + </c> + </tag> + <item>Remove the oldest queued event for which + the <c><anno>EventPredicate</anno></c> returns <c>true</c>. + </item> + <tag><c>{cancel_timer,<anno>TimerRef</anno>}</c></tag> + <item>Uses <c><anno>TimerRef</anno></c> when calling + <seealso marker="erts:erlang#cancel_timer/2"> + <c>erlang:cancel_timer/2</c> + </seealso> 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 + <c>{remove_event,<anno>EventPredicate</anno>}</c> above. + This is a convenience function that saves quite some + lines of code and testing time over doing it from + the primitives mentioned above. + </item> + <tag><c>{demonitor,<anno>MonitorRef</anno>}</c></tag> + <item>Like <c>{cancel_timer,_}</c> above but for + <seealso marker="erts:erlang#demonitor/2"> + <c>demonitor/2</c> + </seealso>. + </item> + <tag><c>{unlink,<anno>Id</anno>}</c></tag> + <item>Like <c>{cancel_timer,_}</c> above but for + <seealso marker="erts:erlang#unlink/1"> + <c>unlink/1</c> + </seealso>. + </item> + </taglist> + </desc> + </datatype> + </datatypes> + + <funcs> + + <func> + <name name="start_link" arity="3" /> + <name name="start_link" arity="4" /> + <fsummary>Create a linked gen_statem process</fsummary> + <desc> + <p>Creates a gen_statem process according to OTP design principles + (using + <seealso marker="proc_lib"><c>proc_lib</c></seealso> + 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. + </p> + <p>The gen_statem process calls + <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso> + to initialize the server. To ensure a synchronized start-up + procedure, <c>start_link/3,4</c> does not return until + <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso> + has returned. + </p> + <p><c><anno>ServerName</anno></c> specifies the + <seealso marker="#type-server_name"> + <c>server_name()</c> + </seealso> to register for the gen_statem. + If the gen_statem is started with <c>start_link/3</c> + no <c><anno>ServerName</anno></c> is provided and + the gen_statem is not registered. + </p> + <p><c><anno>Module</anno></c> is the name of the callback module.</p> + <p><c><anno>Args</anno></c> is an arbitrary term which is passed as + the argument to + <seealso marker="#Module:init/1"><c>Module:init/1</c> + </seealso>. + </p> + <p>If the option <c>{timeout,Time}</c> is present in + <c><anno>Options</anno></c>, the gen_statem is allowed to spend + <c>Time</c> milliseconds initializing or it will be + terminated and the start function will return + <seealso marker="#type-start_ret"> + <c>{error,timeout}</c> + </seealso>. + </p> + <p>If the option + <seealso marker="#type-debug_opt"><c>{debug,Dbgs}</c></seealso> + is present in <c><anno>Options</anno></c>, debugging through + <seealso marker="sys"><c>sys</c></seealso> is activated. + </p> + <p>If the option <c>{spawn_opt,SOpts}</c> is present in + <c><anno>Options</anno></c>, <c>SOpts</c> will be passed + as option list to the <c>spawn_opt</c> BIF + which is used to + <seealso marker="erts:erlang#spawn_opt/2">spawn</seealso> + the gen_statem. + </p> + <note> + <p>Using the spawn option <c>monitor</c> is currently not + allowed, but will cause this function to fail with reason + <c>badarg</c>.</p> + </note> + <p>If the gen_statem is successfully created and initialized + this function returns + <seealso marker="#type-start_ret"> + <c>{ok,Pid}</c>, + </seealso> where <c>Pid</c> is the <c>pid()</c> of the gen_statem. + If there already exists a process with the specified + <c><anno>ServerName</anno></c> this function returns + <seealso marker="#type-start_ret"> + <c>{error,{already_started,Pid}}</c> + </seealso>, where <c>Pid</c> is the <c>pid()</c> of that process. + </p> + <p>If <c>Module:init/1</c> fails with <c>Reason</c>, + this function returns + <seealso marker="#type-start_ret"> + <c>{error,Reason}</c> + </seealso>. If <c>Module:init/1</c> returns + <seealso marker="#type-start_ret"> + <c>{stop,Reason}</c> + </seealso> + or + <seealso marker="#type-start_ret"> + <c>ignore</c> + </seealso>, the process is terminated and this function + returns + <seealso marker="#type-start_ret"> + <c>{error,Reason}</c> + </seealso> or + <seealso marker="#type-start_ret"> + <c>ignore</c> + </seealso>, respectively. + </p> + </desc> + </func> + + + <func> + <name name="start" arity="3" /> + <name name="start" arity="4" /> + <fsummary>Create a stand-alone gen_statem process</fsummary> + <desc> + <p>Creates a stand-alone gen_statem process according to + OTP design principles (using + <seealso marker="proc_lib"><c>proc_lib</c></seealso> + 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. + </p> + <p>See <seealso marker="#start_link/3">start_link/3,4</seealso> + for a description of arguments and return values. + </p> + </desc> + </func> + + <func> + <name name="stop" arity="1" /> + <fsummary>Synchronously stop a generic server</fsummary> + <desc> + <p>The same as + <seealso marker="#stop/3"> + <c>stop(<anno>ServerRef</anno>, normal, infinity)</c> + </seealso>. + </p> + </desc> + </func> + <func> + <name name="stop" arity="3" /> + <fsummary>Synchronously stop a generic server</fsummary> + <desc> + <p>Orders the gen_statem + <seealso marker="#type-server_ref"> + <c><anno>ServerRef</anno></c> + </seealso> to exit with the given <c><anno>Reason</anno></c> + and waits for it to terminate. + The gen_statem will call + <seealso marker="#Module:terminate/3"> + Module:terminate/3 + </seealso> before exiting. + </p> + <p>This function returns <c>ok</c> if the server terminates + with the expected reason. Any other reason than <c>normal</c>, + <c>shutdown</c>, or <c>{shutdown,Term}</c> will cause an + error report to be issued through + <seealso marker="kernel:error_logger#format/2"> + error_logger:format/2 + </seealso>. + The default <c><anno>Reason</anno></c> is <c>normal</c>. + </p> + <p><c><anno>Timeout</anno></c> is an integer greater than zero + which specifies how many milliseconds to wait for the server to + terminate, or the atom <c>infinity</c> to wait indefinitely. + The default value is <c>infinity</c>. + If the server has not terminated within the specified time, + a <c>timeout</c> exception is raised. + </p> + <p>If the process does not exist, a <c>noproc</c> exception + is raised. + </p> + </desc> + </func> + + <func> + <name name="call" arity="2" /> + <name name="call" arity="3" /> + <fsummary>Make a synchronous call to a gen_statem</fsummary> + <desc> + <p>Makes a synchronous call to the gen_statem + <seealso marker="#type-server_ref"> + <c><anno>ServerRef</anno></c> + </seealso> by sending a request + and waiting until its reply arrives. + The gen_statem will call the + <seealso marker="#state_function">state function</seealso> with + <seealso marker="#type-event_type"><c>event_type()</c></seealso> + <c>{call,Client}</c> and event content + <c><anno>Request</anno></c>. + </p> + <p>A <c><anno>Reply</anno></c> is generated when a + <seealso marker="#state_function">state function</seealso> + returns with + <c>{reply,Client,<anno>Reply</anno>}</c> as one + <seealso marker="#type-state_op"><c>state_op()</c></seealso>, + and that <c><anno>Reply</anno></c> becomes the return value + of this function. + </p> + <p><c><anno>Timeout</anno></c> is an integer greater than zero + which specifies how many milliseconds to wait for a reply, + or the atom <c>infinity</c> to wait indefinitely, + which is the default. If no reply is received within + the specified time, the function call fails. + <note> + <p>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 + <c><anno>Timeout</anno> =:= infinity</c>. + </p> + </note> + </p> + <p>The call may fail for example if the gen_statem dies + before or during this function call. + </p> + </desc> + </func> + + <func> + <name name="cast" arity="2" /> + <fsummary>Send an asynchronous event to a gen_statem</fsummary> + <desc> + <p>Sends an asynchronous event to the gen_statem + <seealso marker="#type-server_ref"> + <c><anno>ServerRef</anno></c> + </seealso> and returns <c>ok</c> immediately, + ignoring if the destination node or gen_statem does not exist. + The gen_statem will call the + <seealso marker="#state_function">state function</seealso> with + <seealso marker="#type-event_type"><c>event_type()</c></seealso> + <c>cast</c> and event content + <c><anno>Msg</anno></c>. + </p> + </desc> + </func> + + <func> + <name name="reply" arity="2" /> + <fsummary>Send a reply to a client</fsummary> + <desc> + <p>This function can be used by a gen_statem to explicitly send + a reply to a client that called + <seealso marker="#call/2"><c>call/2</c></seealso> + when the reply cannot be defined in + the return value of the + <seealso marker="#state_function">state function</seealso>. + </p> + <p><c><anno>Client</anno></c> must be the term from the + <seealso marker="#type-event_type"> + <c>{call,<anno>Client</anno>}</c> + </seealso> argument to the + <seealso marker="#state_function">state function</seealso>. + </p> + <note> + <p>A reply sent with this function will not be visible + in <seealso marker="sys">sys</seealso> debug output. + </p> + </note> + </desc> + </func> + + <func> + <name name="enter_loop" arity="4" /> + <fsummary>Enter the gen_statem receive loop</fsummary> + <desc> + <p>The same as + <seealso marker="#enter_loop/6"><c>enter_loop/6</c></seealso> + except that no + <seealso marker="#type-server_name"> + <c>server_name()</c> + </seealso> must have been registered. + </p> + </desc> + </func> + <func> + <name name="enter_loop" arity="5" /> + <fsummary>Enter the gen_statem receive loop</fsummary> + <desc> + <p>If <c><anno>Server_or_StateOps</anno></c> is a <c>list()</c> + the same as + <seealso marker="#enter_loop/6"><c>enter_loop/6</c></seealso> + except that no + <seealso marker="#type-server_name"> + <c>server_name()</c> + </seealso> must have been registered and + <c>StateOps = <anno>Server_or_StateOps</anno></c>. + </p> + <p>Otherwise the same as + <seealso marker="#enter_loop/6"><c>enter_loop/6</c></seealso> + with + <c>Server = <anno>Server_or_StateOps</anno></c> and + <c>StateOps = []</c>. + </p> + </desc> + </func> + <func> + <name name="enter_loop" arity="6" /> + <fsummary>Enter the gen_statem receive loop</fsummary> + <desc> + <p>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 + <em>must</em> have been started using one of the start + functions in + <seealso marker="proc_lib"><c>proc_lib</c></seealso>. + The user is responsible for any initialization of the process, + including registering a name for it. + </p> + <p>This function is useful when a more complex initialization + procedure is needed than the gen_statem behaviour provides. + </p> + <p><c><anno>Module</anno></c>, <c><anno>Options</anno></c> and + <c><anno>Server</anno></c> have the same meanings + as when calling + <seealso marker="#start_link/3">gen_statem:start[_link]/3,4</seealso>. + However, the + <seealso marker="#type-server_name"> + <c>server_name()</c> + </seealso> name must have been registered accordingly + <em>before</em> this function is called.</p> + <p><c><anno>State</anno></c> and <c><anno>StateData</anno></c> + have the same meanings as in the return value of + <seealso marker="#Module:init/1">Module:init/1</seealso>. + Also, the callback module <c><anno>Module</anno></c> + does not need to export an <c>init/1</c> function. + </p> + <p>Failure: If the calling process was not started by a + <seealso marker="proc_lib"><c>proc_lib</c></seealso> + start function, or if it is not registered + according to + <seealso marker="#type-server_name"> + <c>server_name()</c> + </seealso>. + </p> + </desc> + </func> + + </funcs> + + + + <section> + <title>CALLBACK FUNCTIONS</title> + <p>The following functions should be exported from a + <c>gen_statem</c> callback module. + </p> + </section> + <funcs> + + <func> + <name>Module:init(Args) -> Result</name> + <fsummary>Initialize process and internal state</fsummary> + <type> + <v>Args = term()</v> + <v>Result = {ok,State,StateData}</v> + <v> | {ok,State,StateData,StateOps}</v> + <v> | {stop,Reason} | ignore</v> + <v>State = <seealso marker="#type-state">state()</seealso></v> + <v>StateData = <seealso marker="#type-state_data">state_data()</seealso></v> + <v>StateOps = [<seealso marker="#type-state_op">state_op()</seealso>]</v> + <v>Reason = term()</v> + </type> + <desc> + <marker id="Module:init-1" /> + <p>Whenever a gen_statem is started using + <seealso marker="#start_link/3">gen_statem:start_link/3,4</seealso> + or + <seealso marker="#start/3">gen_statem:start/3,4</seealso>, + this function is called by the new process to initialize + the implementation loop data. + </p> + <p><c>Args</c> is the <c>Args</c> argument provided to the start + function.</p> + <p>If the initialization is successful, the function should + return <c>{ok,State,StateData}</c> or + <c>{ok,State,StateData,StateOps}</c>. + <c>State</c> is the <seealso marker="#type-state">state</seealso> + of the gen_statem. + </p> + <p>The <seealso marker="#type-state_op"><c>StateOps</c></seealso> + are executed before entering the first + <seealso marker="#type-state">state</seealso> just as for a + <seealso marker="#state_function">state function</seealso>. + </p> + <p>If something goes wrong during the initialization + the function should return <c>{stop,Reason}</c> + or <c>ignore</c>. See + <seealso marker="#start_link/3">gen_statem:start_link/3,4</seealso>. + </p> + </desc> + </func> + + <func> + <name>Module:handle_event(EventType, EventContent, + PrevState, State, StateData) -> Result + </name> + <name>Module:State(EventType, EventContent, + PrevState, State, StateData) -> Result + </name> + <fsummary>Handle an event</fsummary> + <type> + <v>EventType = + <seealso marker="#type-event_type">event_type()</seealso> + </v> + <v>EventContent = term()</v> + <v>Result = {NewState,NewStateData,StateOps}</v> + <v> | {NewState,NewStateData}</v> + <d> The same as <c>{NewState,NewStateData,[]}</c></d> + <v> | {NewStateData}</v> + <d> The same as <c>{State,NewStateData,[retry]}</c></d> + <v> | {}</v> + <d> The same as <c>{State,StateData,[]}</c></d> + <v> | StateOps</v> + <d> The same as <c>{State,StateData,StateOps}</c></d> + + <v>PrevState = State = NewState = + <seealso marker="#type-state">state()</seealso> + </v> + <v>StateData = NewStateData = + <seealso marker="#type-state_data">state_data()</seealso> + </v> + <v>StateOps = + [<seealso marker="#type-state_op">state_op()</seealso>] + </v> + </type> + <desc> + <p>Whenever a gen_statem receives an event from + <seealso marker="#call/2">gen_statem:call/2</seealso>, + <seealso marker="#cast/2">gen_statem:cast/2</seealso> or + as a normal process message this function is called. + If the <c>EventType</c> is + <seealso marker="#type-event_type"><c>{call,Client}</c></seealso> + the client is waiting for a reply. The reply can be sent + from this or from any other + <seealso marker="#state_function">state function</seealso> + by returning with <c>{reply,Client,Reply}</c> in + <seealso marker="#type-state_op">StateOps</seealso> + or by calling + <seealso marker="#reply/2"> + <c>gen_statem:reply(Client, Reply)</c> + </seealso>. + </p> + <p><seealso marker="#type-state"><c>State</c></seealso> + is the internal state of the gen_statem which + when <c>State</c> is an <c>atom()</c> + is the same as this function's name, so it is seldom useful, + except for example when comparing with <c>PrevState</c> + that is the gen_statem's previous state, or in + <seealso marker="#Module:handle_event/5"> + Module:handle_event/5 + </seealso> since that function is common for all states + that are not an <c>atom()</c>. + </p> + <p>If this function returns with + <seealso marker="#type-state"><c>NewState =/= State</c></seealso> + all postponed events will be retried in the new state. + </p> + <p>See <seealso marker="#type-state_op">state_op()</seealso> + for the operations that can be done by gen_statem + after returning from this function. + </p> + </desc> + </func> + + <func> + <name>Module:terminate(Reason, State, StateData)</name> + <fsummary>Clean up before termination</fsummary> + <type> + <v>Reason = normal | shutdown | {shutdown,term()} | term()</v> + <v>State = <seealso marker="#type-state">state()</seealso></v> + <v>StateData = + <seealso marker="#type-state_data"> + state_data() + </seealso> + </v> + </type> + <desc> + <p>This function is called by a gen_statem when it is about to + terminate. It should be the opposite of + <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso> + and do any necessary cleaning up. When it returns, + the gen_statem terminates with <c>Reason</c>. The return + value is ignored.</p> + <p><c>Reason</c> is a term denoting the stop reason and + <seealso marker="#type-state">State</seealso> + is the internal state of the gen_statem. + </p> + <p><c>Reason</c> depends on why the gen_statem is terminating. + If it is because another callback function has returned a + stop tuple <c>{stop,Reason}</c> in + <seealso marker="#type-state_op">StateOps</seealso>, + <c>Reason</c> will have the value specified in that tuple. + If it is due to a failure, <c>Reason</c> is the error reason. + </p> + <p>If the gen_statem is part of a supervision tree and is + ordered by its supervisor to terminate, this function will be + called with <c>Reason = shutdown</c> if the following + conditions apply:</p> + <list type="bulleted"> + <item>the gen_statem has been set to trap exit signals, and</item> + <item>the shutdown strategy as defined in the supervisor's + child specification is an integer timeout value, not + <c>brutal_kill</c>. + </item> + </list> + <p>Even if the gen_statem is <em>not</em> part of a supervision tree, + this function will be called if it receives an <c>'EXIT'</c> + message from its parent. <c>Reason</c> will be the same as in + the <c>'EXIT'</c> message. + </p> + <p>Otherwise, the gen_statem will be immediately terminated. + </p> + <p>Note that for any other reason than <c>normal</c>, + <c>shutdown</c>, or <c>{shutdown,Term}</c> the gen_statem is + assumed to terminate due to an error and + an error report is issued using + <seealso marker="kernel:error_logger#format/2"> + error_logger:format/2 + </seealso>. + </p> + </desc> + </func> + + <func> + <name>Module:code_change(OldVsn, OldState, OldStateData, Extra) -> + Result + </name> + <fsummary>Update the internal state during upgrade/downgrade</fsummary> + <type> + <v>OldVsn = Vsn | {down,Vsn}</v> + <v> Vsn = term()</v> + <v>OldState = NewState = term()</v> + <v>Extra = term()</v> + <v>Result = {ok,{NewState,NewStateData}} | Reason</v> + <v>OldState = NewState = + <seealso marker="#type-state">state()</seealso> + </v> + <v>OldStateData = NewStateData = + <seealso marker="#type-state_data">state_data()</seealso> + </v> + <v>Reason = term()</v> + </type> + <desc> + <p>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 <c>{update,Module,Change,...}</c> + where <c>Change={advanced,Extra}</c> is given in + the <c>appup</c> file. See + <seealso marker="doc/design_principles:release_handling#instr"> + OTP Design Principles + </seealso> + for more information. + </p> + <p>In the case of an upgrade, <c>OldVsn</c> is <c>Vsn</c>, and + in the case of a downgrade, <c>OldVsn</c> is + <c>{down,Vsn}</c>. <c>Vsn</c> is defined by the <c>vsn</c> + attribute(s) of the old version of the callback module + <c>Module</c>. If no such attribute is defined, the version + is the checksum of the BEAM file. + </p> + <p><c>OldState</c> and <c>OldStateData</c> is the internal state + of the gen_statem. + </p> + <p><c>Extra</c> is passed as-is from the <c>{advanced,Extra}</c> + part of the update instruction. + </p> + <p>If successful, the function shall return the updated + internal state in an + <c>{ok,{NewState,NewStateData}}</c> tuple. + </p> + <p>If the function returns <c>Reason</c>, the ongoing + upgrade will fail and roll back to the old release.</p> + </desc> + </func> + + <func> + <name>Module:format_status(Opt, [PDict,State,StateData]) -> + Status + </name> + <fsummary>Optional function for providing a term describing the + current gen_statem status</fsummary> + <type> + <v>Opt = normal | terminate</v> + <v>PDict = [{Key, Value}]</v> + <v>State = + <seealso marker="#type-state">state()</seealso> + </v> + <v>StateData = + <seealso marker="#type-state_data">state_data()</seealso> + </v> + <v>Key = term()</v> + <v>Value = term()</v> + <v>Status = term()</v> + </type> + <desc> + <note> + <p>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. + </p> + </note> + <p>This function is called by a gen_statem process when:</p> + <list type="bulleted"> + <item>One of + <seealso marker="sys#get_status/1"> + <c>sys:get_status/1,2</c> + </seealso> + is invoked to get the gen_statem status. <c>Opt</c> is set + to the atom <c>normal</c> for this case. + </item> + <item>The gen_statem terminates abnormally and logs an error. + <c>Opt</c> is set to the atom <c>terminate</c> for this case. + </item> + </list> + <p>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 + <seealso marker="sys#get_status/1"> + <c>sys:get_status/1,2</c> + </seealso> return value as well as how + its status appears in termination error logs exports an + instance of <c>format_status/2</c> that returns a term + describing the current status of the gen_statem. + </p> + <p><c>PDict</c> is the current value of the gen_statem's + process dictionary. + </p> + <p><seealso marker="#type-state"><c>State</c></seealso> + is the internal state of the gen_statem. + </p> + <p>The function should return <c>Status</c>, a term that + customises the details of the current state and status of + the gen_statem. There are no restrictions on the + form <c>Status</c> can take, but for the + <seealso marker="sys#get_status/1"> + <c>sys:get_status/1,2</c> + </seealso> case (when <c>Opt</c> + is <c>normal</c>), the recommended form for + the <c>Status</c> value is <c>[{data, [{"State", + Term}]}]</c> where <c>Term</c> 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 + <seealso marker="sys#get_status/1"> + <c>sys:get_status/1,2</c> + </seealso> return value. + </p> + <p>One use for this function is to return compact alternative + state representations to avoid having large state terms + printed in logfiles. + </p> + </desc> + </func> + + </funcs> + + <section> + <title>SEE ALSO</title> + <p><seealso marker="gen_event">gen_event</seealso>, + <seealso marker="gen_fsm">gen_fsm</seealso>, + <seealso marker="gen_server">gen_server</seealso>, + <seealso marker="supervisor">supervisor</seealso>, + <seealso marker="proc_lib">proc_lib</seealso>, + <seealso marker="sys">sys</seealso></p> + </section> +</erlref> 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 @@ <application xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>1996</year><year>2015</year> + <year>1996</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -66,6 +66,7 @@ <xi:include href="gen_event.xml"/> <xi:include href="gen_fsm.xml"/> <xi:include href="gen_server.xml"/> + <xi:include href="gen_statem.xml"/> <xi:include href="io.xml"/> <xi:include href="io_lib.xml"/> <xi:include href="lib.xml"/> 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 @@ <xi:include href="../specs/specs_gen_event.xml"/> <xi:include href="../specs/specs_gen_fsm.xml"/> <xi:include href="../specs/specs_gen_server.xml"/> + <xi:include href="../specs/specs_gen_statem.xml"/> <xi:include href="../specs/specs_io.xml"/> <xi:include href="../specs/specs_io_lib.xml"/> <xi:include href="../specs/specs_lib.xml"/> 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]. |