From 9d01faa36c5c6148104c155d388ca14ef8adb619 Mon Sep 17 00:00:00 2001
From: Taylor R Campbell <campbell@mumble.net>
Date: Thu, 3 Jan 2019 16:35:11 +0000
Subject: [PATCH] Detect trivial infinite recursion in promises.

Obviously this can be fooled, like

(force (let loop () (delay-force (loop))))

or any non-halting Turing machine, but this is an easy case to detect
with negligible cost.
---
 src/runtime/boot.scm           |  2 ++
 tests/runtime/test-promise.scm | 14 ++++++--------
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/src/runtime/boot.scm b/src/runtime/boot.scm
index 68e62a00e..ea7e651b9 100644
--- a/src/runtime/boot.scm
+++ b/src/runtime/boot.scm
@@ -470,6 +470,8 @@ USA.
 	value
 	(let ((promise* (value)))
 	  (guarantee promise? promise* 'force)
+	  (if (eq? promise* promise)
+	      (error "Infinite recursion in promise:" promise))
 	  (without-interrupts
 	   (lambda ()
 	     (let ((q (cell-contents promise)))
diff --git a/tests/runtime/test-promise.scm b/tests/runtime/test-promise.scm
index c8af319e7..6291d8b20 100644
--- a/tests/runtime/test-promise.scm
+++ b/tests/runtime/test-promise.scm
@@ -71,15 +71,13 @@ USA.
 
 (define-test 'delay-force-loop
   (lambda ()
-    (expect-failure
+    (assert-error
      (lambda ()
-       (assert-error
-        (lambda ()
-          (carefully (lambda ()
-                       (define p (delay-force p))
-                       (force p))
-                     (lambda () 'stack-overflow)
-                     (lambda () 'timeout))))))))
+       (carefully (lambda ()
+                    (define p (delay-force p))
+                    (force p))
+                  (lambda () 'stack-overflow)
+                  (lambda () 'timeout))))))
 
 (define-test 'force-force-delay-delay
   (lambda ()
-- 
2.25.1