io: fix file and TCP ports as place messages
This commit is contained in:
parent
a4bd83011b
commit
17c46c9c36
|
@ -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)))])
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
@ -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))
|
Loading…
Reference in New Issue
Block a user