+\f
+
+(with-test-prefix "setvbuf"
+
+ (pass-if "line/column number preserved"
+ ;; In Guile 2.0.5, `setvbuf' would erroneously decrease the port's
+ ;; line and/or column number.
+ (call-with-output-file (test-file)
+ (lambda (p)
+ (display "This is GNU Guile.\nWelcome." p)))
+ (call-with-input-file (test-file)
+ (lambda (p)
+ (and (eqv? #\T (read-char p))
+ (let ((line (port-line p))
+ (col (port-column p)))
+ (and (= line 0) (= col 1)
+ (begin
+ (setvbuf p _IOFBF 777)
+ (let ((line* (port-line p))
+ (col* (port-column p)))
+ (and (= line line*)
+ (= col col*)))))))))))
+
+\f
+
+(pass-if-equal "unget-bytevector"
+ #vu8(10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 200 201 202 203
+ 1 2 3 4 251 253 254 255)
+ (let ((port (open-bytevector-input-port #vu8(1 2 3 4 251 253 254 255))))
+ (unget-bytevector port #vu8(200 201 202 203))
+ (unget-bytevector port #vu8(20 21 22 23 24))
+ (unget-bytevector port #vu8(10 11 12 13 14 15 16 17 18 19) 4)
+ (unget-bytevector port #vu8(10 11 12 13 14 15 16 17 18 19) 2 2)
+ (unget-bytevector port #vu8(10 11))
+ (get-bytevector-all port)))
+
+\f
+
+(with-test-prefix "unicode byte-order marks (BOMs)"
+
+ (define (bv-read-test* encoding bv proc)
+ (let ((port (open-bytevector-input-port bv)))
+ (set-port-encoding! port encoding)
+ (proc port)))
+
+ (define (bv-read-test encoding bv)
+ (bv-read-test* encoding bv read-string))
+
+ (define (bv-write-test* encoding proc)
+ (call-with-values
+ (lambda () (open-bytevector-output-port))
+ (lambda (port get-bytevector)
+ (set-port-encoding! port encoding)
+ (proc port)
+ (get-bytevector))))
+
+ (define (bv-write-test encoding str)
+ (bv-write-test* encoding
+ (lambda (p)
+ (display str p))))
+
+ (pass-if-equal "BOM not discarded from Latin-1 stream"
+ "\xEF\xBB\xBF\x61"
+ (bv-read-test "ISO-8859-1" #vu8(#xEF #xBB #xBF #x61)))
+
+ (pass-if-equal "BOM not discarded from Latin-2 stream"
+ "\u010F\u0165\u017C\x61"
+ (bv-read-test "ISO-8859-2" #vu8(#xEF #xBB #xBF #x61)))
+
+ (pass-if-equal "BOM not discarded from UTF-16BE stream"
+ "\uFEFF\x61"
+ (bv-read-test "UTF-16BE" #vu8(#xFE #xFF #x00 #x61)))
+
+ (pass-if-equal "BOM not discarded from UTF-16LE stream"
+ "\uFEFF\x61"
+ (bv-read-test "UTF-16LE" #vu8(#xFF #xFE #x61 #x00)))
+
+ (pass-if-equal "BOM not discarded from UTF-32BE stream"
+ "\uFEFF\x61"
+ (bv-read-test "UTF-32BE" #vu8(#x00 #x00 #xFE #xFF
+ #x00 #x00 #x00 #x61)))
+
+ (pass-if-equal "BOM not discarded from UTF-32LE stream"
+ "\uFEFF\x61"
+ (bv-read-test "UTF-32LE" #vu8(#xFF #xFE #x00 #x00
+ #x61 #x00 #x00 #x00)))
+
+ (pass-if-equal "BOM not written to UTF-8 stream"
+ #vu8(#x61)
+ (bv-write-test "UTF-8" "a"))
+
+ (pass-if-equal "BOM not written to UTF-16BE stream"
+ #vu8(#x00 #x61)
+ (bv-write-test "UTF-16BE" "a"))
+
+ (pass-if-equal "BOM not written to UTF-16LE stream"
+ #vu8(#x61 #x00)
+ (bv-write-test "UTF-16LE" "a"))
+
+ (pass-if-equal "BOM not written to UTF-32BE stream"
+ #vu8(#x00 #x00 #x00 #x61)
+ (bv-write-test "UTF-32BE" "a"))
+
+ (pass-if-equal "BOM not written to UTF-32LE stream"
+ #vu8(#x61 #x00 #x00 #x00)
+ (bv-write-test "UTF-32LE" "a"))
+
+ (pass-if "Don't read from the port unless user asks to"
+ (let* ((p (make-soft-port
+ (vector
+ (lambda (c) #f) ; write char
+ (lambda (s) #f) ; write string
+ (lambda () #f) ; flush
+ (lambda () (throw 'fail)) ; read char
+ (lambda () #f))
+ "rw")))
+ (set-port-encoding! p "UTF-16")
+ (display "abc" p)
+ (set-port-encoding! p "UTF-32")
+ (display "def" p)
+ #t))
+
+ ;; TODO: test that input and output streams are independent when
+ ;; appropriate, and linked when appropriate.
+
+ (pass-if-equal "BOM discarded from start of UTF-8 stream"
+ "a"
+ (bv-read-test "Utf-8" #vu8(#xEF #xBB #xBF #x61)))
+
+ (pass-if-equal "BOM discarded from start of UTF-8 stream after seek to 0"
+ '(#\a "a")
+ (bv-read-test* "uTf-8" #vu8(#xEF #xBB #xBF #x61)
+ (lambda (p)
+ (let ((c (read-char p)))
+ (seek p 0 SEEK_SET)
+ (let ((s (read-string p)))
+ (list c s))))))
+
+ (pass-if-equal "Only one BOM discarded from start of UTF-8 stream"
+ "\uFEFFa"
+ (bv-read-test "UTF-8" #vu8(#xEF #xBB #xBF #xEF #xBB #xBF #x61)))
+
+ (pass-if-equal "BOM not discarded from UTF-8 stream after seek to > 0"
+ "\uFEFFb"
+ (bv-read-test* "UTF-8" #vu8(#x61 #xEF #xBB #xBF #x62)
+ (lambda (p)
+ (seek p 1 SEEK_SET)
+ (read-string p))))
+
+ (pass-if-equal "BOM not discarded unless at start of UTF-8 stream"
+ "a\uFEFFb"
+ (bv-read-test "UTF-8" #vu8(#x61 #xEF #xBB #xBF #x62)))
+
+ (pass-if-equal "BOM (BE) written to start of UTF-16 stream"
+ #vu8(#xFE #xFF #x00 #x61 #x00 #x62)
+ (bv-write-test "UTF-16" "ab"))
+
+ (pass-if-equal "BOM (BE) written to UTF-16 stream after set-port-encoding!"
+ #vu8(#xFE #xFF #x00 #x61 #x00 #x62 #xFE #xFF #x00 #x63 #x00 #x64)
+ (bv-write-test* "UTF-16"
+ (lambda (p)
+ (display "ab" p)
+ (set-port-encoding! p "UTF-16")
+ (display "cd" p))))
+
+ (pass-if-equal "BOM discarded from start of UTF-16 stream (BE)"
+ "a"
+ (bv-read-test "UTF-16" #vu8(#xFE #xFF #x00 #x61)))
+
+ (pass-if-equal "BOM discarded from start of UTF-16 stream (BE) after seek to 0"
+ '(#\a "a")
+ (bv-read-test* "utf-16" #vu8(#xFE #xFF #x00 #x61)
+ (lambda (p)
+ (let ((c (read-char p)))
+ (seek p 0 SEEK_SET)
+ (let ((s (read-string p)))
+ (list c s))))))
+
+ (pass-if-equal "Only one BOM discarded from start of UTF-16 stream (BE)"
+ "\uFEFFa"
+ (bv-read-test "Utf-16" #vu8(#xFE #xFF #xFE #xFF #x00 #x61)))
+
+ (pass-if-equal "BOM not discarded from UTF-16 stream (BE) after seek to > 0"
+ "\uFEFFa"
+ (bv-read-test* "uTf-16" #vu8(#xFE #xFF #xFE #xFF #x00 #x61)
+ (lambda (p)
+ (seek p 2 SEEK_SET)
+ (read-string p))))
+
+ (pass-if-equal "BOM not discarded unless at start of UTF-16 stream"
+ "a\uFEFFb"
+ (bv-read-test "utf-16" #vu8(#x00 #x61 #xFE #xFF #x00 #x62)))
+
+ (pass-if-equal "BOM discarded from start of UTF-16 stream (LE)"
+ "a"
+ (bv-read-test "UTF-16" #vu8(#xFF #xFE #x61 #x00)))
+
+ (pass-if-equal "BOM discarded from start of UTF-16 stream (LE) after seek to 0"
+ '(#\a "a")
+ (bv-read-test* "Utf-16" #vu8(#xFF #xFE #x61 #x00)
+ (lambda (p)
+ (let ((c (read-char p)))
+ (seek p 0 SEEK_SET)
+ (let ((s (read-string p)))
+ (list c s))))))
+
+ (pass-if-equal "Only one BOM discarded from start of UTF-16 stream (LE)"
+ "\uFEFFa"
+ (bv-read-test "UTf-16" #vu8(#xFF #xFE #xFF #xFE #x61 #x00)))
+
+ (pass-if-equal "BOM discarded from start of UTF-32 stream (BE)"
+ "a"
+ (bv-read-test "UTF-32" #vu8(#x00 #x00 #xFE #xFF
+ #x00 #x00 #x00 #x61)))
+
+ (pass-if-equal "BOM discarded from start of UTF-32 stream (BE) after seek to 0"
+ '(#\a "a")
+ (bv-read-test* "utF-32" #vu8(#x00 #x00 #xFE #xFF
+ #x00 #x00 #x00 #x61)
+ (lambda (p)
+ (let ((c (read-char p)))
+ (seek p 0 SEEK_SET)
+ (let ((s (read-string p)))
+ (list c s))))))
+
+ (pass-if-equal "Only one BOM discarded from start of UTF-32 stream (BE)"
+ "\uFEFFa"
+ (bv-read-test "UTF-32" #vu8(#x00 #x00 #xFE #xFF
+ #x00 #x00 #xFE #xFF
+ #x00 #x00 #x00 #x61)))
+
+ (pass-if-equal "BOM not discarded from UTF-32 stream (BE) after seek to > 0"
+ "\uFEFFa"
+ (bv-read-test* "UtF-32" #vu8(#x00 #x00 #xFE #xFF
+ #x00 #x00 #xFE #xFF
+ #x00 #x00 #x00 #x61)
+ (lambda (p)
+ (seek p 4 SEEK_SET)
+ (read-string p))))
+
+ (pass-if-equal "BOM discarded within UTF-16 stream (BE) after set-port-encoding!"
+ "ab"
+ (bv-read-test* "UTF-16" #vu8(#x00 #x61 #xFE #xFF #x00 #x62)
+ (lambda (p)
+ (let ((a (read-char p)))
+ (set-port-encoding! p "UTF-16")
+ (string a (read-char p))))))
+
+ (pass-if-equal "BOM discarded within UTF-16 stream (LE,BE) after set-port-encoding!"
+ "ab"
+ (bv-read-test* "utf-16" #vu8(#x00 #x61 #xFF #xFE #x62 #x00)
+ (lambda (p)
+ (let ((a (read-char p)))
+ (set-port-encoding! p "UTF-16")
+ (string a (read-char p))))))
+
+ (pass-if-equal "BOM discarded within UTF-32 stream (BE) after set-port-encoding!"
+ "ab"
+ (bv-read-test* "UTF-32" #vu8(#x00 #x00 #x00 #x61
+ #x00 #x00 #xFE #xFF
+ #x00 #x00 #x00 #x62)
+ (lambda (p)
+ (let ((a (read-char p)))
+ (set-port-encoding! p "UTF-32")
+ (string a (read-char p))))))
+
+ (pass-if-equal "BOM discarded within UTF-32 stream (LE,BE) after set-port-encoding!"
+ "ab"
+ (bv-read-test* "UTF-32" #vu8(#x00 #x00 #x00 #x61
+ #xFF #xFE #x00 #x00
+ #x62 #x00 #x00 #x00)
+ (lambda (p)
+ (let ((a (read-char p)))
+ (set-port-encoding! p "UTF-32")
+ (string a (read-char p))))))
+
+ (pass-if-equal "BOM not discarded unless at start of UTF-32 stream"
+ "a\uFEFFb"
+ (bv-read-test "UTF-32" #vu8(#x00 #x00 #x00 #x61
+ #x00 #x00 #xFE #xFF
+ #x00 #x00 #x00 #x62)))
+
+ (pass-if-equal "BOM discarded from start of UTF-32 stream (LE)"
+ "a"
+ (bv-read-test "UTF-32" #vu8(#xFF #xFE #x00 #x00
+ #x61 #x00 #x00 #x00)))
+
+ (pass-if-equal "BOM discarded from start of UTF-32 stream (LE) after seek to 0"
+ '(#\a "a")
+ (bv-read-test* "UTf-32" #vu8(#xFF #xFE #x00 #x00
+ #x61 #x00 #x00 #x00)
+ (lambda (p)
+ (let ((c (read-char p)))
+ (seek p 0 SEEK_SET)
+ (let ((s (read-string p)))
+ (list c s))))))
+
+ (pass-if-equal "Only one BOM discarded from start of UTF-32 stream (LE)"
+ "\uFEFFa"
+ (bv-read-test "UTF-32" #vu8(#xFF #xFE #x00 #x00
+ #xFF #xFE #x00 #x00
+ #x61 #x00 #x00 #x00))))
+
+\f
+
+(define-syntax-rule (with-load-path path body ...)
+ (let ((new path)
+ (old %load-path))
+ (dynamic-wind
+ (lambda ()
+ (set! %load-path new))
+ (lambda ()
+ body ...)
+ (lambda ()
+ (set! %load-path old)))))
+
+(with-test-prefix "%file-port-name-canonicalization"
+
+ (pass-if-equal "absolute file name & empty %load-path entry" "/dev/null"
+ ;; In Guile 2.0.5 and earlier, this would return "dev/null" instead
+ ;; of "/dev/null". See
+ ;; <http://lists.gnu.org/archive/html/guile-devel/2012-05/msg00059.html>
+ ;; for a discussion.
+ (with-load-path (cons "" (delete "/" %load-path))
+ (with-fluids ((%file-port-name-canonicalization 'relative))
+ (port-filename (open-input-file "/dev/null")))))
+
+ (pass-if-equal "relative canonicalization with /" "dev/null"
+ (with-load-path (cons "/" %load-path)
+ (with-fluids ((%file-port-name-canonicalization 'relative))
+ (port-filename (open-input-file "/dev/null")))))
+
+ (pass-if-equal "relative canonicalization from ice-9" "ice-9/q.scm"
+ ;; If an entry in %LOAD-PATH is not canonical, then
+ ;; `scm_i_relativize_path' is unable to do its job.
+ (if (equal? (map canonicalize-path %load-path) %load-path)
+ (with-fluids ((%file-port-name-canonicalization 'relative))
+ (port-filename
+ (open-input-file (%search-load-path "ice-9/q.scm"))))
+ (throw 'unresolved)))
+
+ (pass-if-equal "absolute canonicalization from ice-9"
+ (canonicalize-path
+ (string-append (assoc-ref %guile-build-info 'top_srcdir)
+ "/module/ice-9/q.scm"))
+ (with-fluids ((%file-port-name-canonicalization 'absolute))
+ (port-filename (open-input-file (%search-load-path "ice-9/q.scm"))))))
+