guix_mirror_bot pushed a commit to branch guile-fibers-fix-timer-wheel-patch in repository guix.
commit 7ea5b17465716f9f6e7d24589ede0d851481ce08 Author: Christopher Baines <[email protected]> AuthorDate: Mon Jul 27 11:23:13 2026 +0100 gnu: guile-fibers: Add fix timer wheel patch. This fixes this issue https://codeberg.org/guile/fibers/issues/183 . Patch taken from https://codeberg.org/guile/fibers/pulls/184 . * gnu/packages/patches/guile-fibers-fix-timer-wheel-remove.patch: New file. * gnu/local.mk (dist_patch_DATA): Add it. * gnu/packages/guile-xyz.scm (guile-fibers-1.4)[source]: Add patch. Change-Id: Ifbef990b183ce7aacafb9aa75d1bcc1f4f72b23d --- gnu/local.mk | 1 + gnu/packages/guile-xyz.scm | 3 +- .../guile-fibers-fix-timer-wheel-remove.patch | 117 +++++++++++++++++++++ 3 files changed, 120 insertions(+), 1 deletion(-) diff --git a/gnu/local.mk b/gnu/local.mk index e6ad5d9094..56a9d842db 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -1573,6 +1573,7 @@ dist_patch_DATA = \ %D%/packages/patches/guile-fibers-cross-build-fix.patch \ %D%/packages/patches/guile-fibers-epoll-instance-is-dead.patch \ %D%/packages/patches/guile-fibers-fd-finalizer-leak.patch \ + %D%/packages/patches/guile-fibers-fix-timer-wheel-remove.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 \ diff --git a/gnu/packages/guile-xyz.scm b/gnu/packages/guile-xyz.scm index f7fa9cd540..a272b74c3c 100644 --- a/gnu/packages/guile-xyz.scm +++ b/gnu/packages/guile-xyz.scm @@ -1221,7 +1221,8 @@ is not available for Guile 2.0.") (sha256 (base32 "1q0a9y0cc8rld1z7mcj61fkldhd0kn9n4yq25izxslbgg4g5h9j6")) - (patches '()))) + (patches + (search-patches "guile-fibers-fix-timer-wheel-remove.patch")))) (arguments (if (target-aarch64?) (list #:phases diff --git a/gnu/packages/patches/guile-fibers-fix-timer-wheel-remove.patch b/gnu/packages/patches/guile-fibers-fix-timer-wheel-remove.patch new file mode 100644 index 0000000000..33baeb1be4 --- /dev/null +++ b/gnu/packages/patches/guile-fibers-fix-timer-wheel-remove.patch @@ -0,0 +1,117 @@ +From 68d39f3421ece06bcb5f2dffb309024214b003e3 Mon Sep 17 00:00:00 2001 +From: Christopher Baines <[email protected]> +Date: Wed, 20 May 2026 13:04:51 +0200 +Subject: [PATCH] timer-wheel: Join up removal behaviour between advance! and + remove! + +timer-wheel-advance! can move entries to other wheels, but it can also +change the next pointer of the previous entry to no longer point at +the current entry, effectively removing it from the wheel. + +With previous behaviour of timer-wheel-remove!, always changing the +next and previous entries next and previous values to "remove" the +current entry, and after this setting the next and previous values of +the current entry to point at the entry itself, this could result in a +wheel where there was a cycle in the next linked list. + +This commit addresses this behaviour by setting the next and previous +pointers of an entry to #f when it's advanced over and when +removed. timer-wheel-remove! then can't behave +incorrectly. timer-wheel-advance! also clears the obj and time fields +to be consistent with timer-wheel-remove!. + +* fibers/timer-wheel.scm (timer-wheel-remove!): Restore behaviour +checking prev and next. +(timer-wheel-advance!): Set entry fields to #f when they leave the +wheel. +* tests/timer-wheel.scm (test-remove): New procedure. + +Fixes: guile/fibers#183 +--- + fibers/timer-wheel.scm | 29 ++++++++++++++++++----------- + tests/timer-wheel.scm | 22 ++++++++++++++++++++++ + 2 files changed, 40 insertions(+), 11 deletions(-) + +diff --git a/fibers/timer-wheel.scm b/fibers/timer-wheel.scm +index 9bede30..5ff7446 100644 +--- a/fibers/timer-wheel.scm ++++ b/fibers/timer-wheel.scm +@@ -154,18 +154,15 @@ from @var{wheel}." + + (match entry + (($ <timer-entry> prev next) +- (set-timer-entry-next! prev next) +- (set-timer-entry-prev! entry entry) +- +- (set-timer-entry-prev! next prev) +- (set-timer-entry-next! entry entry) ++ (when (and prev next) ++ (set-timer-entry-next! prev next) ++ (set-timer-entry-prev! next prev) ++ (invalidate-next-entry-time! wheel)) + ++ (set-timer-entry-prev! entry #f) ++ (set-timer-entry-next! entry #f) + (set-timer-entry-obj! entry #f) +- (set-timer-entry-time! entry #f) +- +- ;; Removing ENTRY might have change the next entry time for WHEEL. +- ;; Thus invalidate it so that it gets recomputed. +- (invalidate-next-entry-time! wheel)))) ++ (set-timer-entry-time! entry #f)))) + + (define (timer-wheel-next-entry-time wheel) + (define (slot-min-time head) +@@ -266,7 +263,17 @@ from @var{wheel}." + (push-timer-entry! entry new-head))))) + (advance-wheel! outer add-to-inner!)) + +- (advance-wheel! wheel (lambda (entry t obj) (schedule! obj)))) ++ (advance-wheel! wheel (lambda (entry t obj) ++ ;; Entry no longer needed, so clear fields. ++ (set-timer-entry-obj! entry #f) ++ (set-timer-entry-time! entry #f) ++ ;; Clearing the next and prev prevents ++ ;; timer-wheel-remove! from trying to ++ ;; remove already removed entries. ++ (set-timer-entry-next! entry #f) ++ (set-timer-entry-prev! entry #f) ++ ++ (schedule! obj)))) + + (match wheel + (($ <timer-wheel> time-base shift cur slots outer) +diff --git a/tests/timer-wheel.scm b/tests/timer-wheel.scm +index 8fc86d2..0b3ba96 100644 +--- a/tests/timer-wheel.scm ++++ b/tests/timer-wheel.scm +@@ -71,4 +71,26 @@ + (timer-wheel-advance! wheel (timer-wheel-next-tick-end wheel) check!) + (unless (= count event-count) (error "what4" count event-count))) + ++(define (test-remove) ++ (let* ((wheel (make-timer-wheel)) ++ (t0 (timer-wheel-next-tick-start wheel)) ++ (a (timer-wheel-add! wheel t0 'a)) ++ (b (timer-wheel-add! wheel t0 'b))) ++ (timer-wheel-advance! wheel (timer-wheel-next-tick-end wheel) ++ (lambda (obj) #t)) ++ ++ (timer-wheel-remove! wheel b) ++ (timer-wheel-remove! wheel a) ++ ++ (sigaction SIGALRM ++ (lambda _ ++ (error "timer-wheel-next-entry-time hung"))) ++ (alarm 15) ++ ;; slot-min-time will loop forever ++ (timer-wheel-next-entry-time wheel) ++ (alarm 0))) ++ ++(display "starting timer-wheel self-test\n") + (self-test) ++(display "starting timer-wheel test-remove\n") ++(test-remove) +-- +2.54.0 +
