Permalink
Browse files

transplant-output-port: defend against weird ports

Avoid an error within `transplant-output-port` if the given output
port's position somehow goes down instead of up.

Merge to v6.8
  • Loading branch information...
1 parent a860791 commit 7ef20dd606abd3fd2f5fbe648618a8a95b1bcb66 @mflatt mflatt committed Jan 11, 2017
Showing with 23 additions and 1 deletion.
  1. +22 −0 pkgs/racket-test-core/tests/racket/portlib.rktl
  2. +1 −1 racket/collects/racket/private/port.rkt
@@ -898,6 +898,28 @@
(test-values '(2 2 4) (lambda () (port-next-location i2)))
(test (file-stream-buffer-mode i) file-stream-buffer-mode i2))
+
+;; Check `transplant-output-port` on an uncooperative output port
+;; whose positions count down
+(let* ([pos 100]
+ [o (make-output-port
+ 'demo
+ always-evt
+ (lambda (bstr start end buffer? block?)
+ (define len (- end start))
+ (set! pos (- pos len))
+ len)
+ void
+ #f #f #f #f
+ void
+ (lambda () pos))])
+ (define o2 (transplant-output-port o #f 50))
+ (test 49 file-position o2)
+ (write-bytes #"hello" o2)
+ (test 44 file-position o2)
+ (write-bytes (make-bytes 80) o2)
+ (test 0 file-position o2))
+
;; --------------------------------------------------
(let-values ([(in out) (make-pipe)])
@@ -105,7 +105,7 @@
p
(lambda ()
(define v (file-position* p))
- (and v (+ delta v)))))
+ (and v (max 1 (+ delta v))))))
(case-lambda
[(mode) (file-stream-buffer-mode p mode)]
[() (file-stream-buffer-mode p)]))))

0 comments on commit 7ef20dd

Please sign in to comment.