gnu: guile-fibers: Apply upstream patch fixing libevent timers.

* gnu/packages/patches/guile-fibers-libevent-timeout.patch: New file.
* gnu/local.mk (dist_patch_DATA): Add it.
* gnu/packages/guile-xyz.scm (guile-fibers)[source]: Use it.

Change-Id: I872ffe5b193087234d29eed399d6db518c5af4d5

3 files changed, 66 insertions, 3 deletions

diff --git a/gnu/local.mk b/gnu/local.mk
index 46da9a8adc..16a34065c6 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012-2023 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012-2024 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2022, 2023 Andreas Enge <andreas@enge.fr>
 # Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
 # Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Mark H Weaver <mhw@netris.org>
@@ -1384,6 +1384,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/guile-fibers-fd-finalizer-leak.patch	\
   %D%/packages/patches/guile-fibers-wait-for-io-readiness.patch \
   %D%/packages/patches/guile-fibers-libevent-32-bit.patch	\
+  %D%/packages/patches/guile-fibers-libevent-timeout.patch	\
   %D%/packages/patches/guile-fix-invalid-unicode-handling.patch \
   %D%/packages/patches/guile-gdbm-ffi-support-gdbm-1.14.patch	\
   %D%/packages/patches/guile-git-adjust-for-libgit2-1.2.0.patch \
diff --git a/gnu/packages/guile-xyz.scm b/gnu/packages/guile-xyz.scm
index 9dc1176797..520b838d88 100644
--- a/gnu/packages/guile-xyz.scm
+++ b/gnu/packages/guile-xyz.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014, 2015, 2018 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015, 2017, 2022 Christine Lemmer-Webber <cwebber@dustycloud.org>
 ;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
@@ -816,7 +816,8 @@ tables.")
                (base32
                 "0wvdi4l58f9a5c9wi3cdc9l1bniscsixb6w2zj86mch7j7j814lc"))
               (patches
-               (search-patches "guile-fibers-libevent-32-bit.patch"))))
+               (search-patches "guile-fibers-libevent-32-bit.patch"
+                               "guile-fibers-libevent-timeout.patch"))))
     (build-system gnu-build-system)
     (arguments
      (list #:make-flags
diff --git a/gnu/packages/patches/guile-fibers-libevent-timeout.patch b/gnu/packages/patches/guile-fibers-libevent-timeout.patch
new file mode 100644
index 0000000000..c33678eea3
--- /dev/null
+++ b/gnu/packages/patches/guile-fibers-libevent-timeout.patch
@@ -0,0 +1,61 @@
+commit 2ca397bfcca94c106380368b5b0ce920b0a62a95
+Author: Ludovic Courtès <ludo@gnu.org>
+Date:   Sat Jan 6 16:22:45 2024 +0100
+
+    libevent: Fix computation of the timeout value.
+    
+diff --git a/extensions/libevent.c b/extensions/libevent.c
+index 134460a..62e50a3 100644
+--- a/extensions/libevent.c
++++ b/extensions/libevent.c
+@@ -192,30 +192,27 @@ scm_primitive_resize (SCM lst, SCM eventsv)
+ }
+ #undef FUNC_NAME
+ 
+-static uint64_t time_units_per_microsec;
++static uint64_t time_units_per_microsec, microsec_per_time_units;
+ 
+ static void*
+ run_event_loop (void *p)
+ #define FUNC_NAME "primitive-event-loop"
+ {
+-  int ret = 0;
+-  int microsec = 0;
+-  struct timeval tv;
+-
++  int ret;
+   struct loop_data *data = p;
+ 
+-  if (data->timeout < 0)
+-    microsec = -1;
+-  else if (data->timeout >= 0)
++  if (data->timeout >= 0)
+     {
+-      microsec = (time_units_per_microsec == 0)
+-	? 0 : data->timeout / time_units_per_microsec;
+-      tv.tv_sec = 0;
+-      tv.tv_usec = microsec;
+-    }
++      struct timeval tv;
++
++      tv.tv_sec = data->timeout / scm_c_time_units_per_second;
++      tv.tv_usec =
++	time_units_per_microsec > 0
++	? ((data->timeout % scm_c_time_units_per_second)
++	   / time_units_per_microsec)
++	: ((data->timeout % scm_c_time_units_per_second)
++	   * microsec_per_time_units);
+ 
+-  if (microsec >= 0)
+-    {
+       ret = event_base_loopexit (data->base, &tv);
+       if (ret == -1)
+         SCM_MISC_ERROR ("event loop exit failed", SCM_EOL);
+@@ -307,6 +304,7 @@ void
+ init_fibers_libevt (void)
+ {
+   time_units_per_microsec = scm_c_time_units_per_second / 1000000;
++  microsec_per_time_units = 1000000 / scm_c_time_units_per_second;
+ 
+   scm_c_define_gsubr ("primitive-event-wake", 1, 0, 0,
+                       scm_primitive_event_wake);