diff options
Diffstat (limited to 'lib/stdlib')
| -rw-r--r-- | lib/stdlib/doc/src/gen_statem.xml | 105 | ||||
| -rw-r--r-- | lib/stdlib/src/gen_statem.erl | 464 | ||||
| -rw-r--r-- | lib/stdlib/test/gen_statem_SUITE.erl | 80 |
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), |