File 2022-Add-timer-apply_repeatedly-4.patch of Package erlang
From f9460ed7d09b44bdf559a42e5880d7f28d81f181 Mon Sep 17 00:00:00 2001
From: Maria Scott <maria-12648430@hnc-agency.org>
Date: Tue, 13 Sep 2022 21:52:41 +0200
Subject: [PATCH 2/4] Add timer:apply_repeatedly/4
`apply_repeatedly/4` is similar to `apply_interval/4` in that it
repeatedly spawns a process executing the given MFA. Other than
`apply_interval/4`, in case the execution time of the MFA
exceeds the given interval, `apply_repeatedly/4` waits for the
previously spawned process to finish before spawning a new one.
Co-authored-by: Jan Uhlig <juhlig@hnc-agency.org>
---
lib/stdlib/doc/src/timer.xml | 47 ++++++++--
lib/stdlib/src/timer.erl | 121 ++++++++++++++++++-------
lib/stdlib/test/timer_simple_SUITE.erl | 70 ++++++++++++++
3 files changed, 197 insertions(+), 41 deletions(-)
diff --git a/lib/stdlib/doc/src/timer.xml b/lib/stdlib/doc/src/timer.xml
index 11279ff410..2e9144f4a2 100644
--- a/lib/stdlib/doc/src/timer.xml
+++ b/lib/stdlib/doc/src/timer.xml
@@ -71,10 +71,10 @@
<funcs>
<func>
<name name="apply_after" arity="4" since=""/>
- <fsummary>Apply <c>Module:Function(Arguments)</c> after a specified
- <c>Time</c>.</fsummary>
+ <fsummary>Spawn a process evaluating <c>Module:Function(Arguments)</c>
+ after a specified <c>Time</c>.</fsummary>
<desc>
- <p>Evaluates <c>apply(<anno>Module</anno>, <anno>Function</anno>,
+ <p>Evaluates <c>spawn(<anno>Module</anno>, <anno>Function</anno>,
<anno>Arguments</anno>)</c> after <c><anno>Time</anno></c>
milliseconds.</p>
<p>Returns <c>{ok, <anno>TRef</anno>}</c> or
@@ -84,12 +84,45 @@
<func>
<name name="apply_interval" arity="4" since=""/>
- <fsummary>Evaluate <c>Module:Function(Arguments)</c> repeatedly at
- intervals of <c>Time</c>.</fsummary>
+ <fsummary>Spawn a process evaluating <c>Module:Function(Arguments)</c>
+ repeatedly at intervals of <c>Time</c>.</fsummary>
+ <desc>
+ <p>Evaluates <c>spawn(<anno>Module</anno>, <anno>Function</anno>,
+ <anno>Arguments</anno>)</c> repeatedly at intervals of
+ <c><anno>Time</anno></c>, irrespective of whether a previously
+ spawned process has finished or not.</p>
+ <warning>
+ <p>If the execution time of the spawned process is, on average,
+ greater than the given <c><anno>Time</anno></c>, multiple such
+ processes will run at the same time. With long execution times,
+ short intervals, and many interval timers running, this may even
+ lead to exceeding the number of allowed processes. As an extreme
+ example, consider
+ <c>[timer:apply_interval(1, timer, sleep, [1000]) || _ <- lists:seq(1, 1000)]</c>,
+ that is, 1,000 interval timers executing a process that takes 1s
+ to complete, started in intervals of 1ms, which would result in
+ 1,000,000 processes running at the same time, far more than a node
+ started with default settings allows (see the
+ <seeguide marker="system/efficiency_guide:advanced#system-limits">System
+ Limits section in the Effiency Guide</seeguide>).</p>
+ </warning>
+ <p>Returns <c>{ok, <anno>TRef</anno>}</c> or
+ <c>{error, <anno>Reason</anno>}</c>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="apply_repeatedly" arity="4" since="OTP 26.0"/>
+ <fsummary>Spawn a process evaluating <c>Module:Function(Arguments)</c>
+ repeatedly at intervals of <c>Time</c>.</fsummary>
<desc>
- <p>Evaluates <c>apply(<anno>Module</anno>, <anno>Function</anno>,
+ <p>Evaluates <c>spawn(<anno>Module</anno>, <anno>Function</anno>,
<anno>Arguments</anno>)</c> repeatedly at intervals of
- <c><anno>Time</anno></c>.</p>
+ <c><anno>Time</anno></c>, waiting for the spawned process to
+ finish before starting the next.</p>
+ <p>If the execution time of the spawned process is greater than the
+ given <c><anno>Time</anno></c>, the next process is spawned immediately
+ after the one currently running has finished.</p>
<p>Returns <c>{ok, <anno>TRef</anno>}</c> or
<c>{error, <anno>Reason</anno>}</c>.</p>
</desc>
diff --git a/lib/stdlib/src/timer.erl b/lib/stdlib/src/timer.erl
index 9e0be80df8..6ae09cf16e 100644
--- a/lib/stdlib/src/timer.erl
+++ b/lib/stdlib/src/timer.erl
@@ -22,7 +22,8 @@
-export([apply_after/4,
send_after/3, send_after/2,
exit_after/3, exit_after/2, kill_after/2, kill_after/1,
- apply_interval/4, send_interval/3, send_interval/2,
+ apply_interval/4, apply_repeatedly/4,
+ send_interval/3, send_interval/2,
cancel/1, sleep/1, tc/1, tc/2, tc/3, now_diff/2,
seconds/1, minutes/1, hours/1, hms/3]).
@@ -61,7 +62,7 @@
Reason :: term().
apply_after(0, M, F, A)
when ?valid_mfa(M, F, A) ->
- do_apply({M, F, A}),
+ _ = do_apply({M, F, A}, false),
{ok, {instant, make_ref()}};
apply_after(Time, M, F, A)
when ?valid_time(Time),
@@ -160,6 +161,21 @@ apply_interval(Time, M, F, A)
apply_interval(_Time, _M, _F, _A) ->
{error, badarg}.
+-spec apply_repeatedly(Time, Module, Function, Arguments) ->
+ {'ok', TRef} | {'error', Reason}
+ when Time :: time(),
+ Module :: module(),
+ Function :: atom(),
+ Arguments :: [term()],
+ TRef :: tref(),
+ Reason :: term().
+apply_repeatedly(Time, M, F, A)
+ when ?valid_time(Time),
+ ?valid_mfa(M, F, A) ->
+ req(apply_repeatedly, {system_time(), Time, self(), {M, F, A}});
+apply_repeatedly(_Time, _M, _F, _A) ->
+ {error, badarg}.
+
-spec send_interval(Time, Destination, Message) -> {'ok', TRef} | {'error', Reason}
when Time :: time(),
Destination :: pid() | (RegName :: atom()) | {RegName :: atom(), Node :: node()},
@@ -399,15 +415,11 @@ handle_call({apply_once, {Started, Time, MFA}}, _From, Tab) ->
{reply, Reply, Tab};
%% Start an interval timer.
handle_call({apply_interval, {Started, Time, Pid, MFA}}, _From, Tab) ->
- Tag = make_ref(),
- TimeServerPid = self(),
- {TPid, TRef} = spawn_monitor(fun() ->
- TimeServerRef = monitor(process, TimeServerPid),
- TargetRef = monitor(process, Pid),
- NextTimeout = Started + Time,
- TimerRef = erlang:start_timer(NextTimeout, self(), {apply_interval, NextTimeout, Time, MFA}, [{abs, true}]),
- _ = interval_loop(TimeServerRef, TargetRef, Tag, TimerRef)
- end),
+ {TRef, TPid, Tag} = start_interval_loop(Started, Time, Pid, MFA, false),
+ ets:insert(Tab, {TRef, TPid, Tag}),
+ {reply, {ok, {interval, TRef}}, Tab};
+handle_call({apply_repeatedly, {Started, Time, Pid, MFA}}, _From, Tab) ->
+ {TRef, TPid, Tag} = start_interval_loop(Started, Time, Pid, MFA, true),
ets:insert(Tab, {TRef, TPid, Tag}),
{reply, {ok, {interval, TRef}}, Tab};
%% Cancel a one-shot timer.
@@ -432,9 +444,9 @@ handle_call(_Req, _From, Tab) ->
when Tab :: ets:tid().
%% One-shot timer timeout.
handle_info({timeout, TRef, {apply_once, MFA}}, Tab) ->
- case ets:take(Tab, TRef) of
+ _ = case ets:take(Tab, TRef) of
[{TRef}] ->
- do_apply(MFA);
+ do_apply(MFA, false);
[] ->
ok
end,
@@ -466,8 +478,8 @@ terminate(Reason, Tab) ->
TPid ! {cancel, Tag},
Acc
end,
- undefined,
- Tab),
+ undefined,
+ Tab),
true = ets:delete(Tab),
terminate(Reason, undefined).
@@ -476,8 +488,19 @@ code_change(_OldVsn, Tab, _Extra) ->
%% According to the man for gen server no timer can be set here.
{ok, Tab}.
+start_interval_loop(Started, Time, TargetPid, MFA, WaitComplete) ->
+ Tag = make_ref(),
+ TimeServerPid = self(),
+ {TPid, TRef} = spawn_monitor(fun() ->
+ TimeServerRef = monitor(process, TimeServerPid),
+ TargetRef = monitor(process, TargetPid),
+ TimerRef = schedule_interval_timer(Started, Time, MFA),
+ _ = interval_loop(TimeServerRef, TargetRef, Tag, WaitComplete, TimerRef)
+ end),
+ {TRef, TPid, Tag}.
+
%% Interval timer loop.
-interval_loop(TimerServerMon, TargetMon, Tag, TimerRef0) ->
+interval_loop(TimerServerMon, TargetMon, Tag, WaitComplete, TimerRef0) ->
receive
{cancel, Tag} ->
ok = cancel_timer(TimerRef0);
@@ -486,16 +509,34 @@ interval_loop(TimerServerMon, TargetMon, Tag, TimerRef0) ->
{'DOWN', TargetMon, process, _, _} ->
ok = cancel_timer(TimerRef0);
{timeout, TimerRef0, {apply_interval, CurTimeout, Time, MFA}} ->
- do_apply(MFA),
- NextTimeout = CurTimeout + Time,
- TimerRef1 = case NextTimeout =< system_time() of
- true ->
- self() ! {timeout, TimerRef0, {apply_interval, NextTimeout, Time, MFA}},
- TimerRef0;
- false ->
- erlang:start_timer(NextTimeout, self(), {apply_interval, NextTimeout, Time, MFA}, [{abs, true}])
- end,
- interval_loop(TimerServerMon, TargetMon, Tag, TimerRef1)
+ case do_apply(MFA, WaitComplete) of
+ {ok, {spawn, ActionMon}} ->
+ receive
+ {cancel, Tag} ->
+ ok;
+ {'DOWN', TimerServerMon, process, _, _} ->
+ ok;
+ {'DOWN', TargetMon, process, _, _} ->
+ ok;
+ {'DOWN', ActionMon, process, _, _} ->
+ TimerRef1 = schedule_interval_timer(CurTimeout, Time, MFA),
+ interval_loop(TimerServerMon, TargetMon, Tag, WaitComplete, TimerRef1)
+ end;
+ _ ->
+ TimerRef1 = schedule_interval_timer(CurTimeout, Time, MFA),
+ interval_loop(TimerServerMon, TargetMon, Tag, WaitComplete, TimerRef1)
+ end
+ end.
+
+schedule_interval_timer(CurTimeout, Time, MFA) ->
+ NextTimeout = CurTimeout + Time,
+ case NextTimeout =< system_time() of
+ true ->
+ TimerRef = make_ref(),
+ self() ! {timeout, TimerRef, {apply_interval, NextTimeout, Time, MFA}},
+ TimerRef;
+ false ->
+ erlang:start_timer(NextTimeout, self(), {apply_interval, NextTimeout, Time, MFA}, [{abs, true}])
end.
%% Remove a timer.
@@ -505,9 +546,7 @@ remove_timer(TRef, Tab) ->
ok = cancel_timer(TRef),
true;
[{TRef, TPid, Tag}] -> % Interval timer.
- Mon = monitor(process, TPid),
TPid ! {cancel, Tag},
- receive {'DOWN', Mon, process, _, _} -> ok end,
true;
[] -> % TimerReference does not exist, do nothing
false
@@ -520,13 +559,27 @@ cancel_timer(TRef) ->
%% Help functions
%% If send op. send directly (faster than spawn)
-do_apply({?MODULE, send, A}) ->
- catch send(A);
+do_apply({?MODULE, send, A}, _) ->
+ try send(A)
+ of _ -> {ok, send}
+ catch _:_ -> error
+ end;
%% If exit op. resolve registered name
-do_apply({erlang, exit, [Name, Reason]}) ->
- catch exit(get_pid(Name), Reason);
-do_apply({M,F,A}) ->
- catch spawn(M, F, A).
+do_apply({erlang, exit, [Name, Reason]}, _) ->
+ try exit(get_pid(Name), Reason)
+ of _ -> {ok, exit}
+ catch _:_ -> error
+ end;
+do_apply({M,F,A}, false) ->
+ try spawn(M, F, A)
+ of _ -> {ok, spawn}
+ catch _:_ -> error
+ end;
+do_apply({M, F, A}, true) ->
+ try spawn_monitor(M, F, A)
+ of {_, Ref} -> {ok, {spawn, Ref}}
+ catch _:_ -> error
+ end.
%% Get current time in milliseconds,
%% ceil'ed to the next millisecond.
diff --git a/lib/stdlib/test/timer_simple_SUITE.erl b/lib/stdlib/test/timer_simple_SUITE.erl
index 1a3ac2716f..7b7055a602 100644
--- a/lib/stdlib/test/timer_simple_SUITE.erl
+++ b/lib/stdlib/test/timer_simple_SUITE.erl
@@ -51,7 +51,11 @@
kill_after2/1,
kill_after3/1,
apply_interval1/1,
+ apply_interval2/1,
apply_interval_invalid_args/1,
+ apply_repeatedly1/1,
+ apply_repeatedly2/1,
+ apply_repeatedly_invalid_args/1,
send_interval1/1,
send_interval2/1,
send_interval3/1,
@@ -95,6 +99,7 @@ all() ->
{group, exit_after},
{group, kill_after},
{group, apply_interval},
+ {group, apply_repeatedly},
{group, send_interval},
{group, cancel},
{group, sleep},
@@ -152,9 +157,19 @@ groups() ->
[],
[
apply_interval1,
+ apply_interval2,
apply_interval_invalid_args
]
},
+ {
+ apply_repeatedly,
+ [],
+ [
+ apply_repeatedly1,
+ apply_repeatedly2,
+ apply_repeatedly_invalid_args
+ ]
+ },
{
send_interval,
[],
@@ -406,6 +421,23 @@ apply_interval1(Config) when is_list(Config) ->
{ok, cancel} = timer:cancel(Ref),
nor = get_mess(1000, Msg).
+%% Test apply_interval with the execution time of the action
+%% longer than the timer interval. The timer should not wait for
+%% the action to complete, ie start another action while the
+%% previously started action is still running.
+apply_interval2(Config) when is_list(Config) ->
+ Msg = make_ref(),
+ Self = self(),
+ {ok, Ref} = timer:apply_interval(500, erlang, apply,
+ [fun() ->
+ Self ! Msg,
+ receive after 1000 -> ok end
+ end, []]),
+ receive after 1800 -> ok end,
+ {ok, cancel} = timer:cancel(Ref),
+ ok = get_mess(1000, Msg, 3),
+ nor = get_mess(1000, Msg).
+
%% Test that apply_interval rejects invalid arguments.
apply_interval_invalid_args(Config) when is_list(Config) ->
{error, badarg} = timer:apply_interval(-1, foo, bar, []),
@@ -414,6 +446,44 @@ apply_interval_invalid_args(Config) when is_list(Config) ->
{error, badarg} = timer:apply_interval(0, foo, bar, baz),
ok.
+%% Test of apply_repeatedly by sending messages. Receive
+%% 3 messages, cancel the timer, and check that we do
+%% not get any more messages. In a case like this, ie where
+%% the execution time of the action is shorter than the timer
+%% interval, this should behave the same as apply_interval.
+apply_repeatedly1(Config) when is_list(Config) ->
+ Msg = make_ref(),
+ {ok, Ref} = timer:apply_repeatedly(1000, ?MODULE, send,
+ [self(), Msg]),
+ ok = get_mess(1500, Msg, 3),
+ {ok, cancel} = timer:cancel(Ref),
+ nor = get_mess(1000, Msg).
+
+%% Test apply_repeatedly with the execution time of the action
+%% longer than the timer interval. The timer should wait for
+%% the action to complete, ie not start another action until it
+%% has completed.
+apply_repeatedly2(Config) when is_list(Config) ->
+ Msg = make_ref(),
+ Self = self(),
+ {ok, Ref} = timer:apply_repeatedly(1, erlang, apply,
+ [fun() ->
+ Self ! Msg,
+ receive after 1000 -> ok end
+ end, []]),
+ receive after 2500 -> ok end,
+ {ok, cancel} = timer:cancel(Ref),
+ ok = get_mess(1000, Msg, 3),
+ nor = get_mess(1000, Msg).
+
+%% Test that apply_repeatedly rejects invalid arguments.
+apply_repeatedly_invalid_args(Config) when is_list(Config) ->
+ {error, badarg} = timer:apply_repeatedly(-1, foo, bar, []),
+ {error, badarg} = timer:apply_repeatedly(0, "foo", bar, []),
+ {error, badarg} = timer:apply_repeatedly(0, foo, "bar", []),
+ {error, badarg} = timer:apply_repeatedly(0, foo, bar, baz),
+ ok.
+
%% Test of send_interval/2. Receive 5 messages, cancel the timer, and
%% check that we do not get any more messages.
send_interval1(Config) when is_list(Config) ->
--
2.35.3
