Merge pull request #455 from fadushin/wait-timeout-infinity-fix

This PR fixes calls to `timer:sleep` with `infinity` as a parameter.  Also does
range checking on integer values to ensure values are within range (per OTP).

This PR also fixes a bug in the handling of messages that have come in to a
process while it is waiting for a timeout. Previously, a process would resume
prematurely if it received a message in its mailbox and it was waiting with a
timeout.

As a result of these changes, the implementation of `timer:sleep` is greatly
simplified.

These changes are made under both the "Apache 2.0" and the "GNU Lesser General
Public License 2.1 or later" license terms (dual license).

SPDX-License-Identifier: Apache-2.0 OR LGPL-2.1-or-later

Author: bettio

libs/estdlib/src/timer.erl

@@ -22,18 +22,9 @@
 
 -export([sleep/1]).
 
--define(MAX_INT, 4294967295).
-
 -spec sleep(non_neg_integer() | infinity) -> ok.
-sleep(infinity) ->
-    receive
-        '$atomvm_timer_interrupt' ->
-            {error, unexpected_interrupt}
-    after ?MAX_INT -> sleep(infinity)
-    end;
-sleep(MSecs) ->
+sleep(Timeout) ->
     receive
-        '$atomvm_timer_interrupt' ->
-            {error, unexpected_interrupt}
-    after MSecs -> ok
+    after Timeout ->
+        ok
     end.

src/libAtomVM/opcodesswitch.h

@@ -2145,10 +2145,16 @@ static bool maybe_call_native(Context *ctx, AtomString module_name, AtomString f
                 DECODE_COMPACT_TERM(timeout, code, i, next_off)
 
                 #ifdef IMPL_EXECUTE_LOOP
-                    if (!term_is_integer(timeout) && UNLIKELY(timeout != INFINITY_ATOM)) {
+                    avm_int64_t t = 0;
+                    if (term_is_any_integer(timeout)) {
+                        t = term_maybe_unbox_int64(timeout);
+                        if (UNLIKELY(t < 0)) {
+                            RAISE_ERROR(TIMEOUT_VALUE_ATOM);
+                        }
+                    } else if (UNLIKELY(timeout != INFINITY_ATOM)) {
                         RAISE_ERROR(TIMEOUT_VALUE_ATOM);
                     }
-                    TRACE("wait_timeout/2, label: %i, timeout: %li\n", label, (long int) term_to_int32(timeout));
+                    TRACE("wait_timeout/2, label: %i, timeout: %li\n", label, (long int) t);
 
                     NEXT_INSTRUCTION(next_off);
                     //TODO: it looks like x[0] might be used instead of jump_to_on_restore
@@ -2159,10 +2165,10 @@ static bool maybe_call_native(Context *ctx, AtomString module_name, AtomString f
                     int needs_to_wait = 0;
                     if ((ctx->flags & (WaitingTimeout | WaitingTimeoutExpired)) == 0) {
                         if (timeout != INFINITY_ATOM) {
-                            scheduler_set_timeout(ctx, term_to_int32(timeout));
+                            scheduler_set_timeout(ctx, t);
                         }
                         needs_to_wait = 1;
-                    } else if ((ctx->flags & WaitingTimeout) == 0) {
+                    } else if ((ctx->flags & WaitingTimeout) != 0) {
                         needs_to_wait = 1;
                     } else if (!list_is_empty(&ctx->save_queue)) {
                         needs_to_wait = 1;

src/libAtomVM/scheduler.c

@@ -139,7 +139,7 @@ static void scheduler_timeout_callback(struct TimerWheelItem *it)
     scheduler_make_ready(ctx->global, ctx);
 }
 
-void scheduler_set_timeout(Context *ctx, uint32_t timeout)
+void scheduler_set_timeout(Context *ctx, avm_int64_t timeout)
 {
     GlobalContext *glb = ctx->global;
 

src/libAtomVM/scheduler.h

@@ -102,7 +102,7 @@ Context *scheduler_next(GlobalContext *global, Context *c);
  * @param ctx the context that will be put on sleep
  * @param timeout amount of time to be waited in milliseconds.
  */
-void scheduler_set_timeout(Context *ctx, uint32_t timeout);
+void scheduler_set_timeout(Context *ctx, avm_int64_t timeout);
 
 void scheduler_cancel_timeout(Context *ctx);
 

src/libAtomVM/timer_wheel.h

@@ -29,6 +29,7 @@ extern "C" {
 #include <stdint.h>
 
 #include "list.h"
+#include "term_typedef.h"
 
 struct TimerWheelItem;
 typedef void(timer_wheel_callback_t)(struct TimerWheelItem *);
@@ -84,7 +85,7 @@ static inline void timer_wheel_item_init(struct TimerWheelItem *it, timer_wheel_
     it->callback = cb;
 }
 
-static inline uint64_t timer_wheel_expiry_to_monotonic(const struct TimerWheel *tw, uint32_t expiry)
+static inline uint64_t timer_wheel_expiry_to_monotonic(const struct TimerWheel *tw, avm_int64_t expiry)
 {
     return tw->monotonic_time + expiry;
 }

tests/libs/estdlib/test_timer.erl

@@ -22,65 +22,61 @@
 
 -export([test/0]).
 
+-include("etest.hrl").
+
 test() ->
     ok = test_timer(),
-    ok = test_timer_interrupt(),
     ok = test_timer_loop(),
+    ok = test_timer_badargs(),
+    ok = test_infinity(),
     ok.
 
--include("etest.hrl").
-
 test_timer() ->
-    T0 = erlang:timestamp(),
+    T0 = erlang:system_time(millisecond),
     ok = timer:sleep(101),
-    T1 = erlang:timestamp(),
-    ok = etest:assert_true((to_ms(T1) - to_ms(T0)) >= 101),
+    T1 = erlang:system_time(millisecond),
+    ok = etest:assert_true((T1 - T0) >= 101),
     ok.
 
-test_timer_interrupt() ->
-    Self = self(),
-    Pid = spawn(fun() -> do_test_interrupt(Self) end),
-    receive
-        ready -> ok
-    end,
-
-    %% this message should not interrupt the timer
-    Pid ! try_to_interrupt,
-
-    Pid ! '$atomvm_timer_interrupt',
-    ?ASSERT_MATCH(pop_mailbox(), ok),
-    ok.
-
-pop_mailbox() ->
-    receive
-        X -> X
-    end.
-
-do_test_interrupt(Pid) ->
-    Pid ! ready,
-    case timer:sleep(infinity) of
-        {error, unexpected_interrupt} ->
-            Pid ! ok;
-        _ ->
-            Pid ! error
-    end.
-
 test_timer_loop() ->
     Self = self(),
     spawn(fun() ->
-        timer:sleep(220),
-        Self ! ping
+        Self ! ready,
+        timer:sleep(50),
+        Self ! noise
     end),
+    receive
+        ready ->
+            ok
+    end,
     ok = timer_loop(5).
 
 timer_loop(0) ->
-    ok;
+    receive
+        noise ->
+            ok;
+        SomethingElse ->
+            {error, SomethingElse}
+    end;
 timer_loop(I) ->
-    T0 = erlang:timestamp(),
+    T0 = erlang:system_time(millisecond),
     ok = timer:sleep(101),
-    T1 = erlang:timestamp(),
-    ok = etest:assert_true((to_ms(T1) - to_ms(T0)) >= 101),
+    T1 = erlang:system_time(millisecond),
+    ok = etest:assert_true((T1 - T0) >= 101),
     timer_loop(I - 1).
 
-to_ms({MegaSecs, Secs, MicroSecs}) ->
-    ((MegaSecs * 1000000 + Secs) * 1000 + MicroSecs div 1000).
+test_timer_badargs() ->
+    {'EXIT', {timeout_value, _}} = (catch timer:sleep(-1)),
+    {'EXIT', {timeout_value, _}} = (catch timer:sleep(not_infinity)),
+    ok.
+
+test_infinity() ->
+    Self = self(),
+    Pid = spawn(fun() ->
+        Self ! ok,
+        timer:sleep(infinity)
+    end),
+    receive
+        ok ->
+            ok = etest:assert_true(erlang:is_process_alive(Pid))
+    end.

tests/libs/estdlib/tests.erl

@@ -32,6 +32,6 @@ start() ->
         test_io_lib,
         test_maps,
         test_proplists,
-        % , test_timer TODO: enable it again, once we try a way to make it less flaky
+        test_timer,
         test_supervisor
     ]).