diff --git a/collects/tests/mzscheme/port.ss b/collects/tests/mzscheme/port.ss index 8356754c50..e177f2b556 100644 --- a/collects/tests/mzscheme/port.ss +++ b/collects/tests/mzscheme/port.ss @@ -574,6 +574,33 @@ (test (char->integer #\h) peek-byte r)) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Check that breaks are enabled properly: + +(let ([try + (lambda (read-char) + (let ([p (make-input-port + 'test + (lambda (bstr) never-evt) + (lambda (bstr skip-count progress-evt) never-evt) + void)]) + (let ([t (thread (lambda () (with-handlers ([exn:break? void]) + (read-char p))))]) + (sleep 0.1) + (break-thread t) + (sleep 0.1) + (test #f thread-running? t))))]) + (try sync) + (try sync/enable-break) + (parameterize-break #f (try sync/enable-break)) + (try read-char) + (try peek-char) + (try (lambda (x) (read-bytes-avail! (make-bytes 10) x))) + (try (lambda (x) (read-bytes-avail!/enable-break (make-bytes 10) x))) + (parameterize-break + #f + (try (lambda (x) (read-bytes-avail!/enable-break (make-bytes 10) x))))) + +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (report-errs) diff --git a/collects/tests/mzscheme/sync.ss b/collects/tests/mzscheme/sync.ss index e7a05c6d51..67ef4193ca 100644 --- a/collects/tests/mzscheme/sync.ss +++ b/collects/tests/mzscheme/sync.ss @@ -1030,6 +1030,19 @@ (mk-capturing 'pre) (mk-capturing 'act)))))) +;; ---------------------------------------- +;; Check wrap-evt result superceded by internally +;; installed constant (i.e., the input port): + +(let ([p (make-input-port + 'test + (lambda (bstr) never-evt) + (lambda (bstr skip-count progress-evt) + (wrap-evt always-evt (lambda (_) 17))) + void)]) + ;; Make sure we don't get 17 + (test p sync p)) + ;; ---------------------------------------- (report-errs)