diff options
| -rw-r--r-- | lib/stdlib/doc/src/gen_statem.xml | 71 | ||||
| -rw-r--r-- | lib/stdlib/src/gen_statem.erl | 326 | ||||
| -rw-r--r-- | lib/stdlib/test/gen_statem_SUITE.erl | 35 |
3 files changed, 104 insertions, 328 deletions
diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index bda3ef081d..04b80d29ac 100644 --- a/lib/stdlib/doc/src/gen_statem.xml +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -462,24 +462,6 @@ ok </desc> </datatype> <datatype> - <name name="event_predicate" /> - <desc> - <p> - A <c>fun()</c> of arity 2 that takes an event - and returns a boolean. - When used in the - <seealso marker="#type-action">action()</seealso> - <c>{remove_event,RemoveEventPredicate}</c>, - the oldest event for which the predicate returns <c>true</c> - will be removed. - </p> - <p> - The predicate may <em>not</em> use a throw exception - to return its result. - </p> - </desc> - </datatype> - <datatype> <name name="callback_mode" /> <desc> <p> @@ -617,13 +599,11 @@ ok counts just like a new in this respect. If the value is <c>infinity</c> no timer is started. If it is <c>0</c> the timeout event - is immediately enqueued as the newest received. + is immediately enqueued as the newest received + (unless there are retried or inserted events to process). Also note that it is not possible nor needed - to cancel this timeout using the - <seealso marker="#type-action"> - <c>action() cancel_timer</c> - </seealso> - since this timeout is cancelled automatically by any other event. + to cancel this timeout since it is cancelled automatically + by any other event. </p> </desc> </datatype> @@ -702,49 +682,6 @@ ok should be used when you want to reliably distinguish an event inserted this way from any external event. </item> - <tag><c>remove_event</c></tag> - <item> - Remove the oldest queued event - that matches equal to <c><anno>EventType</anno></c> - and <c><anno>EventContent</anno></c> or for which - <c><anno>EventPredicate</anno></c> - returns <c>true</c>. Note that <c>next_event</c> - and <c>postpone</c> events in the same actions list - does not get into the event queue until after all actions - has been done so you can not remove an event that you insert - with the same actions list. Make up your mind! - </item> - <tag><c>cancel_timer</c></tag> - <item> - Cancel the timer by calling - <seealso marker="erts:erlang#cancel_timer/2"> - <c>erlang:cancel_timer/2</c> - </seealso> - with <c><anno>TimerRef</anno></c>, - clean the process message queue from any late timeout message, - and remove any late timeout message - from the <c>gen_statem</c> event queue using - <c>{remove_event,<anno>EventPredicate</anno>}</c> above. - This is a convenience function that saves quite some - lines of code and testing time over doing it from - the primitives mentioned above. - </item> - <tag><c>demonitor</c></tag> - <item> - Like <c>cancel_timer</c> above but for - <seealso marker="erts:erlang#demonitor/2"> - <c>demonitor/2</c> - </seealso> - with <c><anno>MonitorRef</anno></c>. - </item> - <tag><c>unlink</c></tag> - <item> - Like <c>cancel_timer</c> above but for - <seealso marker="erts:erlang#unlink/1"> - <c>unlink/1</c> - </seealso> - with <c><anno>Id</anno></c>. - </item> </taglist> </desc> </datatype> diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 29848d13a3..26f1aede6f 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -66,9 +66,6 @@ {'call',Caller :: caller()} | 'cast' | 'info' | 'timeout' | 'internal'. --type event_predicate() :: % Return true for the event in question - fun((event_type(), term()) -> boolean()). - -type callback_mode() :: 'state_functions' | 'handle_event_function'. -type transition_option() :: @@ -117,19 +114,7 @@ %% action() list is the first to be delivered. {'next_event', % Insert event as the next to handle EventType :: event_type(), - EventContent :: term()} | - %% - {'remove_event', % Remove the oldest matching (=:=) event - EventType :: event_type(), EventContent :: term()} | - {'remove_event', % Remove the oldest event satisfying predicate - EventPredicate :: event_predicate()} | - %% - {'cancel_timer', % Cancel timer and clean up mess(ages) - TimerRef :: reference()} | - {'demonitor', % Demonitor and clean up mess(ages) - MonitorRef :: reference()} | - {'unlink', % Unlink and clean up mess(ages) - Id :: pid() | port()}. + EventContent :: term()}. -type reply_action() :: {'reply', % Reply to a caller Caller :: caller(), Reply :: term()}. @@ -745,11 +730,11 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> Msg -> case Msg of {system,Pid,Req} -> + #{hibernate := Hibernate} = S, %% Does not return but tail recursively calls %% system_continue/3 that jumps to loop/3 sys:handle_system_msg( - Req, Pid, Parent, ?MODULE, Debug, S, - maps:get(hibernate, S)); + Req, Pid, Parent, ?MODULE, Debug, S, Hibernate); {'EXIT',Parent,Reason} = EXIT -> %% EXIT is not a 2-tuple and therefore %% not an event and has no event_type(), @@ -757,8 +742,25 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> ?TERMINATE(exit, Reason, Debug, S, [EXIT]); {timeout,Timer,Content} when Timer =/= undefined -> loop_event( - Parent, Debug, S, {timeout,Content}, undefined); + Parent, Debug, S, {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, Event = case Msg of {'$gen_call',Caller,Request} -> @@ -768,22 +770,20 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> _ -> {info,Msg} end, - loop_event(Parent, Debug, S, Event, Timer) + loop_event(Parent, Debug, S, Event) end end. -loop_event(Parent, Debug, S, Event, Timer) -> +loop_event(Parent, Debug, S, Event) -> + %% The timer field in S is now invalid and ignored + %% until we get back to loop/3 NewDebug = sys_debug(Debug, S, {in,Event}), %% Here the queue of not yet processed events is created - loop_events(Parent, NewDebug, S, [Event], Timer). + loop_events(Parent, NewDebug, S, [Event]). -%% Process first event in queue, or if there is none receive a new -%% -%% The loop_event* functions optimize S map handling by dismantling it, -%% passing the parts in arguments to avoid map lookups and construct the -%% new S map in one go on exit. Premature optimization, I know, but -%% there were quite some map lookups repeated in different functions. -loop_events(Parent, Debug, S, [], _Timer) -> +%% Process first the event queue, or if it is empty +%% loop back to receive a new event +loop_events(Parent, Debug, S, []) -> loop(Parent, Debug, S); loop_events( Parent, Debug, @@ -791,9 +791,7 @@ loop_events( module := Module, state := State, data := Data} = S, - [{Type,Content} = Event|Events] = Q, Timer) -> - _ = (Timer =/= undefined) andalso - cancel_timer(Timer), + [{Type,Content} = Event|Events] = Q) -> try case CallbackMode of state_functions -> @@ -841,7 +839,7 @@ loop_events( terminate(Class, Reason, Stacktrace, Debug, S, Q) end. -%% Interpret all callback return value variants +%% Interpret all callback return variants loop_event_result( Parent, Debug, #{callback_mode := CallbackMode, state := State, data := Data} = S, @@ -909,7 +907,6 @@ loop_event_actions( Hibernate = false, Timeout = undefined, NextEvents = [], - P = false, % The postponed list or false if unchanged loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, if @@ -918,24 +915,25 @@ loop_event_actions( true -> [Actions] end, - Postpone, Hibernate, Timeout, NextEvents, P). + Postpone, Hibernate, Timeout, NextEvents). %% +%% Process all action()s loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, [Action|Actions], - Postpone, Hibernate, Timeout, NextEvents, P) -> + Postpone, Hibernate, Timeout, NextEvents) -> case Action of - %% Set options + %% Actions that set options postpone -> loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, Actions, - true, Hibernate, Timeout, NextEvents, P); + true, Hibernate, Timeout, NextEvents); {postpone,NewPostpone} when is_boolean(NewPostpone) -> loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, Actions, - NewPostpone, Hibernate, Timeout, NextEvents, P); + NewPostpone, Hibernate, Timeout, NextEvents); {postpone,_} -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]); @@ -943,12 +941,12 @@ loop_event_actions( loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, Actions, - Postpone, true, Timeout, NextEvents, P); + Postpone, true, Timeout, NextEvents); {hibernate,NewHibernate} when is_boolean(NewHibernate) -> loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, Actions, - Postpone, NewHibernate, Timeout, NextEvents, P); + Postpone, NewHibernate, Timeout, NextEvents); {hibernate,_} -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]); @@ -956,12 +954,12 @@ loop_event_actions( loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, Actions, - Postpone, Hibernate, undefined, NextEvents, P); + Postpone, Hibernate, undefined, NextEvents); {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 -> loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, Actions, - Postpone, Hibernate, NewTimeout, NextEvents, P); + Postpone, Hibernate, NewTimeout, NextEvents); {timeout,_,_} -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]); @@ -973,7 +971,7 @@ loop_event_actions( loop_event_actions( Parent, NewDebug, S, Events, Event, State, NewState, NewData, Actions, - Postpone, Hibernate, Timeout, NextEvents, P); + Postpone, Hibernate, Timeout, NextEvents); false -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]) @@ -985,67 +983,25 @@ loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, Actions, Postpone, Hibernate, Timeout, - [{Type,Content}|NextEvents], P); + [{Type,Content}|NextEvents]); false -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]) end; _ -> - %% All others are remove actions - case remove_fun(Action) of - false -> - loop_event_actions( - Parent, Debug, S, Events, Event, - State, NewState, NewData, Actions, - Postpone, Hibernate, Timeout, NextEvents, P); - undefined -> - ?TERMINATE( - error, {bad_action,Action}, Debug, S, [Event|Events]); - RemoveFun when is_function(RemoveFun, 2) -> - P0 = - case P of - false -> - maps:get(postponed, S); - _ -> - P - end, - case remove_event(RemoveFun, Events, P0) of - false -> - loop_event_actions( - Parent, Debug, S, Events, Event, - State, NewState, NewData, Actions, - Postpone, Hibernate, Timeout, NextEvents, P); - {NewEvents,false} -> - loop_event_actions( - Parent, Debug, S, NewEvents, Event, - State, NewState, NewData, Actions, - Postpone, Hibernate, Timeout, NextEvents, P); - {false,NewP} -> - loop_event_actions( - Parent, Debug, S, Events, Event, - State, NewState, NewData, Actions, - Postpone, Hibernate, Timeout, NextEvents, - NewP); - [Class,Reason,Stacktrace] -> - terminate( - Class, Reason, Stacktrace, - Debug, S, [Event|Events]) - end; - [Class,Reason,Stacktrace] -> - terminate( - Class, Reason, Stacktrace, Debug, S, [Event|Events]) - end + ?TERMINATE( + error, {bad_action,Action}, Debug, S, [Event|Events]) end; +%% +%% End of actions list loop_event_actions( - Parent, Debug, S, Events, Event, State, NewState, NewData, [], - Postpone, Hibernate, Timeout, NextEvents, P) -> - P0 = - case P of - false -> - maps:get(postponed, S); - _ -> - P - end, + Parent, Debug, #{postponed := P0} = S, Events, Event, + State, NewState, NewData, [], + Postpone, Hibernate, Timeout, NextEvents) -> + %% + %% All options have been collected and next_events are buffered. + %% Do the actual state transition. + %% P1 = % Move current event to postponed if Postpone case Postpone of true -> @@ -1053,23 +1009,12 @@ loop_event_actions( false -> P0 end, - {Timer,Q1} = - case Timeout of - undefined -> - {undefined,Events}; - {timeout,0,Msg} -> - %% Pretend the timeout has just been received - {undefined,Events ++ [{timeout,Msg}]}; - {timeout,Time,Msg} -> - {erlang:start_timer(Time, self(), Msg), - Events} - end, - {Q2,P2} = % Move all postponed events to queue if state change + {Q2,P} = % Move all postponed events to queue if state change if NewState =:= State -> - {Q1,P1}; + {Events,P1}; true -> - {lists:reverse(P1, Q1),[]} + {lists:reverse(P1, Events),[]} end, %% Place next events first in queue Q3 = lists:reverse(NextEvents, Q2), @@ -1083,16 +1028,41 @@ loop_event_actions( false -> {consume,Event,NewState} end), - %% Loop to top; process next event + %% Have a peek on the event queue so we can avoid starting + %% the state timer unless we have to + {Q,Timer} = + case Timeout of + undefined -> + %% No state timeout has been requested + {Q3,undefined}; + {timeout,Time,Msg} -> + %% A state timeout has been requested + case Q3 of + [] when Time =:= 0 -> + %% Immediate timeout - simulate it + %% so we do not get the timeout message + %% after any received event + {[{timeout,Msg}],undefined}; + [] -> + %% Actually start a timer + {Q3,erlang:start_timer(Time, self(), Msg)}; + _ -> + %% Do not start a timer since any queued + %% event cancels the state timer so we pretend + %% that the timer has been started and cancelled + {Q3,undefined} + end + end, + %% Loop to top of event queue loop; process next event loop_events( Parent, NewDebug, S#{ state := NewState, data := NewData, timer := Timer, - hibernate := Hibernate, - postponed := P2}, - Q3, Timer). + postponed := P, + hibernate := Hibernate}, + Q). %%--------------------------------------------------------------------------- %% Server helpers @@ -1125,103 +1095,6 @@ do_reply(Debug, S, Caller, Reply) -> sys_debug(Debug, S, {out,Reply,Caller}). -%% Remove oldest matching event from the queue(s) -remove_event(RemoveFun, Q, P) -> - try - case remove_tail_event(RemoveFun, P) of - false -> - case remove_head_event(RemoveFun, Q) of - false -> - false; - NewQ -> - {false,NewQ} - end; - NewP -> - {NewP,false} - end - catch - Class:Reason -> - [Class,Reason,erlang:get_stacktrace()] - end. - -%% Do the given action and create an event removal predicate fun() -remove_fun({remove_event,Type,Content}) -> - fun (T, C) when T =:= Type, C =:= Content -> true; - (_, _) -> false - end; -remove_fun({remove_event,RemoveFun}) when is_function(RemoveFun, 2) -> - RemoveFun; -remove_fun({cancel_timer,TimerRef}) -> - try cancel_timer(TimerRef) of - false -> - false; - true -> - fun - (info, {timeout,TRef,_}) - when TRef =:= TimerRef -> - true; - (_, _) -> - false - end - catch - Class:Reason -> - [Class,Reason,erlang:get_stacktrace()] - end; -remove_fun({demonitor,MonitorRef}) -> - try erlang:demonitor(MonitorRef, [flush,info]) of - false -> - false; - true -> - fun (info, {'DOWN',MRef,_,_,_}) - when MRef =:= MonitorRef-> - true; - (_, _) -> - false - end - catch - Class:Reason -> - [Class,Reason,erlang:get_stacktrace()] - end; -remove_fun({unlink,Id}) -> - try unlink(Id) of - true -> - receive - {'EXIT',Id,_} -> - ok - after 0 -> - ok - end, - fun (info, {'EXIT',I,_}) - when I =:= Id -> - true; - (_, _) -> - false - end - catch - Class:Reason -> - [Class,Reason,erlang:get_stacktrace()] - end; -remove_fun(_) -> - undefined. - - -%% Cancel a timer and clense the process mailbox returning -%% false if no such timer message can arrive after this or -%% true otherwise -cancel_timer(TimerRef) -> - case erlang:cancel_timer(TimerRef) of - TimeLeft when is_integer(TimeLeft) -> - false; - false -> - receive - {timeout,TimerRef,_} -> - false - after 0 -> - true - end - end. - - terminate( Class, Reason, Stacktrace, Debug, #{module := Module, @@ -1350,30 +1223,3 @@ format_status_default(Opt, State, Data) -> _ -> [{data,[{"State",SSD}]}] end. - -%%--------------------------------------------------------------------------- -%% Farily general helpers - -%% Return the modified list where the first element that satisfies -%% the RemoveFun predicate is removed, or false if no such element exists. -remove_head_event(_RemoveFun, []) -> - false; -remove_head_event(RemoveFun, [{Tag,Content}|Events]) -> - case RemoveFun(Tag, Content) of - false -> - remove_head_event(RemoveFun, Events); - true -> - Events - end. - -%% Return the modified list where the last element that satisfies -%% the RemoveFun predicate is removed, or false if no such element exists. -remove_tail_event(_RemoveFun, []) -> - false; -remove_tail_event(RemoveFun, [{Tag,Content} = Event|Events]) -> - case remove_tail_event(RemoveFun, Events) of - false -> - RemoveFun(Tag, Content) andalso Events; - NewEvents -> - [Event|NewEvents] - end. diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl index 268b45a0e7..38aab752b8 100644 --- a/lib/stdlib/test/gen_statem_SUITE.erl +++ b/lib/stdlib/test/gen_statem_SUITE.erl @@ -1210,29 +1210,22 @@ idle(Type, Content, Data) -> end. timeout(timeout, idle, {From,Time}) -> - TRef2 = erlang:start_timer(Time, self(), ok), - TRefC1 = erlang:start_timer(Time, self(), cancel1), - TRefC2 = erlang:start_timer(Time, self(), cancel2), - {next_state,timeout2,{From,Time,TRef2}, - [{cancel_timer, TRefC1}, - {next_event,internal,{cancel_timer,TRefC2}}]}; -timeout(_, _, Data) -> - {keep_state,Data}. - -timeout2( - internal, {cancel_timer,TRefC2}, {From,Time,TRef2}) -> - Time4 = Time * 4, - receive after Time4 -> ok end, - {next_state,timeout3,{From,TRef2}, - [{cancel_timer,TRefC2}]}; -timeout2(_, _, Data) -> - {keep_state,Data}. - -timeout3(info, {timeout,TRef2,Result}, {From,TRef2}) -> + TRef = erlang:start_timer(Time, self(), ok), + {next_state,timeout2,{From,TRef}, + [{timeout,1,should_be_cancelled}, + postpone]}; % Should cancel state timeout +timeout(_, _, _) -> + keep_state_and_data. + +timeout2(timeout, idle, _) -> + keep_state_and_data; +timeout2(timeout, Reason, _) -> + {stop,Reason}; +timeout2(info, {timeout,TRef,Result}, {From,TRef}) -> gen_statem:reply([{reply,From,Result}]), {next_state,idle,state}; -timeout3(_, _, Data) -> - {keep_state,Data}. +timeout2(_, _, _) -> + {keep_state_and_data,[]}. wfor_conf({call,From}, confirm, Data) -> {next_state,connected,Data, |