aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib
diff options
context:
space:
mode:
authorRaimo Niskanen <[email protected]>2016-10-20 22:28:10 +0200
committerRaimo Niskanen <[email protected]>2016-10-26 10:13:25 +0200
commit0b4deedf278273205c9dcd2ed5d0b4b4d4d8fb9d (patch)
tree59927c90348fbe4d9ea294cb00112aff14193f8e /lib/stdlib
parentf3f2b83e873592bcec47431a787c7cfffdd60685 (diff)
downloadotp-0b4deedf278273205c9dcd2ed5d0b4b4d4d8fb9d.tar.gz
otp-0b4deedf278273205c9dcd2ed5d0b4b4d4d8fb9d.tar.bz2
otp-0b4deedf278273205c9dcd2ed5d0b4b4d4d8fb9d.zip
Rework timeout handling
Handling of timers and timeouts has been cleaned up and generalized. Semantic change regarding state timeout zero: Previously if one state caused a state timeout zero and managed to stay in the same state to insert additional timeout zero(s) in the next state callback invocation, then there would be only one timeout zero event. The mindset was that the machine was faster then the timeout zero. This has changed with the mindset that all state callback invocations should be independent, so now the machine will get one state timeout zero event per started state timeout zero. Note that just using zero timeouts is fairly esoteric...
Diffstat (limited to 'lib/stdlib')
-rw-r--r--lib/stdlib/doc/src/gen_statem.xml66
-rw-r--r--lib/stdlib/src/gen_statem.erl602
-rw-r--r--lib/stdlib/test/gen_statem_SUITE.erl30
3 files changed, 364 insertions, 334 deletions
diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml
index fb1e4e8da2..567130875a 100644
--- a/lib/stdlib/doc/src/gen_statem.xml
+++ b/lib/stdlib/doc/src/gen_statem.xml
@@ -639,6 +639,20 @@ handle_event(_, _, State, Data) ->
</p>
<list type="ordered">
<item>
+ <p>
+ If the state changes or is the initial state, and
+ <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>
+ are used, the <c>gen_statem</c> calls
+ the new state callback with arguments
+ <seealso marker="#type-state_enter">(enter, OldState, Data)</seealso>.
+ Any
+ <seealso marker="#type-enter_action"><c>actions</c></seealso>
+ returned from this call are handled as if they were
+ appended to the actions
+ returned by the state callback that changed states.
+ </p>
+ </item>
+ <item>
<p>
All
<seealso marker="#type-action">actions</seealso>
@@ -668,36 +682,36 @@ handle_event(_, _, State, Data) ->
</p>
</item>
<item>
- <p>
- If the state changes or is the initial state, and
- <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>
- are used, the <c>gen_statem</c> calls
- the new state callback with arguments
- <seealso marker="#type-state_enter">(enter, OldState, Data)</seealso>.
- Any
- <seealso marker="#type-enter_action"><c>actions</c></seealso>
- returned from this call are handled as if they were
- appended to the actions
- returned by the state callback that changed states.
- </p>
- </item>
- <item>
- <p>
- If there are enqueued events the (possibly new)
- <seealso marker="#state callback">state callback</seealso>
- is called with the oldest enqueued event,
- and we start again from the top of this list.
- </p>
- </item>
- <item>
<p>
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
+ are handled. Time-outs with zero time are guaranteed to be
+ delivered to the state machine before any external
+ not yet received event so if there is such a timeout requested,
+ the corresponding time-out zero event is enqueued as
+ the newest event.
+ </p>
+ <p>
+ Any event cancels an
+ <seealso marker="#type-event_timeout"><c>event_timeout()</c></seealso>
+ so a zero time event time-out is only generated
+ if the event queue is empty.
+ </p>
+ <p>
+ A state change cancels a
+ <seealso marker="#type-state_timeout"><c>state_timeout()</c></seealso>
+ and any new transition option of this type
+ belongs to the new state.
+ </p>
+ </item>
+ <item>
+ <p>
+ If there are enqueued events the
<seealso marker="#state callback">state callback</seealso>
+ for the possibly new state
+ is called with the oldest enqueued event,
and we start again from the top of this list.
</p>
</item>
@@ -802,7 +816,7 @@ handle_event(_, _, State, Data) ->
<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>.
+ this time-out by setting it to <c>infinity</c>.
</p>
</desc>
</datatype>
@@ -1130,7 +1144,7 @@ handle_event(_, _, State, Data) ->
<c><anno>Timeout</anno></c> can also be a tuple
<c>{clean_timeout,<anno>T</anno>}</c> or
<c>{dirty_timeout,<anno>T</anno>}</c>, where
- <c><anno>T</anno></c> is the timeout time.
+ <c><anno>T</anno></c> is the time-out time.
<c>{clean_timeout,<anno>T</anno>}</c> works like
just <c>T</c> described in the note above
and uses a proxy process for <c>T &lt; infinity</c>,
diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl
index a314f43b42..c81916197c 100644
--- a/lib/stdlib/src/gen_statem.erl
+++ b/lib/stdlib/src/gen_statem.erl
@@ -85,7 +85,8 @@
-type state_enter() :: 'state_enter'.
-type transition_option() ::
- postpone() | hibernate() | event_timeout().
+ postpone() | hibernate() |
+ event_timeout() | state_timeout().
-type postpone() ::
%% If 'true' postpone the current event
%% and retry it when the state changes (=/=)
@@ -108,7 +109,7 @@
%% * All action()s are executed in order of apperance.
%% * Postponing the current event is performed
%% iff 'postpone' is 'true'.
- %% * A state timer is started iff 'timeout' is set.
+ %% * A state timeout is started iff 'timeout' is set.
%% * Pending events are handled or if there are
%% no pending events the server goes into receive
%% or hibernate (iff 'hibernate' is 'true')
@@ -596,8 +597,8 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) ->
data => Data,
postponed => P,
%% The rest of the fields are set from to the arguments to
- %% loop_event_actions/9 when it finally loops back to loop/3
- %% in loop_events_done/9
+ %% loop_event_actions/10 when it finally loops back to loop/3
+ %% in loop_events/10
%%
%% Marker for initial state, cleared immediately when used
init_state => true
@@ -605,9 +606,10 @@ 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,
+ TimerRefs = #{},
+ TimerTypes = #{},
loop_event_actions(
- Parent, NewDebug, NewS, StateTimer,
+ Parent, NewDebug, NewS, TimerRefs, TimerTypes,
Events, Event, State, Data, NewActions);
{Class,Reason,Stacktrace} ->
terminate(
@@ -806,7 +808,7 @@ loop(Parent, Debug, #{hibernate := Hibernate} = S) ->
%% Entry point for wakeup_from_hibernate/3
loop_receive(
- Parent, Debug, #{timer := Timer, state_timer := StateTimer} = S) ->
+ Parent, Debug, #{timer_refs := TimerRefs, timer_types := TimerTypes} = S) ->
receive
Msg ->
case Msg of
@@ -822,18 +824,23 @@ loop_receive(
%% but this will stand out in the crash report...
terminate(
exit, Reason, ?STACKTRACE(), Debug, S, [EXIT]);
- {timeout,Timer,Content}
- when Timer =/= undefined ->
- loop_receive_result(
- Parent, Debug, S, StateTimer,
- {timeout,Content});
- {timeout,StateTimer,Content}
- when StateTimer =/= undefined ->
- loop_receive_result(
- Parent, Debug, S, undefined,
- {state_timeout,Content});
+ {timeout,TimerRef,TimerMsg} ->
+ case TimerRefs of
+ #{TimerRef := TimerType} ->
+ Event = {TimerType,TimerMsg},
+ %% Unregister the triggered timeout
+ loop_receive_result(
+ Parent, Debug, S,
+ maps:remove(TimerRef, TimerRefs),
+ maps:remove(TimerType, TimerTypes),
+ Event);
+ _ ->
+ Event = {info,Msg},
+ loop_receive_result(
+ Parent, Debug, S,
+ TimerRefs, TimerTypes, Event)
+ end;
_ ->
- cancel_timer(Timer),
Event =
case Msg of
{'$gen_call',From,Request} ->
@@ -844,12 +851,15 @@ loop_receive(
{info,Msg}
end,
loop_receive_result(
- Parent, Debug, S, StateTimer, Event)
+ Parent, Debug, S,
+ TimerRefs, TimerTypes, Event)
end
end.
-loop_receive_result(Parent, Debug, #{state := State} = S, StateTimer, Event) ->
- %% The fields 'timer', 'state_timer' and 'hibernate'
+loop_receive_result(
+ Parent, Debug, #{state := State} = S,
+ TimerRefs, TimerTypes, Event) ->
+ %% The fields 'timer_refs', 'timer_types' and 'hibernate'
%% are now invalid in state map S - they will be recalculated
%% and restored when we return to loop/3
%%
@@ -857,82 +867,197 @@ loop_receive_result(Parent, Debug, #{state := State} = S, StateTimer, Event) ->
%% Here the queue of not yet handled events is created
Events = [],
Hibernate = false,
- loop_event(Parent, NewDebug, S, StateTimer, Events, Event, Hibernate).
+ loop_event(
+ Parent, NewDebug, S, TimerRefs, TimerTypes, 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, StateTimeout,
- [Event|Events], _Timeout, State, Data, P, Hibernate) ->
+%% Entry point for handling an event, received or enqueued
+loop_event(
+ Parent, Debug, #{state := State, data := Data} = S, TimerRefs, TimerTypes,
+ Events, {Type,Content} = Event, Hibernate) ->
%%
- %% 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, 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, StateTimer,
- [] = Events, Timeout, State, Data, P, Hibernate) ->
- case Timeout of
- {timeout,0,EventContent} ->
- %% Simulate an immediate timeout
- %% so we do not get the timeout message
- %% after any received event
- %%
- Event = {timeout,EventContent},
- loop_event(
- Parent, Debug, S, StateTimer,
- Events, Event, State, Data, P, Hibernate);
- {timeout,Time,EventContent} ->
- Timer = erlang:start_timer(Time, self(), EventContent),
- loop_events_done(
- Parent, Debug, S, StateTimer,
- State, Data, P, Hibernate, Timer);
- undefined ->
- %% No event timeout has been requested
- Timer = undefined,
- loop_events_done(
- Parent, Debug, S, StateTimer,
- State, Data, P, Hibernate, Timer)
+ %% 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 rely on i.e collect garbage which
+ %% would have happened if we actually hibernated
+ %% and immediately was awakened
+ Hibernate andalso garbage_collect(),
+ case call_state_function(S, Type, Content, State, Data) of
+ {ok,Result,NewS} ->
+ %% Cancel event timeout
+ {NewTimerRefs,NewTimerTypes} =
+ cancel_timer_by_type(
+ timeout, TimerRefs, TimerTypes),
+ {NewData,NextState,Actions} =
+ parse_event_result(
+ true, Debug, NewS, Result,
+ Events, Event, State, Data),
+ loop_event_actions(
+ Parent, Debug, S, NewTimerRefs, NewTimerTypes,
+ Events, Event, NextState, NewData, Actions);
+ {Class,Reason,Stacktrace} ->
+ terminate(
+ Class, Reason, Stacktrace, Debug, S, [Event|Events])
+ end.
+
+loop_event_actions(
+ Parent, Debug,
+ #{state := State, state_enter := StateEnter} = S, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewData, Actions) ->
+ case parse_actions(Debug, S, State, Actions) of
+ {ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} ->
+ if
+ StateEnter, NextState =/= State ->
+ loop_event_enter(
+ Parent, NewDebug, S, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR);
+ 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, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR);
+ false ->
+ loop_event_result(
+ Parent, NewDebug, S, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR)
+ end;
+ true ->
+ loop_event_result(
+ Parent, NewDebug, S, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR)
+ end;
+ {Class,Reason,Stacktrace} ->
+ terminate(
+ Class, Reason, Stacktrace,
+ Debug, S#{data := NewData}, [Event|Events])
+ end.
+
+loop_event_enter(
+ Parent, Debug, #{state := State} = S, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR) ->
+ case call_state_function(S, enter, State, NextState, NewData) of
+ {ok,Result,NewS} ->
+ {NewerData,_,Actions} =
+ parse_event_result(
+ false, Debug, NewS, Result,
+ Events, Event, NextState, NewData),
+ loop_event_enter_actions(
+ Parent, Debug, NewS, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewerData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Actions);
+ {Class,Reason,Stacktrace} ->
+ terminate(
+ Class, Reason, Stacktrace,
+ Debug, S#{state := NextState, data := NewData},
+ [Event|Events])
+ end.
+
+loop_event_enter_actions(
+ Parent, Debug, S, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Actions) ->
+ case
+ parse_enter_actions(
+ Debug, S, NextState, Actions,
+ Hibernate, TimeoutsR)
+ of
+ {ok,NewDebug,NewHibernate,NewTimeoutsR,_,_} ->
+ loop_event_result(
+ Parent, NewDebug, S, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewData,
+ NewHibernate, NewTimeoutsR, Postpone, NextEventsR);
+ {Class,Reason,Stacktrace} ->
+ terminate(
+ Class, Reason, Stacktrace,
+ Debug, S#{state := NextState, data := NewData},
+ [Event|Events])
end.
-%% Back to the top
-loop_events_done(
- Parent, Debug, S, StateTimer,
- State, Data, P, Hibernate, Timer) ->
+loop_event_result(
+ Parent, Debug,
+ #{state := State, postponed := P_0} = S, TimerRefs_0, TimerTypes_0,
+ Events, Event, NextState, NewData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR) ->
+ %%
+ %% All options have been collected and next_events are buffered.
+ %% Do the actual state transition.
+ %%
+ {NewDebug,P_1} = % Move current event to postponed if Postpone
+ case Postpone of
+ true ->
+ {sys_debug(Debug, S, State, {postpone,Event,State}),
+ [Event|P_0]};
+ false ->
+ {sys_debug(Debug, S, State, {consume,Event,State}),
+ P_0}
+ end,
+ {Events_1,NewP,{TimerRefs,TimerTypes}} =
+ %% Move all postponed events to queue and cancel the
+ %% state timeout if the state changes
+ if
+ NextState =:= State ->
+ {Events,P_1,{TimerRefs_0,TimerTypes_0}};
+ true ->
+ {lists:reverse(P_1, Events),[],
+ cancel_timer_by_type(
+ state_timeout, TimerRefs_0, TimerTypes_0)}
+ end,
+ {NewTimerRefs,NewTimerTypes,TimeoutEvents} =
+ %% Stop and start timers
+ handle_timers(TimerRefs, TimerTypes, TimeoutsR),
+ %% Place next events first in reversed queue
+ NewEventsR = lists:reverse(Events_1, NextEventsR),
+ %% Append timeout zero events
+ NewEvents =
+ lists:reverse(
+ NewEventsR,
+ process_timeout_events(TimeoutEvents, NewEventsR)),
+ %%
+ loop_events(
+ Parent, NewDebug, S, NewTimerRefs, NewTimerTypes,
+ NewEvents, Hibernate, NextState, NewData, NewP).
+
+%% Loop until out of enqueued events
+%%
+loop_events(
+ Parent, Debug, S, TimerRefs, TimerTypes,
+ [] = _Events, Hibernate, State, Data, P) ->
+ %% Update S and loop back to loop/3 to receive a new event
NewS =
S#{
state := State,
data := Data,
postponed := P,
hibernate => Hibernate,
- timer => Timer,
- state_timer => StateTimer},
- loop(Parent, Debug, NewS).
+ timer_refs => TimerRefs,
+ timer_types => TimerTypes},
+ loop(Parent, Debug, NewS);
+loop_events(
+ Parent, Debug, S, TimerRefs, TimerTypes,
+ [Event|Events], Hibernate, State, Data, P) ->
+ %% Update S and continue with enqueued events
+ NewS =
+ S#{
+ state := State,
+ data := Data,
+ postponed := P},
+ loop_event(
+ Parent, Debug, NewS, TimerRefs, TimerTypes, Events, Event, Hibernate).
+
+%%---------------------------------------------------------------------------
+%% Server loop helpers
call_callback_mode(#{module := Module} = S) ->
try Module:callback_mode() of
@@ -996,6 +1121,7 @@ parse_callback_mode([H|T], CBMode, StateEnter) ->
parse_callback_mode(_, _CBMode, StateEnter) ->
{undefined,StateEnter}.
+
call_state_function(
#{callback_mode := undefined} = S,
Type, Content, State, Data) ->
@@ -1061,42 +1187,6 @@ call_state_function(
{Class,Reason,erlang:get_stacktrace()}
end.
-%% Update S and continue
-loop_event(
- 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 rely on i.e collect garbage which
- %% would have happened if we actually hibernated
- %% and immediately was awakened
- Hibernate andalso garbage_collect(),
- case call_state_function(S, Type, Content, State, Data) of
- {ok,Result,NewS} ->
- {NewData,NextState,Actions} =
- parse_event_result(
- true, Debug, NewS, Result,
- Events, Event, State, Data),
- loop_event_actions(
- Parent, Debug, S, StateTimer,
- Events, Event, NextState, NewData, Actions);
- {Class,Reason,Stacktrace} ->
- terminate(
- Class, Reason, Stacktrace, Debug, S, [Event|Events])
- end.
%% Interpret all callback return variants
parse_event_result(
@@ -1146,32 +1236,32 @@ parse_event_result(
Debug, S, [Event|Events])
end.
+
parse_enter_actions(
Debug, S, State, Actions,
- Hibernate, Timeout, StateTimeout) ->
+ Hibernate, TimeoutsR) ->
Postpone = forbidden,
- NextEvents = forbidden,
+ NextEventsR = forbidden,
parse_actions(
Debug, S, State, listify(Actions),
- Hibernate, Timeout, StateTimeout, Postpone, NextEvents).
+ Hibernate, TimeoutsR, Postpone, NextEventsR).
parse_actions(Debug, S, State, Actions) ->
Hibernate = false,
- Timeout = undefined,
- StateTimeout = undefined,
+ TimeoutsR = [],
Postpone = false,
- NextEvents = [],
+ NextEventsR = [],
parse_actions(
Debug, S, State, listify(Actions),
- Hibernate, Timeout, StateTimeout, Postpone, NextEvents).
+ Hibernate, TimeoutsR, Postpone, NextEventsR).
%%
parse_actions(
Debug, _S, _State, [],
- Hibernate, Timeout, StateTimeout, Postpone, NextEvents) ->
- {ok,Debug,Hibernate,Timeout,StateTimeout,Postpone,NextEvents};
+ Hibernate, TimeoutsR, Postpone, NextEventsR) ->
+ {ok,Debug,Hibernate,TimeoutsR,Postpone,NextEventsR};
parse_actions(
Debug, S, State, [Action|Actions],
- Hibernate, Timeout, StateTimeout, Postpone, NextEvents) ->
+ Hibernate, TimeoutsR, Postpone, NextEventsR) ->
case Action of
%% Actual actions
{reply,From,Reply} ->
@@ -1180,8 +1270,7 @@ parse_actions(
NewDebug = do_reply(Debug, S, State, From, Reply),
parse_actions(
NewDebug, S, State, Actions,
- Hibernate, Timeout, StateTimeout,
- Postpone, NextEvents);
+ Hibernate, TimeoutsR, Postpone, NextEventsR);
false ->
{error,
{bad_action_from_state_function,Action},
@@ -1191,7 +1280,7 @@ parse_actions(
{hibernate,NewHibernate} when is_boolean(NewHibernate) ->
parse_actions(
Debug, S, State, Actions,
- NewHibernate, Timeout, StateTimeout, Postpone, NextEvents);
+ NewHibernate, TimeoutsR, Postpone, NextEventsR);
{hibernate,_} ->
{error,
{bad_action_from_state_function,Action},
@@ -1199,43 +1288,44 @@ parse_actions(
hibernate ->
parse_actions(
Debug, S, State, Actions,
- true, Timeout, StateTimeout, Postpone, NextEvents);
- {state_timeout,Time,_} = NewStateTimeout
+ true, TimeoutsR, Postpone, NextEventsR);
+ {state_timeout,Time,_} = StateTimeout
when is_integer(Time), Time >= 0;
Time =:= infinity ->
parse_actions(
Debug, S, State, Actions,
- Hibernate, Timeout, NewStateTimeout, Postpone, NextEvents);
+ Hibernate, [StateTimeout|TimeoutsR], Postpone, NextEventsR);
{state_timeout,_,_} ->
{error,
{bad_action_from_state_function,Action},
?STACKTRACE()};
- {timeout,infinity,_} -> % Clear timer - it will never trigger
+ {timeout,infinity,_} ->
+ %% Ignore - timeout will never happen and already cancelled
parse_actions(
Debug, S, State, Actions,
- Hibernate, undefined, StateTimeout, Postpone, NextEvents);
- {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 ->
+ Hibernate, TimeoutsR, Postpone, NextEventsR);
+ {timeout,Time,_} = Timeout when is_integer(Time), Time >= 0 ->
parse_actions(
Debug, S, State, Actions,
- Hibernate, NewTimeout, StateTimeout, Postpone, NextEvents);
+ Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR);
{timeout,_,_} ->
{error,
{bad_action_from_state_function,Action},
?STACKTRACE()};
- infinity -> % Clear timer - it will never trigger
+ infinity -> % Ignore - timeout will never happen
parse_actions(
Debug, S, State, Actions,
- Hibernate, undefined, StateTimeout, Postpone, NextEvents);
+ Hibernate, TimeoutsR, Postpone, NextEventsR);
Time when is_integer(Time), Time >= 0 ->
- NewTimeout = {timeout,Time,Time},
+ Timeout = {timeout,Time,Time},
parse_actions(
Debug, S, State, Actions,
- Hibernate, NewTimeout, StateTimeout, Postpone, NextEvents);
+ Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR);
{postpone,NewPostpone}
when is_boolean(NewPostpone), Postpone =/= forbidden ->
parse_actions(
Debug, S, State, Actions,
- Hibernate, Timeout, StateTimeout, NewPostpone, NextEvents);
+ Hibernate, TimeoutsR, NewPostpone, NextEventsR);
{postpone,_} ->
{error,
{bad_action_from_state_function,Action},
@@ -1243,16 +1333,16 @@ parse_actions(
postpone when Postpone =/= forbidden ->
parse_actions(
Debug, S, State, Actions,
- Hibernate, Timeout, StateTimeout, true, NextEvents);
+ Hibernate, TimeoutsR, true, NextEventsR);
{next_event,Type,Content} ->
case event_type(Type) of
- true when NextEvents =/= forbidden ->
+ true when NextEventsR =/= forbidden ->
NewDebug =
sys_debug(Debug, S, State, {in,{Type,Content}}),
parse_actions(
NewDebug, S, State, Actions,
- Hibernate, Timeout, StateTimeout,
- Postpone, [{Type,Content}|NextEvents]);
+ Hibernate, TimeoutsR, Postpone,
+ [{Type,Content}|NextEventsR]);
_ ->
{error,
{bad_action_from_state_function,Action},
@@ -1264,158 +1354,59 @@ parse_actions(
?STACKTRACE()}
end.
-loop_event_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,StateTimeout,Postpone,NextEvents} ->
- if
- StateEnter, NextState =/= State ->
- loop_event_enter(
- 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, StateTimer,
- Events, Event, NextState, NewData,
- Hibernate, Timeout, StateTimeout, Postpone, NextEvents)
- end;
- {Class,Reason,Stacktrace} ->
- terminate(
- Class, Reason, Stacktrace,
- Debug, S#{data := NewData}, [Event|Events])
- end.
-loop_event_enter(
- 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(
- false, Debug, NewS, Result,
- Events, Event, NextState, NewData),
- loop_event_enter_actions(
- Parent, Debug, NewS, StateTimer,
- Events, Event, NextState, NewerData,
- Hibernate, Timeout, StateTimeout, Postpone, NextEvents, Actions);
- {Class,Reason,Stacktrace} ->
- terminate(
- Class, Reason, Stacktrace,
- Debug, S#{state := NextState, data := NewData},
- [Event|Events])
+%% Stop and start timers as well as create timeout zero events
+%%
+handle_timers(TimerRefs, TimerTypes, TimeoutsR) ->
+ Seen = #{},
+ TimeoutEvents = [],
+ handle_timers(TimerRefs, TimerTypes, TimeoutsR, Seen, TimeoutEvents).
+%%
+handle_timers(TimerRefs, TimerTypes, [], _Seen, TimeoutEvents) ->
+ {TimerRefs,TimerTypes,TimeoutEvents};
+handle_timers(TimerRefs, TimerTypes, [Timeout|TimeoutsR], Seen, TimeoutEvents) ->
+ {TimerType,Time,TimerMsg} = Timeout,
+ case Seen of
+ #{TimerType := _} ->
+ handle_timers(
+ TimerRefs, TimerTypes, TimeoutsR, Seen, TimeoutEvents);
+ #{} ->
+ NewSeen = Seen#{TimerType => true},
+ {NewTimerRefs,NewTimerTypes} =
+ cancel_timer_by_type(TimerType, TimerRefs, TimerTypes),
+ case Time of
+ 0 ->
+ TimeoutEvent = {TimerType,TimerMsg},
+ handle_timers(
+ NewTimerRefs, NewTimerTypes,
+ TimeoutsR, NewSeen, [TimeoutEvent|TimeoutEvents]);
+ infinity ->
+ %% Ignore - timer will never fire
+ handle_timers(
+ NewTimerRefs, NewTimerTypes,
+ TimeoutsR, NewSeen, TimeoutEvents);
+ _ ->
+ TimerRef = erlang:start_timer(Time, self(), TimerMsg),
+ handle_timers(
+ NewTimerRefs#{TimerRef => TimerType},
+ NewTimerTypes#{TimerType => TimerRef},
+ TimeoutsR, NewSeen, TimeoutEvents)
+ end
end.
-loop_event_enter_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, StateTimeout)
- of
- {ok,NewDebug,NewHibernate,NewTimeout,NewStateTimeout,_,_} ->
- loop_event_result(
- Parent, NewDebug, S, StateTimer,
- Events, Event, NextState, NewData,
- NewHibernate, NewTimeout, NewStateTimeout, Postpone, NextEvents);
- {Class,Reason,Stacktrace} ->
- terminate(
- Class, Reason, Stacktrace,
- Debug, S#{state := NextState, data := NewData},
- [Event|Events])
- end.
-loop_event_result(
- 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.
- %%
- 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|P_0];
- false ->
- P_0
- end,
- {Events_1,NewP} = % Move all postponed events to queue if state change
- if
- NextState =:= State ->
- {Events,P_1};
- true ->
- {lists:reverse(P_1, Events),[]}
- end,
- %% Place next events first in queue
- NewEvents = lists:reverse(NextEvents, Events_1),
- %%
- NewDebug =
- sys_debug(
- Debug, S, State,
- case Postpone of
- true ->
- {postpone,Event,State};
- false ->
- {consume,Event,State}
- end),
- %%
- loop_events(
- Parent, NewDebug, S, NewStateTimeout,
- NewEvents, Timeout, NextState, NewData, NewP, Hibernate).
+%% Keep an event timeout event if it is the only event so far
+process_timeout_events([], _Es) ->
+ [];
+process_timeout_events([{timeout,_} = TimeoutEvent|TimeoutEvents], []) ->
+ [TimeoutEvent|process_timeout_events(TimeoutEvents, [TimeoutEvent])];
+process_timeout_events([{timeout,_}|TimeoutEvents], Es) ->
+ %% Ignore event timeout since there are other events
+ process_timeout_events(TimeoutEvents, Es);
+process_timeout_events([TimeoutEvent|TimeoutEvents], Es) ->
+ [TimeoutEvent|process_timeout_events(TimeoutEvents, [TimeoutEvent|Es])].
+
+
%%---------------------------------------------------------------------------
%% Server helpers
@@ -1605,8 +1596,19 @@ listify(Item) when is_list(Item) ->
listify(Item) ->
[Item].
-cancel_timer(undefined) ->
- ok;
+%% Cancel timer if running, otherwise no op
+cancel_timer_by_type(TimerType, TimerRefs, TimerTypes) ->
+ case TimerTypes of
+ #{TimerType := TimerRef} ->
+ cancel_timer(TimerRef),
+ {maps:remove(TimerRef, TimerRefs),
+ maps:remove(TimerType, TimerTypes)};
+ #{} ->
+ {TimerRefs,TimerTypes}
+ end.
+
+%%cancel_timer(undefined) ->
+%% ok;
cancel_timer(TRef) ->
case erlang:cancel_timer(TRef) of
false ->
diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl
index 28f9ab81fe..119546be98 100644
--- a/lib/stdlib/test/gen_statem_SUITE.erl
+++ b/lib/stdlib/test/gen_statem_SUITE.erl
@@ -742,26 +742,40 @@ state_timeout(_Config) ->
%% Verify that {state_timeout,0,_}
%% comes after next_event and that
%% {timeout,0,_} is cancelled by
- %% {state_timeout,0,_}
+ %% pending {state_timeout,0,_}
{keep_state, {ok,2,Data},
[{timeout,0,3}]};
- (state_timeout, 2, {ok,2,{Time,From}}) ->
- {next_state, state3, 3,
+ (state_timeout, 2, {ok,2,Data}) ->
+ %% Verify that timeout 0's are processed
+ %% in order
+ {keep_state, {ok,3,Data},
+ [{timeout,0,4},{state_timeout,0,5}]};
+ (timeout, 4, {ok,3,Data}) ->
+ %% Verify that timeout 0 is cancelled by
+ %% enqueued state_timeout 0 and that
+ %% multiple state_timeout 0 can be enqueued
+ {keep_state, {ok,4,Data},
+ [{state_timeout,0,6},{timeout,0,7}]};
+ (state_timeout, 5, {ok,4,Data}) ->
+ {keep_state, {ok,5,Data}};
+ (state_timeout, 6, {ok,5,{Time,From}}) ->
+ {next_state, state3, 6,
[{reply,From,ok},
- {state_timeout,Time,3}]}
+ {state_timeout,Time,8}]}
end,
state3 =>
fun
- (info, message_to_self, 3) ->
- {keep_state, '3'};
- ({call,From}, check, '3') ->
+ (info, message_to_self, 6) ->
+ {keep_state, 7};
+ ({call,From}, check, 7) ->
{keep_state, From};
- (state_timeout, 3, From) ->
+ (state_timeout, 8, From) ->
{stop_and_reply, normal,
{reply,From,ok}}
end},
{ok,STM} = gen_statem:start_link(?MODULE, {map_statem,Machine,[]}, []),
+ sys:trace(STM, true),
TRef = erlang:start_timer(1000, self(), kull),
ok = gen_statem:call(STM, {go,500}),
ok = gen_statem:call(STM, check),