aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib
diff options
context:
space:
mode:
authorRaimo Niskanen <[email protected]>2015-10-26 11:52:17 +0100
committerRaimo Niskanen <[email protected]>2016-02-09 10:07:56 +0100
commit6ace96d3e5c9ac8ace3d8967bcafb3e6a081d9be (patch)
tree2a5dc8326bf0a52a23ac3c00de0ea365d91866e4 /lib/stdlib
parentadcc726c36555434204dd0fccd13ed984741a7fb (diff)
downloadotp-6ace96d3e5c9ac8ace3d8967bcafb3e6a081d9be.tar.gz
otp-6ace96d3e5c9ac8ace3d8967bcafb3e6a081d9be.tar.bz2
otp-6ace96d3e5c9ac8ace3d8967bcafb3e6a081d9be.zip
New state machine
Diffstat (limited to 'lib/stdlib')
-rw-r--r--lib/stdlib/doc/src/Makefile3
-rw-r--r--lib/stdlib/doc/src/gen_statem.xml1131
-rw-r--r--lib/stdlib/doc/src/ref_man.xml3
-rw-r--r--lib/stdlib/doc/src/specs.xml1
-rw-r--r--lib/stdlib/src/Makefile3
-rw-r--r--lib/stdlib/src/gen_statem.erl1095
-rw-r--r--lib/stdlib/src/proc_lib.erl16
-rw-r--r--lib/stdlib/src/stdlib.app.src3
-rw-r--r--lib/stdlib/test/Makefile1
-rw-r--r--lib/stdlib/test/error_logger_forwarder.erl8
-rw-r--r--lib/stdlib/test/gen_statem_SUITE.erl1250
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>&nbsp;| {ok,State,StateData,StateOps}</v>
+ <v>&nbsp;| {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>&nbsp;&nbsp;| {NewState,NewStateData}</v>
+ <d>&nbsp;&nbsp;The same as <c>{NewState,NewStateData,[]}</c></d>
+ <v>&nbsp;&nbsp;| {NewStateData}</v>
+ <d>&nbsp;&nbsp;The same as <c>{State,NewStateData,[retry]}</c></d>
+ <v>&nbsp;&nbsp;| {}</v>
+ <d>&nbsp;&nbsp;The same as <c>{State,StateData,[]}</c></d>
+ <v>&nbsp;&nbsp;| StateOps</v>
+ <d>&nbsp;&nbsp;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>&nbsp;&nbsp;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].