aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib
diff options
context:
space:
mode:
authorRaimo Niskanen <[email protected]>2016-09-30 18:00:38 +0200
committerRaimo Niskanen <[email protected]>2016-10-12 11:27:34 +0200
commit77e175589b0ee3c1a4c94aef3cdcdf54cd84c53c (patch)
treec1f5fa31d25e4e3f8974448f131f980a798bfbeb /lib/stdlib
parent800265f49f912dcf66846b13aa8032bf2f380caf (diff)
downloadotp-77e175589b0ee3c1a4c94aef3cdcdf54cd84c53c.tar.gz
otp-77e175589b0ee3c1a4c94aef3cdcdf54cd84c53c.tar.bz2
otp-77e175589b0ee3c1a4c94aef3cdcdf54cd84c53c.zip
Implement state timeouts
Diffstat (limited to 'lib/stdlib')
-rw-r--r--lib/stdlib/doc/src/gen_statem.xml105
-rw-r--r--lib/stdlib/src/gen_statem.erl464
-rw-r--r--lib/stdlib/test/gen_statem_SUITE.erl80
3 files changed, 440 insertions, 209 deletions
diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml
index bba2de5e77..c0631c8448 100644
--- a/lib/stdlib/doc/src/gen_statem.xml
+++ b/lib/stdlib/doc/src/gen_statem.xml
@@ -527,7 +527,8 @@ handle_event(_, _, State, Data) ->
Type <c>info</c> originates from regular process messages sent
to the <c>gen_statem</c>. Also, the state machine
implementation can generate events of types
- <c>timeout</c>, <c>enter</c> and <c>internal</c> to itself.
+ <c>timeout</c>, <c>state_timeout</c>, <c>enter</c>,
+ and <c>internal</c> to itself.
</p>
</desc>
</datatype>
@@ -657,8 +658,7 @@ handle_event(_, _, State, Data) ->
All events stored with
<seealso marker="#type-action"><c>action()</c></seealso>
<c>next_event</c>
- are inserted in the queue to be processed before
- other events.
+ are inserted to be processed before the other queued events.
</p>
</item>
<item>
@@ -668,35 +668,36 @@ handle_event(_, _, State, Data) ->
are used, the <c>gen_statem</c> calls
the new state function with arguments
<seealso marker="#type-state_enter">(enter, OldState, Data)</seealso>.
- If this call returns any
+ Any
<seealso marker="#type-enter_action"><c>actions</c></seealso>
- that sets transition options
- they are merged with the current
- That is: <c>hibernate</c> and <c>timeout</c> overrides
- the current and <c>reply</c> sends a reply.
- This has the same effect as if you would have appended
- the actions from this state enter call to the actions
+ returned from this call are handled as if they were
+ appended to the actions
returned by the state function that changed states.
</p>
</item>
<item>
<p>
- If an
- <seealso marker="#type-event_timeout"><c>event_timeout()</c></seealso>
- is set through
- <seealso marker="#type-action"><c>action()</c></seealso>
- <c>timeout</c>,
- an event timer is started if the value is less than
- <c>infinity</c> or a time-out zero event
- is enqueued if the value is zero.
+ If there are enqueued events the (possibly new)
+ <seealso marker="#state_function">state function</seealso>
+ is called with the oldest enqueued event,
+ and we start again from the top of this list.
</p>
</item>
<item>
<p>
- The (possibly new)
+ Timeout timers
+ <seealso marker="#type-state_timeout"><c>state_timeout()</c></seealso>
+ and
+ <seealso marker="#type-event_timeout"><c>event_timeout()</c></seealso>
+ are handled. This may lead to a time-out zero event
+ being generated to the
<seealso marker="#state_function">state function</seealso>
- is called with the oldest enqueued event if there is any,
- otherwise the <c>gen_statem</c> goes into <c>receive</c>
+ and we start again from the top of this list.
+ </p>
+ </item>
+ <item>
+ <p>
+ Otherwise the <c>gen_statem</c> goes into <c>receive</c>
or hibernation
(if
<seealso marker="#type-hibernate"><c>hibernate()</c></seealso>
@@ -704,8 +705,11 @@ handle_event(_, _, State, Data) ->
to wait for the next message. In hibernation the next
non-system event awakens the <c>gen_statem</c>, or rather
the next incoming message awakens the <c>gen_statem</c>,
- but if it is a system event
- it goes right back into hibernation.
+ but if it is a system event it goes right back into hibernation.
+ When a new message arrives the
+ <seealso marker="#state_function">state function</seealso>
+ is called with the corresponding event,
+ and we start again from the top of this list.
</p>
</item>
</list>
@@ -747,20 +751,20 @@ handle_event(_, _, State, Data) ->
<seealso marker="#type-event_type"><c>event_type()</c></seealso>
<c>timeout</c>
after this time (in milliseconds) unless another
- event arrives in which case this time-out is cancelled.
- Notice that a retried or inserted event
- counts like a new in this respect.
+ event arrives or has arrived
+ in which case this time-out is cancelled.
+ Note that a retried, inserted or state time-out zero
+ events counts as arrived.
</p>
<p>
If the value is <c>infinity</c>, no timer is started, as
- it never triggers anyway.
+ it never would trigger anyway.
</p>
<p>
- If the value is <c>0</c>, the time-out event is immediately enqueued
- unless there already are enqueued events, as the
- time-out is then immediately cancelled.
- This is a feature ensuring that a time-out <c>0</c> event
- is processed before any not yet received external event.
+ If the value is <c>0</c> no timer is actually started,
+ instead the the time-out event is enqueued to ensure
+ that it gets processed before any not yet
+ received external event.
</p>
<p>
Note that it is not possible or needed to cancel this time-out,
@@ -769,6 +773,34 @@ handle_event(_, _, State, Data) ->
</desc>
</datatype>
<datatype>
+ <name name="state_timeout"/>
+ <desc>
+ <p>
+ Generates an event of
+ <seealso marker="#type-event_type"><c>event_type()</c></seealso>
+ <c>state_timeout</c>
+ after this time (in milliseconds) unless the <c>gen_statem</c>
+ changes states (<c>NewState =/= OldState</c>)
+ which case this time-out is cancelled.
+ </p>
+ <p>
+ If the value is <c>infinity</c>, no timer is started, as
+ it never would trigger anyway.
+ </p>
+ <p>
+ If the value is <c>0</c> no timer is actually started,
+ instead the the time-out event is enqueued to ensure
+ that it gets processed before any not yet
+ received external event.
+ </p>
+ <p>
+ Setting this timer while it is running will restart it with
+ the new time-out value. Therefore it is possible to cancel
+ this timeout by setting it to <c>infinity</c>.
+ </p>
+ </desc>
+ </datatype>
+ <datatype>
<name name="action"/>
<desc>
<p>
@@ -886,6 +918,15 @@ handle_event(_, _, State, Data) ->
to <c><anno>Time</anno></c> with <c><anno>EventContent</anno></c>.
</p>
</item>
+ <tag><c>state_timeout</c></tag>
+ <item>
+ <p>
+ Sets the
+ <seealso marker="#type-transition_option"><c>transition_option()</c></seealso>
+ <seealso marker="#type-state_timeout"><c>state_timeout()</c></seealso>
+ to <c><anno>Time</anno></c> with <c><anno>EventContent</anno></c>.
+ </p>
+ </item>
</taglist>
</desc>
</datatype>
diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl
index 9f5573af86..bc33be22a2 100644
--- a/lib/stdlib/src/gen_statem.erl
+++ b/lib/stdlib/src/gen_statem.erl
@@ -75,7 +75,7 @@
-type event_type() ::
{'call',From :: from()} | 'cast' |
- 'info' | 'timeout' | 'internal'.
+ 'info' | 'timeout' | 'state_timeout' | 'internal'.
-type callback_mode_result() ::
callback_mode() | [callback_mode() | state_enter()].
@@ -95,6 +95,10 @@
%% Generate a ('timeout', EventContent, ...) event after Time
%% unless some other event is delivered
Time :: timeout().
+-type state_timeout() ::
+ %% Generate a ('state_timeout', EventContent, ...) event after Time
+ %% unless the state is changed
+ Time :: timeout().
-type action() ::
%% During a state change:
@@ -126,8 +130,10 @@
{'hibernate', Hibernate :: hibernate()} |
%%
(Timeout :: event_timeout()) | % {timeout,Timeout}
- {'timeout', % Set the event timeout option
+ {'timeout', % Set the event_timeout option
Time :: event_timeout(), EventContent :: term()} |
+ {'state_timeout', % Set the state_timeout option
+ Time :: state_timeout(), EventContent :: term()} |
%%
reply_action().
-type reply_action() ::
@@ -593,7 +599,8 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) ->
%% The values should already have been type checked
Name = gen:get_proc_name(Server),
Debug = gen:debug_options(Name, Opts),
- P = Events = [],
+ Events = [],
+ P = [],
Event = {internal,init_state},
%% We enforce {postpone,false} to ensure that
%% our fake Event gets discarded, thought it might get logged
@@ -609,9 +616,12 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) ->
state_enter => false,
module => Module,
name => Name,
+ state => State,
+ data => Data,
+ postponed => P,
%% The rest of the fields are set from to the arguments to
- %% loop_event_actions/10 when it finally loops back to loop/3
- %% in loop_events_done/8
+ %% loop_event_actions/9 when it finally loops back to loop/3
+ %% in loop_events_done/9
%%
%% Marker for initial state, cleared immediately when used
init_state => true
@@ -619,13 +629,14 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) ->
NewDebug = sys_debug(Debug, S, State, {enter,Event,State}),
case call_callback_mode(S) of
{ok,NewS} ->
+ StateTimer = undefined,
loop_event_actions(
- Parent, NewDebug, NewS, Events,
- State, Data, P, Event, State, NewActions);
+ Parent, NewDebug, NewS, StateTimer,
+ Events, Event, State, Data, NewActions);
{Class,Reason,Stacktrace} ->
terminate(
Class, Reason, Stacktrace,
- NewDebug, S, [Event|Events], State, Data, P)
+ NewDebug, S, [Event|Events])
end.
%%%==========================================================================
@@ -647,7 +658,9 @@ init_it(Starter, Parent, ServerRef, Module, Args, Opts) ->
proc_lib:init_ack(Starter, {error,Reason}),
error_info(
Class, Reason, Stacktrace,
- #{name => Name, callback_mode => undefined},
+ #{name => Name,
+ callback_mode => undefined,
+ state_enter => false},
[], [], undefined),
erlang:raise(Class, Reason, Stacktrace)
end.
@@ -678,7 +691,9 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) ->
proc_lib:init_ack(Starter, {error,Error}),
error_info(
error, Error, ?STACKTRACE(),
- #{name => Name, callback_mode => undefined},
+ #{name => Name,
+ callback_mode => undefined,
+ state_enter => false},
[], [], undefined),
exit(Error)
end.
@@ -689,12 +704,10 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) ->
system_continue(Parent, Debug, S) ->
loop(Parent, Debug, S).
-system_terminate(
- Reason, _Parent, Debug,
- #{state := State, data := Data, postponed := P} = S) ->
+system_terminate(Reason, _Parent, Debug, S) ->
terminate(
exit, Reason, ?STACKTRACE(),
- Debug, S, [], State, Data, P).
+ Debug, S, []).
system_code_change(
#{module := Module,
@@ -731,7 +744,7 @@ system_replace_state(
format_status(
Opt,
[PDict,SysState,Parent,Debug,
- #{name := Name, postponed := P, state := State, data := Data} = S]) ->
+ #{name := Name, postponed := P} = S]) ->
Header = gen:format_status_header("Status for state machine", Name),
Log = sys:get_debug(log, Debug, []),
[{header,Header},
@@ -740,7 +753,7 @@ format_status(
{"Parent",Parent},
{"Logged Events",Log},
{"Postponed",P}]} |
- case format_status(Opt, PDict, S, State, Data) of
+ case format_status(Opt, PDict, S) of
L when is_list(L) -> L;
T -> [T]
end].
@@ -816,7 +829,8 @@ loop(Parent, Debug, #{hibernate := Hibernate} = S) ->
end.
%% Entry point for wakeup_from_hibernate/3
-loop_receive(Parent, Debug, #{timer := Timer} = S) ->
+loop_receive(
+ Parent, Debug, #{timer := Timer, state_timer := StateTimer} = S) ->
receive
Msg ->
case Msg of
@@ -827,34 +841,23 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) ->
sys:handle_system_msg(
Req, Pid, Parent, ?MODULE, Debug, S, Hibernate);
{'EXIT',Parent,Reason} = EXIT ->
- #{state := State, data := Data, postponed := P} = S,
%% 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(
- exit, Reason, ?STACKTRACE(),
- Debug, S, [EXIT], State, Data, P);
- {timeout,Timer,Content} when Timer =/= undefined ->
+ exit, Reason, ?STACKTRACE(), Debug, S, [EXIT]);
+ {timeout,Timer,Content}
+ when Timer =/= undefined ->
loop_receive_result(
- Parent, Debug, S, {timeout,Content});
+ Parent, Debug, S, StateTimer,
+ {timeout,Content});
+ {timeout,StateTimer,Content}
+ when StateTimer =/= undefined ->
+ loop_receive_result(
+ Parent, Debug, S, undefined,
+ {state_timeout,Content});
_ ->
- %% Cancel Timer if running
- case Timer of
- undefined ->
- ok;
- _ ->
- case erlang:cancel_timer(Timer) of
- TimeLeft when is_integer(TimeLeft) ->
- ok;
- false ->
- receive
- {timeout,Timer,_} ->
- ok
- after 0 ->
- ok
- end
- end
- end,
+ cancel_timer(Timer),
Event =
case Msg of
{'$gen_call',From,Request} ->
@@ -864,71 +867,93 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) ->
_ ->
{info,Msg}
end,
- loop_receive_result(Parent, Debug, S, Event)
+ loop_receive_result(
+ Parent, Debug, S, StateTimer, Event)
end
end.
-loop_receive_result(
- Parent, Debug,
- #{state := State,
- data := Data,
- postponed := P} = S,
- Event) ->
- %% The engine state map S is now dismantled
- %% and will not be restored until we return to loop/3.
- %%
- %% The fields 'callback_mode', 'module', and 'name' are still valid.
- %% The fields 'state', 'data', and 'postponed' are held in arguments.
- %% The fields 'timer' and 'hibernate' will be recalculated.
+loop_receive_result(Parent, Debug, #{state := State} = S, StateTimer, Event) ->
+ %% The fields 'timer', 'state_timer' and 'hibernate'
+ %% are now invalid in state map S - they will be recalculated
+ %% and restored when we return to loop/3
%%
NewDebug = sys_debug(Debug, S, State, {in,Event}),
%% Here the queue of not yet handled events is created
Events = [],
Hibernate = false,
- loop_event(
- Parent, NewDebug, S, Events, State, Data, P, Event, Hibernate).
+ loop_event(Parent, NewDebug, S, StateTimer, Events, Event, Hibernate).
%% Process the event queue, or if it is empty
%% loop back to loop/3 to receive a new event
loop_events(
- Parent, Debug, S, [Event|Events],
- State, Data, P, Hibernate, _Timeout) ->
+ Parent, Debug, S, StateTimeout,
+ [Event|Events], _Timeout, State, Data, P, Hibernate) ->
%%
- %% If there was a state timer requested we just ignore that
+ %% If there was an event timer requested we just ignore that
%% since we have events to handle which cancels the timer
loop_event(
- Parent, Debug, S, Events, State, Data, P, Event, Hibernate);
+ Parent, Debug, S, StateTimeout,
+ Events, Event, State, Data, P, Hibernate);
+loop_events(
+ Parent, Debug, S, {state_timeout,Time,EventContent},
+ [] = Events, Timeout, State, Data, P, Hibernate) ->
+ if
+ Time =:= 0 ->
+ %% Simulate an immediate timeout
+ %% so we do not get the timeout message
+ %% after any received event
+ %%
+ %% This faked event will cancel
+ %& any not yet started event timer
+ Event = {state_timeout,EventContent},
+ StateTimer = undefined,
+ loop_event(
+ Parent, Debug, S, StateTimer,
+ Events, Event, State, Data, P, Hibernate);
+ true ->
+ StateTimer = erlang:start_timer(Time, self(), EventContent),
+ loop_events(
+ Parent, Debug, S, StateTimer,
+ Events, Timeout, State, Data, P, Hibernate)
+ end;
loop_events(
- Parent, Debug, S, [],
- State, Data, P, Hibernate, Timeout) ->
+ Parent, Debug, S, StateTimer,
+ [] = Events, Timeout, State, Data, P, Hibernate) ->
case Timeout of
{timeout,0,EventContent} ->
- %% Immediate timeout - simulate it
+ %% Simulate an immediate timeout
%% so we do not get the timeout message
%% after any received event
+ %%
+ Event = {timeout,EventContent},
loop_event(
- Parent, Debug, S, [],
- State, Data, P, {timeout,EventContent}, Hibernate);
+ Parent, Debug, S, StateTimer,
+ Events, Event, State, Data, P, Hibernate);
{timeout,Time,EventContent} ->
- %% Actually start a timer
Timer = erlang:start_timer(Time, self(), EventContent),
loop_events_done(
- Parent, Debug, S, Timer, State, Data, P, Hibernate);
+ Parent, Debug, S, StateTimer,
+ State, Data, P, Hibernate, Timer);
undefined ->
- %% No state timeout has been requested
+ %% No event timeout has been requested
Timer = undefined,
loop_events_done(
- Parent, Debug, S, Timer, State, Data, P, Hibernate)
+ Parent, Debug, S, StateTimer,
+ State, Data, P, Hibernate, Timer)
end.
-%%
-loop_events_done(Parent, Debug, S, Timer, State, Data, P, Hibernate) ->
+
+%% Back to the top
+loop_events_done(
+ Parent, Debug, S, StateTimer,
+ State, Data, P, Hibernate, Timer) ->
NewS =
S#{
- state => State,
- data => Data,
- postponed => P,
+ state := State,
+ data := Data,
+ postponed := P,
hibernate => Hibernate,
- timer => Timer},
+ timer => Timer,
+ state_timer => StateTimer},
loop(Parent, Debug, NewS).
@@ -936,10 +961,10 @@ loop_events_done(Parent, Debug, S, Timer, State, Data, P, Hibernate) ->
call_callback_mode(#{module := Module} = S) ->
try Module:callback_mode() of
CallbackMode ->
- call_callback_mode_result(S, CallbackMode)
+ callback_mode_result(S, CallbackMode)
catch
CallbackMode ->
- call_callback_mode_result(S, CallbackMode);
+ callback_mode_result(S, CallbackMode);
error:undef ->
%% Process undef to check for the simple mistake
%% of calling a nonexistent state function
@@ -957,7 +982,7 @@ call_callback_mode(#{module := Module} = S) ->
{Class,Reason,erlang:get_stacktrace()}
end.
-call_callback_mode_result(S, CallbackMode) ->
+callback_mode_result(S, CallbackMode) ->
case
parse_callback_mode(
if
@@ -1060,15 +1085,26 @@ call_state_function(
{Class,Reason,erlang:get_stacktrace()}
end.
+%% Update S and continue
loop_event(
- Parent, Debug, S, Events,
- State, Data, P, {Type,Content} = Event, Hibernate) ->
+ Parent, Debug, S, StateTimer,
+ Events, Event, State, Data, P, Hibernate) ->
+ NewS =
+ S#{
+ state := State,
+ data := Data,
+ postponed := P},
+ loop_event(Parent, Debug, NewS, StateTimer, Events, Event, Hibernate).
+
+loop_event(
+ Parent, Debug, #{state := State, data := Data} = S, StateTimer,
+ Events, {Type,Content} = Event, Hibernate) ->
%%
%% If Hibernate is true here it can only be
%% because it was set from an event action
%% and we did not go into hibernation since there
%% were events in queue, so we do what the user
- %% might depend on i.e collect garbage which
+ %% might rely on i.e collect garbage which
%% would have happened if we actually hibernated
%% and immediately was awakened
Hibernate andalso garbage_collect(),
@@ -1076,45 +1112,40 @@ loop_event(
{ok,Result,NewS} ->
{NewData,NextState,Actions} =
parse_event_result(
- Parent, Debug, NewS, Events,
- State, Data, P, Event,
- Result, true),
+ true, Debug, NewS, Result,
+ Events, Event, State, Data),
loop_event_actions(
- Parent, Debug, S, Events,
- State, NewData, P, Event, NextState, Actions);
+ Parent, Debug, S, StateTimer,
+ Events, Event, NextState, NewData, Actions);
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace,
- Debug, S, [Event|Events], State, Data, P)
+ Class, Reason, Stacktrace, Debug, S, [Event|Events])
end.
%% Interpret all callback return variants
parse_event_result(
- _Parent, Debug, S, Events, State, Data, P, Event,
- Result, AllowStateChange) ->
+ AllowStateChange, Debug, S, Result, Events, Event, State, Data) ->
case Result of
stop ->
terminate(
- exit, normal, ?STACKTRACE(),
- Debug, S, [Event|Events], State, Data, P);
+ exit, normal, ?STACKTRACE(), Debug, S, [Event|Events]);
{stop,Reason} ->
terminate(
- exit, Reason, ?STACKTRACE(),
- Debug, S, [Event|Events], State, Data, P);
+ exit, Reason, ?STACKTRACE(), Debug, S, [Event|Events]);
{stop,Reason,NewData} ->
terminate(
exit, Reason, ?STACKTRACE(),
- Debug, S, [Event|Events], State, NewData, P);
+ Debug, S#{data := NewData}, [Event|Events]);
{stop_and_reply,Reason,Replies} ->
Q = [Event|Events],
reply_then_terminate(
exit, Reason, ?STACKTRACE(),
- Debug, S, Q, State, Data, P, Replies);
+ Debug, S, Q, Replies);
{stop_and_reply,Reason,Replies,NewData} ->
Q = [Event|Events],
reply_then_terminate(
exit, Reason, ?STACKTRACE(),
- Debug, S, Q, State, NewData, P, Replies);
+ Debug, S#{data := NewData}, Q, Replies);
{next_state,State,NewData} ->
{NewData,State,[]};
{next_state,NextState,NewData} when AllowStateChange ->
@@ -1136,31 +1167,35 @@ parse_event_result(
error,
{bad_return_from_state_function,Result},
?STACKTRACE(),
- Debug, S, [Event|Events], State, Data, P)
+ Debug, S, [Event|Events])
end.
-parse_enter_actions(Debug, S, State, Actions, Hibernate, Timeout) ->
+parse_enter_actions(
+ Debug, S, State, Actions,
+ Hibernate, Timeout, StateTimeout) ->
Postpone = forbidden,
NextEvents = forbidden,
parse_actions(
Debug, S, State, listify(Actions),
- Hibernate, Timeout, Postpone, NextEvents).
+ Hibernate, Timeout, StateTimeout, Postpone, NextEvents).
parse_actions(Debug, S, State, Actions) ->
- Postpone = false,
Hibernate = false,
Timeout = undefined,
+ StateTimeout = undefined,
+ Postpone = false,
NextEvents = [],
parse_actions(
Debug, S, State, listify(Actions),
- Hibernate, Timeout, Postpone, NextEvents).
+ Hibernate, Timeout, StateTimeout, Postpone, NextEvents).
%%
parse_actions(
- Debug, _S, _State, [], Hibernate, Timeout, Postpone, NextEvents) ->
- {ok,Debug,Hibernate,Timeout,Postpone,NextEvents};
+ Debug, _S, _State, [],
+ Hibernate, Timeout, StateTimeout, Postpone, NextEvents) ->
+ {ok,Debug,Hibernate,Timeout,StateTimeout,Postpone,NextEvents};
parse_actions(
Debug, S, State, [Action|Actions],
- Hibernate, Timeout, Postpone, NextEvents) ->
+ Hibernate, Timeout, StateTimeout, Postpone, NextEvents) ->
case Action of
%% Actual actions
{reply,From,Reply} ->
@@ -1169,7 +1204,8 @@ parse_actions(
NewDebug = do_reply(Debug, S, State, From, Reply),
parse_actions(
NewDebug, S, State, Actions,
- Hibernate, Timeout, Postpone, NextEvents);
+ Hibernate, Timeout, StateTimeout,
+ Postpone, NextEvents);
false ->
{error,
{bad_action_from_state_function,Action},
@@ -1179,7 +1215,7 @@ parse_actions(
{hibernate,NewHibernate} when is_boolean(NewHibernate) ->
parse_actions(
Debug, S, State, Actions,
- NewHibernate, Timeout, Postpone, NextEvents);
+ NewHibernate, Timeout, StateTimeout, Postpone, NextEvents);
{hibernate,_} ->
{error,
{bad_action_from_state_function,Action},
@@ -1187,15 +1223,25 @@ parse_actions(
hibernate ->
parse_actions(
Debug, S, State, Actions,
- true, Timeout, Postpone, NextEvents);
+ true, Timeout, StateTimeout, Postpone, NextEvents);
+ {state_timeout,Time,_} = NewStateTimeout
+ when is_integer(Time), Time >= 0;
+ Time =:= infinity ->
+ parse_actions(
+ Debug, S, State, Actions,
+ Hibernate, Timeout, NewStateTimeout, Postpone, NextEvents);
+ {state_timeout,_,_} ->
+ {error,
+ {bad_action_from_state_function,Action},
+ ?STACKTRACE()};
{timeout,infinity,_} -> % Clear timer - it will never trigger
parse_actions(
Debug, S, State, Actions,
- Hibernate, undefined, Postpone, NextEvents);
+ Hibernate, undefined, StateTimeout, Postpone, NextEvents);
{timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 ->
parse_actions(
Debug, S, State, Actions,
- Hibernate, NewTimeout, Postpone, NextEvents);
+ Hibernate, NewTimeout, StateTimeout, Postpone, NextEvents);
{timeout,_,_} ->
{error,
{bad_action_from_state_function,Action},
@@ -1203,17 +1249,17 @@ parse_actions(
infinity -> % Clear timer - it will never trigger
parse_actions(
Debug, S, State, Actions,
- Hibernate, undefined, Postpone, NextEvents);
+ Hibernate, undefined, StateTimeout, Postpone, NextEvents);
Time when is_integer(Time), Time >= 0 ->
NewTimeout = {timeout,Time,Time},
parse_actions(
Debug, S, State, Actions,
- Hibernate, NewTimeout, Postpone, NextEvents);
+ Hibernate, NewTimeout, StateTimeout, Postpone, NextEvents);
{postpone,NewPostpone}
when is_boolean(NewPostpone), Postpone =/= forbidden ->
parse_actions(
Debug, S, State, Actions,
- Hibernate, Timeout, NewPostpone, NextEvents);
+ Hibernate, Timeout, StateTimeout, NewPostpone, NextEvents);
{postpone,_} ->
{error,
{bad_action_from_state_function,Action},
@@ -1221,7 +1267,7 @@ parse_actions(
postpone when Postpone =/= forbidden ->
parse_actions(
Debug, S, State, Actions,
- Hibernate, Timeout, true, NextEvents);
+ Hibernate, Timeout, StateTimeout, true, NextEvents);
{next_event,Type,Content} ->
case event_type(Type) of
true when NextEvents =/= forbidden ->
@@ -1229,8 +1275,8 @@ parse_actions(
sys_debug(Debug, S, State, {in,{Type,Content}}),
parse_actions(
NewDebug, S, State, Actions,
- Hibernate, Timeout, Postpone,
- [{Type,Content}|NextEvents]);
+ Hibernate, Timeout, StateTimeout,
+ Postpone, [{Type,Content}|NextEvents]);
_ ->
{error,
{bad_action_from_state_function,Action},
@@ -1243,94 +1289,143 @@ parse_actions(
end.
loop_event_actions(
- Parent, Debug, #{state_enter := StateEnter} = S, Events,
- State, NewData, P, Event, NextState, Actions) ->
+ Parent, Debug,
+ #{state := State, state_enter := StateEnter} = S, StateTimer,
+ Events, Event, NextState, NewData, Actions) ->
case parse_actions(Debug, S, State, Actions) of
- {ok,NewDebug,Hibernate,Timeout,Postpone,NextEvents} ->
- case
- StateEnter andalso
- ((NextState =/= State)
- orelse maps:is_key(init_state, S)) of
- true ->
+ {ok,NewDebug,Hibernate,Timeout,StateTimeout,Postpone,NextEvents} ->
+ if
+ StateEnter, NextState =/= State ->
loop_event_enter(
- Parent, NewDebug, S, Events,
- State, NewData, P, Event, NextState,
- Hibernate, Timeout, Postpone, NextEvents);
- false ->
+ Parent, NewDebug, S, StateTimer,
+ Events, Event, NextState, NewData,
+ Hibernate, Timeout, StateTimeout, Postpone, NextEvents);
+ StateEnter ->
+ case maps:is_key(init_state, S) of
+ true ->
+ %% Avoid infinite loop in initial state
+ %% with state entry events
+ NewS = maps:remove(init_state, S),
+ loop_event_enter(
+ Parent, NewDebug, NewS, StateTimer,
+ Events, Event, NextState, NewData,
+ Hibernate, Timeout, StateTimeout,
+ Postpone, NextEvents);
+ false ->
+ loop_event_result(
+ Parent, NewDebug, S, StateTimer,
+ Events, Event, NextState, NewData,
+ Hibernate, Timeout, StateTimeout,
+ Postpone, NextEvents)
+ end;
+ true ->
loop_event_result(
- Parent, NewDebug, S, Events,
- State, NewData, P, Event, NextState,
- Hibernate, Timeout, Postpone, NextEvents)
+ Parent, NewDebug, S, StateTimer,
+ Events, Event, NextState, NewData,
+ Hibernate, Timeout, StateTimeout, Postpone, NextEvents)
end;
{Class,Reason,Stacktrace} ->
terminate(
Class, Reason, Stacktrace,
- Debug, S, [Event|Events], State, NewData, P)
+ Debug, S#{data := NewData}, [Event|Events])
end.
loop_event_enter(
- Parent, Debug, S, Events,
- State, NewData, P, Event, NextState,
- Hibernate, Timeout, Postpone, NextEvents) ->
+ Parent, Debug, #{state := State} = S, StateTimer,
+ Events, Event, NextState, NewData,
+ Hibernate, Timeout, StateTimeout, Postpone, NextEvents) ->
case call_state_function(S, enter, State, NextState, NewData) of
{ok,Result,NewS} ->
{NewerData,_,Actions} =
parse_event_result(
- Parent, Debug, NewS, Events,
- NextState, NewData, P, Event,
- Result, false),
+ false, Debug, NewS, Result,
+ Events, Event, NextState, NewData),
loop_event_enter_actions(
- Parent, Debug, NewS, Events,
- State, NewerData, P, Event, NextState,
- Hibernate, Timeout, Postpone, NextEvents, Actions);
+ Parent, Debug, NewS, StateTimer,
+ Events, Event, NextState, NewerData,
+ Hibernate, Timeout, StateTimeout, Postpone, NextEvents, Actions);
{Class,Reason,Stacktrace} ->
terminate(
Class, Reason, Stacktrace,
- Debug, S, [Event|Events], NextState, NewData, P)
+ Debug, S#{state := NextState, data := NewData},
+ [Event|Events])
end.
loop_event_enter_actions(
- Parent, Debug, S, Events,
- State, NewData, P, Event, NextState,
- Hibernate, Timeout, Postpone, NextEvents, Actions) ->
+ Parent, Debug, S, StateTimer,
+ Events, Event, NextState, NewData,
+ Hibernate, Timeout, StateTimeout, Postpone, NextEvents, Actions) ->
case
- parse_enter_actions(Debug, S, NextState, Actions, Hibernate, Timeout)
+ parse_enter_actions(
+ Debug, S, NextState, Actions,
+ Hibernate, Timeout, StateTimeout)
of
- {ok,NewDebug,NewHibernate,NewTimeout,_,_} ->
+ {ok,NewDebug,NewHibernate,NewTimeout,NewStateTimeout,_,_} ->
loop_event_result(
- Parent, NewDebug, S, Events,
- State, NewData, P, Event, NextState,
- NewHibernate, NewTimeout, Postpone, NextEvents);
+ Parent, NewDebug, S, StateTimer,
+ Events, Event, NextState, NewData,
+ NewHibernate, NewTimeout, NewStateTimeout, Postpone, NextEvents);
{Class,Reason,Stacktrace} ->
terminate(
Class, Reason, Stacktrace,
- Debug, S, [Event|Events], NextState, NewData, P)
+ Debug, S#{state := NextState, data := NewData},
+ [Event|Events])
end.
loop_event_result(
- Parent, Debug, S, Events,
- State, NewData, P0, Event, NextState,
- Hibernate, Timeout, Postpone, NextEvents) ->
+ Parent, Debug,
+ #{state := State, postponed := P_0} = S, StateTimer,
+ Events, Event, NextState, NewData,
+ Hibernate, Timeout, StateTimeout, Postpone, NextEvents) ->
%%
%% All options have been collected and next_events are buffered.
%% Do the actual state transition.
%%
- P1 = % Move current event to postponed if Postpone
+ NewStateTimeout =
+ case StateTimeout of
+ {state_timeout,Time,_} ->
+ %% New timeout -> cancel timer
+ case StateTimer of
+ {state_timeout,_,_} ->
+ ok;
+ _ ->
+ cancel_timer(StateTimer)
+ end,
+ case Time of
+ infinity ->
+ undefined;
+ _ ->
+ StateTimeout
+ end;
+ undefined when NextState =/= State ->
+ %% State change -> cancel timer
+ case StateTimer of
+ {state_timeout,_,_} ->
+ ok;
+ _ ->
+ cancel_timer(StateTimer)
+ end,
+ undefined;
+ undefined ->
+ StateTimer
+ end,
+ %%
+ P_1 = % Move current event to postponed if Postpone
case Postpone of
true ->
- [Event|P0];
+ [Event|P_0];
false ->
- P0
+ P_0
end,
- {Q2,P} = % Move all postponed events to queue if state change
+ {Events_1,NewP} = % Move all postponed events to queue if state change
if
NextState =:= State ->
- {Events,P1};
+ {Events,P_1};
true ->
- {lists:reverse(P1, Events),[]}
+ {lists:reverse(P_1, Events),[]}
end,
%% Place next events first in queue
- Q = lists:reverse(NextEvents, Q2),
+ NewEvents = lists:reverse(NextEvents, Events_1),
%%
NewDebug =
sys_debug(
@@ -1341,46 +1436,44 @@ loop_event_result(
false ->
{consume,Event,State}
end),
+ %%
loop_events(
- Parent, NewDebug,
- %% Avoid infinite loop in initial state with state entry events
- maps:remove(init_state, S),
- Q, NextState, NewData, P, Hibernate, Timeout).
+ Parent, NewDebug, S, NewStateTimeout,
+ NewEvents, Timeout, NextState, NewData, NewP, Hibernate).
%%---------------------------------------------------------------------------
%% Server helpers
reply_then_terminate(
Class, Reason, Stacktrace,
- Debug, S, Q, State, Data, P, Replies) ->
+ Debug, #{state := State} = S, Q, Replies) ->
if
is_list(Replies) ->
do_reply_then_terminate(
Class, Reason, Stacktrace,
- Debug, S, Q, State, Data, P, Replies);
+ Debug, S, Q, Replies, State);
true ->
do_reply_then_terminate(
Class, Reason, Stacktrace,
- Debug, S, Q, State, Data, P, [Replies])
+ Debug, S, Q, [Replies], State)
end.
%%
do_reply_then_terminate(
- Class, Reason, Stacktrace, Debug, S, Q, State, Data, P, []) ->
- terminate(Class, Reason, Stacktrace, Debug, S, Q, State, Data, P);
+ Class, Reason, Stacktrace, Debug, S, Q, [], _State) ->
+ terminate(Class, Reason, Stacktrace, Debug, S, Q);
do_reply_then_terminate(
- Class, Reason, Stacktrace, Debug, S, Q, State, Data, P, [R|Rs]) ->
+ Class, Reason, Stacktrace, Debug, S, Q, [R|Rs], State) ->
case R of
{reply,{_To,_Tag}=From,Reply} ->
NewDebug = do_reply(Debug, S, State, From, Reply),
do_reply_then_terminate(
- Class, Reason, Stacktrace,
- NewDebug, S, Q, State, Data, P, Rs);
+ Class, Reason, Stacktrace, NewDebug, S, Q, Rs, State);
_ ->
terminate(
error,
{bad_reply_action_from_state_function,R},
?STACKTRACE(),
- Debug, S, Q, State, Data, P)
+ Debug, S, Q)
end.
do_reply(Debug, S, State, From, Reply) ->
@@ -1390,7 +1483,9 @@ do_reply(Debug, S, State, From, Reply) ->
terminate(
Class, Reason, Stacktrace,
- Debug, #{module := Module} = S, Q, State, Data, P) ->
+ Debug,
+ #{module := Module, state := State, data := Data, postponed := P} = S,
+ Q) ->
try Module:terminate(Reason, State, Data) of
_ -> ok
catch
@@ -1399,7 +1494,7 @@ terminate(
ST = erlang:get_stacktrace(),
error_info(
C, R, ST, S, Q, P,
- format_status(terminate, get(), S, State, Data)),
+ format_status(terminate, get(), S)),
sys:print_log(Debug),
erlang:raise(C, R, ST)
end,
@@ -1410,7 +1505,7 @@ terminate(
_ ->
error_info(
Class, Reason, Stacktrace, S, Q, P,
- format_status(terminate, get(), S, State, Data)),
+ format_status(terminate, get(), S)),
sys:print_log(Debug)
end,
case Stacktrace of
@@ -1502,7 +1597,9 @@ error_info(
%% Call Module:format_status/2 or return a default value
-format_status(Opt, PDict, #{module := Module}, State, Data) ->
+format_status(
+ Opt, PDict,
+ #{module := Module, state := State, data := Data}) ->
case erlang:function_exported(Module, format_status, 2) of
true ->
try Module:format_status(Opt, [PDict,State,Data])
@@ -1531,3 +1628,18 @@ listify(Item) when is_list(Item) ->
Item;
listify(Item) ->
[Item].
+
+cancel_timer(undefined) ->
+ ok;
+cancel_timer(TRef) ->
+ case erlang:cancel_timer(TRef) of
+ TimeLeft when is_integer(TimeLeft) ->
+ ok;
+ false ->
+ receive
+ {timeout,TRef,_} ->
+ ok
+ after 0 ->
+ ok
+ end
+ end.
diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl
index 48f93b1de7..28f9ab81fe 100644
--- a/lib/stdlib/test/gen_statem_SUITE.erl
+++ b/lib/stdlib/test/gen_statem_SUITE.erl
@@ -37,7 +37,8 @@ all() ->
{group, stop_handle_event},
{group, abnormal},
{group, abnormal_handle_event},
- shutdown, stop_and_reply, state_enter, event_order, code_change,
+ shutdown, stop_and_reply, state_enter, event_order,
+ state_timeout, code_change,
{group, sys},
hibernate, enter_loop].
@@ -709,6 +710,83 @@ event_order(_Config) ->
+state_timeout(_Config) ->
+ process_flag(trap_exit, true),
+
+ Machine =
+ #{init =>
+ fun () ->
+ {ok,start,0}
+ end,
+ start =>
+ fun
+ ({call,From}, {go,Time}, 0) ->
+ self() ! message_to_self,
+ {next_state, state1, {Time,From},
+ %% Verify that internal events goes before external
+ [{state_timeout,Time,1},
+ {next_event,internal,1}]}
+ end,
+ state1 =>
+ fun
+ (internal, 1, Data) ->
+ %% Verify that a state change cancels timeout 1
+ {next_state, state2, Data,
+ [{timeout,0,2},
+ {state_timeout,0,2},
+ {next_event,internal,2}]}
+ end,
+ state2 =>
+ fun
+ (internal, 2, Data) ->
+ %% Verify that {state_timeout,0,_}
+ %% comes after next_event and that
+ %% {timeout,0,_} is cancelled by
+ %% {state_timeout,0,_}
+ {keep_state, {ok,2,Data},
+ [{timeout,0,3}]};
+ (state_timeout, 2, {ok,2,{Time,From}}) ->
+ {next_state, state3, 3,
+ [{reply,From,ok},
+ {state_timeout,Time,3}]}
+ end,
+ state3 =>
+ fun
+ (info, message_to_self, 3) ->
+ {keep_state, '3'};
+ ({call,From}, check, '3') ->
+ {keep_state, From};
+ (state_timeout, 3, From) ->
+ {stop_and_reply, normal,
+ {reply,From,ok}}
+ end},
+
+ {ok,STM} = gen_statem:start_link(?MODULE, {map_statem,Machine,[]}, []),
+ TRef = erlang:start_timer(1000, self(), kull),
+ ok = gen_statem:call(STM, {go,500}),
+ ok = gen_statem:call(STM, check),
+ receive
+ {timeout,TRef,kull} ->
+ ct:fail(late_timeout)
+ after 0 ->
+ receive
+ {timeout,TRef,kull} ->
+ ok
+ after 1000 ->
+ ct:fail(no_check_timeout)
+ end
+ end,
+ receive
+ {'EXIT',STM,normal} ->
+ ok
+ after 500 ->
+ ct:fail(did_not_stop)
+ end,
+
+ verify_empty_msgq().
+
+
+
sys1(Config) ->
{ok,Pid} = gen_statem:start(?MODULE, start_arg(Config, []), []),
{status, Pid, {module,gen_statem}, _} = sys:get_status(Pid),