io: fix file and TCP ports as place messages

This commit is contained in:
Matthew Flatt 2019-02-13 10:48:55 -07:00
parent a4bd83011b
commit 17c46c9c36
2 changed files with 7 additions and 34 deletions

View File

@ -16,8 +16,7 @@
"buffer-mode.rkt"
"close.rkt"
"count.rkt"
"check.rkt"
"place-message.rkt")
"check.rkt")
(provide (struct-out fd-input-port)
open-input-fd
@ -82,9 +81,9 @@
#:property
[prop:file-stream (lambda (p) (fd-input-port-fd p))]
[prop:data-place-message (lambda (port)
(lambda ()
(fd-port->place-message port)))])
[prop:place-message (lambda (port)
(lambda ()
(fd-port->place-message port)))])
;; ----------------------------------------
@ -288,9 +287,9 @@
(end-atomic)
(raise-rktio-error 'file-truncate result "error setting file size")]
[else result]))]
[prop:data-place-message (lambda (port)
(lambda ()
(fd-port->place-message port)))])
[prop:place-message (lambda (port)
(lambda ()
(fd-port->place-message port)))])
;; ----------------------------------------

View File

@ -1,26 +0,0 @@
#lang racket/base
;; To make certain kinds of ports allowed as a place message, a
;; `prop:place-message` property has to chain through properties on
;; the `data` field and, for an fd port, the `extra-data` field
(provide prop:data-place-message
data->place-message
prop:fd-extra-data-place-message
fd-extra-data->opener)
(define-values (prop:data-place-message data-place-message? data-place-message-ref)
(make-struct-type-property 'data-place-message))
(define (data->place-message data port)
(if (data-place-message? data)
((data-place-message-ref data) port)
#f))
(define-values (prop:fd-extra-data-place-message fd-extra-data-place-message? fd-extra-data-place-message-ref)
(make-struct-type-property 'fd-extra-data-place-message))
(define (fd-extra-data->opener extra-data port)
(if (fd-extra-data-place-message? extra-data)
((fd-extra-data-place-message-ref extra-data) port)
#f))