From f31c6563e42c5bfb52f2ed5e6fcb5549f6aadeeb Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 27 Oct 2014 07:00:30 -0600
Subject: [PATCH] make `read-line` interruptable on a primitive port

Closes PR 14800

Merge to v6.1.1
---
 pkgs/racket-pkgs/racket-test/tests/racket/file.rktl | 8 ++++++++
 racket/src/racket/src/portfun.c                     | 2 ++
 2 files changed, 10 insertions(+)

diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/file.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/file.rktl
index 7f3223c32b..eb09e403ab 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/file.rktl
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/file.rktl
@@ -260,6 +260,14 @@
 (err/rt-test (read-line (current-input-port) 8))
 (err/rt-test (read-line (current-input-port) 'anyx))
 
+(when (file-exists? "/dev/zero")
+  ;; Make sure read-line is interruptable on a primitive port that
+  ;; has no line ending:
+  (define t (thread (lambda () (call-with-input-file* "/dev/zero" read-line))))
+  (sleep 0.1)
+  (kill-thread t)
+  (test #t thread-dead? t))
+
 (arity-test open-input-file 1 1)
 (err/rt-test (open-input-file 8))
 (err/rt-test (open-input-file "x" 8))
diff --git a/racket/src/racket/src/portfun.c b/racket/src/racket/src/portfun.c
index edd397d264..9402fe311c 100644
--- a/racket/src/racket/src/portfun.c
+++ b/racket/src/racket/src/portfun.c
@@ -3261,6 +3261,8 @@ do_read_line (int as_bytes, const char *who, int argc, Scheme_Object *argv[])
     }
     buf[i++] = ch;
     if (ch > 127) ascii = 0;
+
+    SCHEME_USE_FUEL(1);
   }
 
   if (as_bytes) {