diff options
| -rw-r--r-- | lib/stdlib/src/gen_statem.erl | 193 | ||||
| -rw-r--r-- | lib/stdlib/test/gen_statem_SUITE.erl | 36 |
2 files changed, 129 insertions, 100 deletions
diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 5dc9cca76e..86109f04b4 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -859,117 +859,112 @@ loop_hibernate(Parent, Debug, S) -> {wakeup_from_hibernate,3}}). %% Entry point for wakeup_from_hibernate/3 -loop_receive(Parent, Debug, #{cancel_timers := 0, hibernate_after := HibernateAfterTimeout} = S) when is_integer(HibernateAfterTimeout) -> +loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> receive Msg -> - handle_received_msg(Msg, Parent, Debug, S) - after - HibernateAfterTimeout -> - loop_hibernate(Parent, Debug, S) - end; -loop_receive(Parent, Debug, S) -> - receive - Msg -> - handle_received_msg(Msg, Parent, Debug, S) - end. - -handle_received_msg({system,Pid,Req}, Parent, Debug, S) -> - #{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, - Hibernate); -handle_received_msg({'EXIT',Parent,Reason} = EXIT, Parent, Debug, S) -> - %% EXIT is not a 2-tuple therefore - %% not an event but this will stand out - %% in the crash report... - Q = [EXIT], - terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q); -handle_received_msg({timeout,TimerRef,TimerMsg} = Msg, Parent, Debug, S) -> - #{timer_refs := TimerRefs, - timer_types := TimerTypes, - hibernate := Hibernate} = S, - case TimerRefs of - #{TimerRef := TimerType} -> - %% We know of this timer; is it a running - %% timer or a timer being cancelled that - %% managed to send a late timeout message? - case TimerTypes of + 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, + Hibernate); + {'EXIT',Parent,Reason} = EXIT -> + %% EXIT is not a 2-tuple therefore + %% not an event but this will stand out + %% in the crash report... + Q = [EXIT], + terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q); + {timeout,TimerRef,TimerMsg} -> + #{timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := Hibernate} = S, + case TimerRefs of + #{TimerRef := TimerType} -> + %% We know of this timer; is it a running + %% timer or a timer being cancelled that + %% managed to send a late timeout message? + case TimerTypes of #{TimerType := TimerRef} -> - %% The timer type maps back to this - %% timer ref, so it was a running timer - Event = {TimerType,TimerMsg}, - %% Unregister the triggered timeout - NewTimerRefs = - maps:remove(TimerRef, TimerRefs), - NewTimerTypes = - maps:remove(TimerType, TimerTypes), - loop_receive_result( - Parent, Debug, - S#{ - timer_refs := NewTimerRefs, - timer_types := NewTimerTypes}, - Hibernate, - Event); + %% The timer type maps back to this + %% timer ref, so it was a running timer + Event = {TimerType,TimerMsg}, + %% Unregister the triggered timeout + NewTimerRefs = + maps:remove(TimerRef, TimerRefs), + NewTimerTypes = + maps:remove(TimerType, TimerTypes), + loop_receive_result( + Parent, Debug, + S#{ + timer_refs := NewTimerRefs, + timer_types := NewTimerTypes}, + Hibernate, + Event); _ -> - %% This was a late timeout message - %% from timer being cancelled, so - %% ignore it and expect a cancel_timer - %% msg shortly - loop_receive(Parent, Debug, S) - end; - _ -> - %% Not our timer; present it as an event - Event = {info,Msg}, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) - end; -handle_received_msg({cancel_timer,TimerRef,_} = Msg, Parent, Debug, S) -> - #{timer_refs := TimerRefs, - cancel_timers := CancelTimers, - hibernate := Hibernate} = S, - case TimerRefs of - #{TimerRef := _} -> - %% We must have requested a cancel - %% of this timer so it is already - %% removed from TimerTypes - NewTimerRefs = + %% This was a late timeout message + %% from timer being cancelled, so + %% ignore it and expect a cancel_timer + %% msg shortly + loop_receive(Parent, Debug, S) + end; + _ -> + %% Not our timer; present it as an event + Event = {info,Msg}, + loop_receive_result( + Parent, Debug, S, Hibernate, Event) + end; + {cancel_timer,TimerRef,_} -> + #{timer_refs := TimerRefs, + cancel_timers := CancelTimers, + hibernate := Hibernate} = S, + case TimerRefs of + #{TimerRef := _} -> + %% We must have requested a cancel + %% of this timer so it is already + %% removed from TimerTypes + NewTimerRefs = maps:remove(TimerRef, TimerRefs), - NewCancelTimers = CancelTimers - 1, - NewS = + NewCancelTimers = CancelTimers - 1, + NewS = S#{ - timer_refs := NewTimerRefs, - cancel_timers := NewCancelTimers}, - if + timer_refs := NewTimerRefs, + cancel_timers := NewCancelTimers}, + if Hibernate =:= true, NewCancelTimers =:= 0 -> - %% No more cancel_timer msgs to expect; - %% we can hibernate - loop_hibernate(Parent, Debug, NewS); + %% No more cancel_timer msgs to expect; + %% we can hibernate + loop_hibernate(Parent, Debug, NewS); NewCancelTimers >= 0 -> % Assert - loop_receive(Parent, Debug, NewS) - end; + loop_receive(Parent, Debug, NewS) + end; + _ -> + %% Not our cancel_timer msg; + %% present it as an event + Event = {info,Msg}, + loop_receive_result( + Parent, Debug, S, Hibernate, Event) + end; _ -> - %% Not our cancel_timer msg; - %% present it as an event - Event = {info,Msg}, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) - end; -handle_received_msg(Msg, Parent, Debug, S) -> - %% External msg - #{hibernate := Hibernate} = S, - Event = - case Msg of - {'$gen_call',From,Request} -> + %% External msg + #{hibernate := Hibernate} = S, + Event = + case Msg of + {'$gen_call',From,Request} -> {{call,From},Request}; - {'$gen_cast',E} -> + {'$gen_cast',E} -> {cast,E}; - _ -> + _ -> {info,Msg} - end, - loop_receive_result( - Parent, Debug, S, Hibernate, Event). + end, + loop_receive_result( + Parent, Debug, S, Hibernate, Event) + end + after + HibernateAfterTimeout -> + loop_hibernate(Parent, Debug, S) + end. loop_receive_result( Parent, Debug, diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl index 33441c75e0..5b9daecfd3 100644 --- a/lib/stdlib/test/gen_statem_SUITE.erl +++ b/lib/stdlib/test/gen_statem_SUITE.erl @@ -1323,7 +1323,36 @@ auto_hibernate(Config) -> is_not_in_erlang_hibernate(Pid), timer:sleep(HibernateAfterTimeout), is_in_erlang_hibernate(Pid), - + %% Timer test 1 + TimerTimeout1 = 50, + ok = gen_statem:call(Pid, {arm_htimer, self(), TimerTimeout1}), + is_not_in_erlang_hibernate(Pid), + timer:sleep(TimerTimeout1), + is_not_in_erlang_hibernate(Pid), + receive + {Pid, htimer_armed} -> + ok + after 1000 -> + ct:fail(timer1) + end, + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + %% Timer test 2 + TimerTimeout2 = 150, + ok = gen_statem:call(Pid, {arm_htimer, self(), TimerTimeout2}), + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + receive + {Pid, htimer_armed} -> + ok + after 1000 -> + ct:fail(timer2) + end, + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), stop_it(Pid), process_flag(trap_exit, OldFl), receive @@ -1761,6 +1790,11 @@ idle(cast, {hping,Pid}, Data) -> {keep_state, Data}; idle({call, From}, hping, _Data) -> {keep_state_and_data, [{reply, From, hpong}]}; +idle({call, From}, {arm_htimer, Pid, Timeout}, _Data) -> + {keep_state_and_data, [{reply, From, ok}, {timeout, Timeout, {arm_htimer, Pid}}]}; +idle(timeout, {arm_htimer, Pid}, _Data) -> + Pid ! {self(), htimer_armed}, + keep_state_and_data; idle(cast, {connect,Pid}, Data) -> Pid ! accept, {next_state,wfor_conf,Data,infinity}; % NoOp timeout just to test API |