io: TCP port does not count as a file-stream port
This commit is contained in:
parent
6abadc472e
commit
1e726581ef
|
@ -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))
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user