io: TCP port does not count as a file-stream port

This commit is contained in:
Matthew Flatt 2018-11-14 18:46:16 -07:00
parent 6abadc472e
commit 1e726581ef
4 changed files with 18 additions and 10 deletions

View File

@ -15,9 +15,6 @@
(current-directory (host:path->string (host:current-directory))) (current-directory (host:path->string (host:current-directory)))
(set-string->number?! string->number) (set-string->number?! string->number)
(get-machine-info)
(exit)
(define-syntax-rule (test expect rhs) (define-syntax-rule (test expect rhs)
(let ([e expect] (let ([e expect]
[v rhs]) [v rhs])
@ -686,6 +683,9 @@
(test l (sync l)) (test l (sync l))
(define-values (tai tao) (tcp-accept l)) (define-values (tai tao) (tcp-accept l))
(test #f (file-stream-port? i))
(test #f (file-stream-port? o))
(test 6 (write-string "hello\n" to)) (test 6 (write-string "hello\n" to))
(flush-output to) (flush-output to)
(test "hello" (read-line tai)) (test "hello" (read-line tai))

View File

@ -22,10 +22,12 @@
(lambda (fd name) (lambda (fd name)
(open-input-fd fd name (open-input-fd fd name
#:extra-data (tcp-data #f #t) #:extra-data (tcp-data #f #t)
#:file-stream? #f
#:network-error? #t)) #:network-error? #t))
(lambda (fd name) (lambda (fd name)
(open-output-fd fd name (open-output-fd fd name
#:extra-data (tcp-data #t #f) #:extra-data (tcp-data #t #f)
#:file-stream? #f
#:network-error? #t))))) #:network-error? #t)))))
(define (open-input-output-tcp fd name #:close? [close? #t]) (define (open-input-output-tcp fd name #:close? [close? #t])
@ -40,6 +42,7 @@
(unless (tcp-data-abandon-in? extra-data) (unless (tcp-data-abandon-in? extra-data)
(rktio_socket_shutdown rktio fd RKTIO_SHUTDOWN_READ))) (rktio_socket_shutdown rktio fd RKTIO_SHUTDOWN_READ)))
#:fd-refcount refcount #:fd-refcount refcount
#:file-stream? #f
#:network-error? #t) #:network-error? #t)
(open-output-fd fd name (open-output-fd fd name
#:extra-data extra-data #:extra-data extra-data
@ -50,6 +53,7 @@
(rktio_socket_shutdown rktio fd RKTIO_SHUTDOWN_WRITE))) (rktio_socket_shutdown rktio fd RKTIO_SHUTDOWN_WRITE)))
#:fd-refcount refcount #:fd-refcount refcount
#:buffer-mode 'block #:buffer-mode 'block
#:file-stream? #f
#:network-error? #t))) #:network-error? #t)))
(define (port-tcp-data p) (define (port-tcp-data p)

View File

@ -24,8 +24,9 @@
fd-port-fd fd-port-fd
maybe-fd-data-extra) maybe-fd-data-extra)
(struct fd-data (fd extra input?) (struct fd-data (fd extra input? file-stream?)
#:property prop:file-stream (lambda (fdd) (fd-data-fd fdd)) #:property prop:file-stream (lambda (fdd) (and (fd-data-file-stream? fdd)
(fd-data-fd fdd)))
#:property prop:data-place-message (lambda (port) #:property prop:data-place-message (lambda (port)
(lambda () (lambda ()
(fd-port->place-message port)))) (fd-port->place-message port))))
@ -62,11 +63,12 @@
#:on-close [on-close void] #:on-close [on-close void]
#:fd-refcount [fd-refcount (box 1)] #:fd-refcount [fd-refcount (box 1)]
#:custodian [cust (current-custodian)] #:custodian [cust (current-custodian)]
#:file-stream? [file-stream? #t]
#:network-error? [network-error? #f]) #:network-error? [network-error? #f])
(define-values (port buffer-control) (define-values (port buffer-control)
(open-input-peek-via-read (open-input-peek-via-read
#:name name #:name name
#:data (fd-data fd extra-data #t) #:data (fd-data fd extra-data #t file-stream?)
#:read-in #:read-in
;; in atomic mode ;; in atomic mode
(lambda (dest-bstr start end copy?) (lambda (dest-bstr start end copy?)
@ -108,6 +110,7 @@
#:on-close [on-close void] #:on-close [on-close void]
#:plumber [plumber (current-plumber)] #:plumber [plumber (current-plumber)]
#:custodian [cust (current-custodian)] #:custodian [cust (current-custodian)]
#:file-stream? [file-stream? #t]
#:network-error? [network-error? #f]) #:network-error? [network-error? #f])
(define buffer (make-bytes 4096)) (define buffer (make-bytes 4096))
(define buffer-start 0) (define buffer-start 0)
@ -175,7 +178,7 @@
(define port (define port
(make-core-output-port (make-core-output-port
#:name name #:name name
#:data (fd-output-data fd extra-data #f #:data (fd-output-data fd extra-data #f file-stream?
;; Flush function needed for `file-truncate`: ;; Flush function needed for `file-truncate`:
(lambda () (lambda ()
(atomically (atomically

View File

@ -7,12 +7,12 @@
file-stream-ref file-stream-ref
file-stream-port?) file-stream-port?)
;; Property value should be a funciton that returns a file descriptor ;; Property value should be a function that returns a file descriptor
(define-values (prop:file-stream file-stream? file-stream-ref) (define-values (prop:file-stream file-stream? file-stream-ref)
(make-struct-type-property 'file-stream)) (make-struct-type-property 'file-stream))
(define (file-stream-port? p) (define (file-stream-port? p)
(file-stream? (file-stream-ref
(core-port-data (core-port-data
(cond (cond
[(input-port? p) (->core-input-port p)] [(input-port? p) (->core-input-port p)]
@ -20,4 +20,5 @@
[else [else
(raise-argument-error 'file-stream-port? (raise-argument-error 'file-stream-port?
"port?" "port?"
p)])))) p)]))
#f))