racket/port: fix spinning by peeking-input-port on blocked input

pkgs/racket-test-core/tests/racket/portlib.rktl

@@ -472,6 +472,23 @@
   (try-peeking 'none)
   (try-peeking 'block))
 
+(when (run-unreliable-tests? 'timing)
+  (define (try get)
+    (define-values (in out) (make-pipe))
+    (write-char #\. out)
+    (let ((i (peeking-input-port in)))
+      (read-byte i)
+      (let loop ([tries 10])
+        (if (zero? tries)
+            (test #t values `(peeking-input-port-timing-test-failed ,get))
+            (let ([now (current-process-milliseconds)])
+              (get i)
+              (let ([spun (- (current-process-milliseconds) now)])
+                (unless (< spun (/ (* SLEEP-TIME 1000) 10))
+                  (loop (sub1 tries)))))))))
+  (try (lambda (i) (sync/timeout SLEEP-TIME (thread (lambda () (read-byte i))))))
+  (try (lambda (i) (sync/timeout SLEEP-TIME i))))
+
 ;; read synchronization events
 (define (go mk-hello sync atest btest)
   (test #t list? (list mk-hello sync atest btest))

racket/collects/racket/port.rkt

@@ -664,14 +664,25 @@
                             #:init-position [init-position 1])
   (define buffer-mode (or (file-stream-buffer-mode orig-in)
                           'block))
+  (define (make-evt delta)
+    (wrap-evt (if (= delta 0)
+                  orig-in
+                  (peek-bytes-evt 1 delta #f orig-in))
+              (lambda (v) 0)))
   (make-input-port/read-to-peek
    name
    (lambda (s)
      (let ([r (peek-bytes-avail!* s delta #f orig-in)])
-       (set! delta (+ delta (if (number? r) r 1)))
-       (if (eq? r 0) (wrap-evt orig-in (lambda (v) 0)) r)))
+       (cond
+         [(eq? r 0) (make-evt delta)]
+         [else
+          (set! delta (+ delta (if (number? r) r 1)))
+          r])))
    (lambda (s skip default)
-     (peek-bytes-avail!* s (+ delta skip) #f orig-in))
+     (define r (peek-bytes-avail!* s (+ delta skip) #f orig-in))
+     (cond
+       [(eq? r 0) (make-evt (+ delta skip))]
+       [else r]))
    void
    #f
    void