From 730442069198578e12332e09be32f8cae952b8e4 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 14 Sep 2014 16:38:04 +0200 Subject: [PATCH] fix `peek` implementation in R6RS input ports The peek operation must not block, otherwise the port behaves badly for `sync`. Based on a bug report from Brett Stahlman. --- pkgs/r6rs-pkgs/r6rs-lib/r6rs/private/ports.rkt | 2 +- pkgs/r6rs-pkgs/r6rs-test/tests/r6rs/io/sync.rkt | 6 ++++++ 2 files changed, 7 insertions(+), 1 deletion(-) create mode 100644 pkgs/r6rs-pkgs/r6rs-test/tests/r6rs/io/sync.rkt diff --git a/pkgs/r6rs-pkgs/r6rs-lib/r6rs/private/ports.rkt b/pkgs/r6rs-pkgs/r6rs-lib/r6rs/private/ports.rkt index ab302937f4..a693e7fa96 100644 --- a/pkgs/r6rs-pkgs/r6rs-lib/r6rs/private/ports.rkt +++ b/pkgs/r6rs-pkgs/r6rs-lib/r6rs/private/ports.rkt @@ -164,7 +164,7 @@ n))) (lambda (bytes skip evt) (check-disconnect) - (let ([n (peek-bytes-avail! bytes skip evt port)]) + (let ([n (peek-bytes-avail!* bytes skip evt port)]) (if (eq? n 0) (wrap-evt port (lambda (v) 0)) n))) diff --git a/pkgs/r6rs-pkgs/r6rs-test/tests/r6rs/io/sync.rkt b/pkgs/r6rs-pkgs/r6rs-test/tests/r6rs/io/sync.rkt new file mode 100644 index 0000000000..1be9917aa5 --- /dev/null +++ b/pkgs/r6rs-pkgs/r6rs-test/tests/r6rs/io/sync.rkt @@ -0,0 +1,6 @@ +#lang racket +(require rnrs/io/ports-6) + +;; Make sure that an R6RS port plays ok with sync, +;; particularly when no input is available. +(void (sync/timeout 0 (standard-input-port)))