Fix future-get with timeout

#1103
shirok · Jan 21, 2025 · 2ad1c83 · 2ad1c83
1 parent 9cc1b24
commit 2ad1c83
Show file tree

Hide file tree

Showing 3 changed files with 9 additions and 2 deletions.
diff --git a/ChangeLog b/ChangeLog
@@ -1,5 +1,8 @@
 2025-01-20  Shiro Kawai  <[email protected]>
 
+	* lib/control/future.scm (future-get): Fixed timeout bug
+	  https://github.com/shirok/Gauche/issues/1103
+
 	* lib/gauche/numutil.scm (inverse-mod): Added.
 
 2025-01-17  Shiro Kawai  <[email protected]>

diff --git a/lib/control/future.scm b/lib/control/future.scm
@@ -76,5 +76,6 @@
 
 (define (future-get future :optional (timeout #f) (timeout-val #f))
   (assume-type future <future>)
-  (guard (e [(<uncaught-exception> e) (raise (~ e'reason))])
-    (apply values (thread-join! (~ future'%thread) timeout timeout-val))))
+  (guard (e [(uncaught-exception? e) (raise (~ e'reason))]
+            [else (raise e)])
+    (apply values (thread-join! (~ future'%thread) timeout (list timeout-val)))))
diff --git a/test/control.scm b/test/control.scm
@@ -243,6 +243,9 @@
   (test* "future error handling (propagated)" (test-error <error> "oops")
          (future-get f)))
 
+(test* "timeout" 'timeout
+       (future-get (future (sys-sleep 10)) 0.01 'timeout))
+
 ;;--------------------------------------------------------------------
 ;; control.pmap
 ;;