--- /dev/null
+;;;; ports.test --- test suite for Guile I/O ports -*- scheme -*-
+;;;; Jim Blandy <jimb@red-bean.com> --- May 1999
+;;;;
+;;;; Copyright (C) 1999, 2001, 2004, 2006, 2007 Free Software Foundation, Inc.
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2, or (at your option)
+;;;; any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this software; see the file COPYING. If not, write to
+;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;;; Boston, MA 02110-1301 USA
+
+(define-module (test-suite test-ports)
+ :use-module (test-suite lib)
+ :use-module (test-suite guile-test)
+ :use-module (ice-9 popen)
+ :use-module (ice-9 rdelim))
+
+(define (display-line . args)
+ (for-each display args)
+ (newline))
+
+(define (test-file)
+ (data-file-name "ports-test.tmp"))
+
+\f
+;;;; Some general utilities for testing ports.
+
+;;; Read from PORT until EOF, and return the result as a string.
+(define (read-all port)
+ (let loop ((chars '()))
+ (let ((char (read-char port)))
+ (if (eof-object? char)
+ (list->string (reverse! chars))
+ (loop (cons char chars))))))
+
+(define (read-file filename)
+ (let* ((port (open-input-file filename))
+ (string (read-all port)))
+ (close-port port)
+ string))
+
+\f
+;;;; Normal file ports.
+
+;;; Write out an s-expression, and read it back.
+(let ((string '("From fairest creatures we desire increase,"
+ "That thereby beauty's rose might never die,"))
+ (filename (test-file)))
+ (let ((port (open-output-file filename)))
+ (write string port)
+ (close-port port))
+ (let ((port (open-input-file filename)))
+ (let ((in-string (read port)))
+ (pass-if "file: write and read back list of strings"
+ (equal? string in-string)))
+ (close-port port))
+ (delete-file filename))
+
+;;; Write out a string, and read it back a character at a time.
+(let ((string "This is a test string\nwith no newline at the end")
+ (filename (test-file)))
+ (let ((port (open-output-file filename)))
+ (display string port)
+ (close-port port))
+ (let ((in-string (read-file filename)))
+ (pass-if "file: write and read back characters"
+ (equal? string in-string)))
+ (delete-file filename))
+
+;;; Buffered input/output port with seeking.
+(let* ((filename (test-file))
+ (port (open-file filename "w+")))
+ (display "J'Accuse" port)
+ (seek port -1 SEEK_CUR)
+ (pass-if "file: r/w 1"
+ (char=? (read-char port) #\e))
+ (pass-if "file: r/w 2"
+ (eof-object? (read-char port)))
+ (seek port -1 SEEK_CUR)
+ (write-char #\x port)
+ (seek port 7 SEEK_SET)
+ (pass-if "file: r/w 3"
+ (char=? (read-char port) #\x))
+ (seek port -2 SEEK_END)
+ (pass-if "file: r/w 4"
+ (char=? (read-char port) #\s))
+ (close-port port)
+ (delete-file filename))
+
+;;; Unbuffered input/output port with seeking.
+(let* ((filename (test-file))
+ (port (open-file filename "w+0")))
+ (display "J'Accuse" port)
+ (seek port -1 SEEK_CUR)
+ (pass-if "file: ub r/w 1"
+ (char=? (read-char port) #\e))
+ (pass-if "file: ub r/w 2"
+ (eof-object? (read-char port)))
+ (seek port -1 SEEK_CUR)
+ (write-char #\x port)
+ (seek port 7 SEEK_SET)
+ (pass-if "file: ub r/w 3"
+ (char=? (read-char port) #\x))
+ (seek port -2 SEEK_END)
+ (pass-if "file: ub r/w 4"
+ (char=? (read-char port) #\s))
+ (close-port port)
+ (delete-file filename))
+
+;;; Buffered output-only and input-only ports with seeking.
+(let* ((filename (test-file))
+ (port (open-output-file filename)))
+ (display "J'Accuse" port)
+ (pass-if "file: out tell"
+ (= (seek port 0 SEEK_CUR) 8))
+ (seek port -1 SEEK_CUR)
+ (write-char #\x port)
+ (close-port port)
+ (let ((iport (open-input-file filename)))
+ (pass-if "file: in tell 0"
+ (= (seek iport 0 SEEK_CUR) 0))
+ (read-char iport)
+ (pass-if "file: in tell 1"
+ (= (seek iport 0 SEEK_CUR) 1))
+ (unread-char #\z iport)
+ (pass-if "file: in tell 0 after unread"
+ (= (seek iport 0 SEEK_CUR) 0))
+ (pass-if "file: unread char still there"
+ (char=? (read-char iport) #\z))
+ (seek iport 7 SEEK_SET)
+ (pass-if "file: in last char"
+ (char=? (read-char iport) #\x))
+ (close-port iport))
+ (delete-file filename))
+
+;;; unusual characters.
+(let* ((filename (test-file))
+ (port (open-output-file filename)))
+ (display (string #\nul (integer->char 255) (integer->char 128)
+ #\nul) port)
+ (close-port port)
+ (let* ((port (open-input-file filename))
+ (line (read-line port)))
+ (pass-if "file: read back NUL 1"
+ (char=? (string-ref line 0) #\nul))
+ (pass-if "file: read back 255"
+ (char=? (string-ref line 1) (integer->char 255)))
+ (pass-if "file: read back 128"
+ (char=? (string-ref line 2) (integer->char 128)))
+ (pass-if "file: read back NUL 2"
+ (char=? (string-ref line 3) #\nul))
+ (pass-if "file: EOF"
+ (eof-object? (read-char port)))
+ (close-port port))
+ (delete-file filename))
+
+;;; line buffering mode.
+(let* ((filename (test-file))
+ (port (open-file filename "wl"))
+ (test-string "one line more or less"))
+ (write-line test-string port)
+ (let* ((in-port (open-input-file filename))
+ (line (read-line in-port)))
+ (close-port in-port)
+ (close-port port)
+ (pass-if "file: line buffering"
+ (string=? line test-string)))
+ (delete-file filename))
+
+;;; ungetting characters and strings.
+(with-input-from-string "walk on the moon\nmoon"
+ (lambda ()
+ (read-char)
+ (unread-char #\a (current-input-port))
+ (pass-if "unread-char"
+ (char=? (read-char) #\a))
+ (read-line)
+ (let ((replacenoid "chicken enchilada"))
+ (unread-char #\newline (current-input-port))
+ (unread-string replacenoid (current-input-port))
+ (pass-if "unread-string"
+ (string=? (read-line) replacenoid)))
+ (pass-if "unread residue"
+ (string=? (read-line) "moon"))))
+
+;;; non-blocking mode on a port. create a pipe and set O_NONBLOCK on
+;;; the reading end. try to read a byte: should get EAGAIN or
+;;; EWOULDBLOCK error.
+(let* ((p (pipe))
+ (r (car p)))
+ (fcntl r F_SETFL (logior (fcntl r F_GETFL) O_NONBLOCK))
+ (pass-if "non-blocking-I/O"
+ (catch 'system-error
+ (lambda () (read-char r) #f)
+ (lambda (key . args)
+ (and (eq? key 'system-error)
+ (let ((errno (car (list-ref args 3))))
+ (or (= errno EAGAIN)
+ (= errno EWOULDBLOCK))))))))
+
+\f
+;;;; Pipe (popen) ports.
+
+;;; Run a command, and read its output.
+(let* ((pipe (open-pipe "echo 'Howdy there, partner!'" "r"))
+ (in-string (read-all pipe)))
+ (close-pipe pipe)
+ (pass-if "pipe: read"
+ (equal? in-string "Howdy there, partner!\n")))
+
+;;; Run a command, send some output to it, and see if it worked.
+(let* ((filename (test-file))
+ (pipe (open-pipe (string-append "grep Mommy > " filename) "w")))
+ (display "Now Jimmy lives on a mushroom cloud\n" pipe)
+ (display "Mommy, why does everybody have a bomb?\n" pipe)
+ (close-pipe pipe)
+ (let ((in-string (read-file filename)))
+ (pass-if "pipe: write"
+ (equal? in-string "Mommy, why does everybody have a bomb?\n")))
+ (delete-file filename))
+
+\f
+;;;; Void ports. These are so trivial we don't test them.
+
+\f
+;;;; String ports.
+
+(with-test-prefix "string ports"
+
+ ;; Write text to a string port.
+ (let* ((string "Howdy there, partner!")
+ (in-string (call-with-output-string
+ (lambda (port)
+ (display string port)
+ (newline port)))))
+ (pass-if "display text"
+ (equal? in-string (string-append string "\n"))))
+
+ ;; Write an s-expression to a string port.
+ (let* ((sexpr '("more utterly random text" 1729 #(a vector) 3.1415926))
+ (in-sexpr
+ (call-with-input-string (call-with-output-string
+ (lambda (port)
+ (write sexpr port)))
+ read)))
+ (pass-if "write/read sexpr"
+ (equal? in-sexpr sexpr)))
+
+ ;; seeking and unreading from an input string.
+ (let ((text "that text didn't look random to me"))
+ (call-with-input-string text
+ (lambda (p)
+ (pass-if "input tell 0"
+ (= (seek p 0 SEEK_CUR) 0))
+ (read-char p)
+ (pass-if "input tell 1"
+ (= (seek p 0 SEEK_CUR) 1))
+ (unread-char #\x p)
+ (pass-if "input tell back to 0"
+ (= (seek p 0 SEEK_CUR) 0))
+ (pass-if "input ungetted char"
+ (char=? (read-char p) #\x))
+ (seek p 0 SEEK_END)
+ (pass-if "input seek to end"
+ (= (seek p 0 SEEK_CUR)
+ (string-length text)))
+ (unread-char #\x p)
+ (pass-if "input seek to beginning"
+ (= (seek p 0 SEEK_SET) 0))
+ (pass-if "input reread first char"
+ (char=? (read-char p)
+ (string-ref text 0))))))
+
+ ;; seeking an output string.
+ (let* ((text (string-copy "123456789"))
+ (len (string-length text))
+ (result (call-with-output-string
+ (lambda (p)
+ (pass-if "output tell 0"
+ (= (seek p 0 SEEK_CUR) 0))
+ (display text p)
+ (pass-if "output tell end"
+ (= (seek p 0 SEEK_CUR) len))
+ (pass-if "output seek to beginning"
+ (= (seek p 0 SEEK_SET) 0))
+ (write-char #\a p)
+ (seek p -1 SEEK_END)
+ (pass-if "output seek to last char"
+ (= (seek p 0 SEEK_CUR)
+ (- len 1)))
+ (write-char #\b p)))))
+ (string-set! text 0 #\a)
+ (string-set! text (- len 1) #\b)
+ (pass-if "output check"
+ (string=? text result))))
+
+(with-test-prefix "call-with-output-string"
+
+ ;; In Guile 1.6.4, closing the port resulted in a segv, check that doesn't
+ ;; occur.
+ (pass-if-exception "proc closes port" exception:wrong-type-arg
+ (call-with-output-string close-port)))
+
+
+\f
+;;;; Soft ports. No tests implemented yet.
+
+\f
+;;;; Generic operations across all port types.
+
+(let ((port-loop-temp (test-file)))
+
+ ;; Return a list of input ports that all return the same text.
+ ;; We map tests over this list.
+ (define (input-port-list text)
+
+ ;; Create a text file some of the ports will use.
+ (let ((out-port (open-output-file port-loop-temp)))
+ (display text out-port)
+ (close-port out-port))
+
+ (list (open-input-file port-loop-temp)
+ (open-input-pipe (string-append "cat " port-loop-temp))
+ (call-with-input-string text (lambda (x) x))
+ ;; We don't test soft ports at the moment.
+ ))
+
+ (define port-list-names '("file" "pipe" "string"))
+
+ ;; Test the line counter.
+ (define (test-line-counter text second-line final-column)
+ (with-test-prefix "line counter"
+ (let ((ports (input-port-list text)))
+ (for-each
+ (lambda (port port-name)
+ (with-test-prefix port-name
+ (pass-if "at beginning of input"
+ (= (port-line port) 0))
+ (pass-if "read first character"
+ (eqv? (read-char port) #\x))
+ (pass-if "after reading one character"
+ (= (port-line port) 0))
+ (pass-if "read first newline"
+ (eqv? (read-char port) #\newline))
+ (pass-if "after reading first newline char"
+ (= (port-line port) 1))
+ (pass-if "second line read correctly"
+ (equal? (read-line port) second-line))
+ (pass-if "read-line increments line number"
+ (= (port-line port) 2))
+ (pass-if "read-line returns EOF"
+ (let loop ((i 0))
+ (cond
+ ((eof-object? (read-line port)) #t)
+ ((> i 20) #f)
+ (else (loop (+ i 1))))))
+ (pass-if "line count is 5 at EOF"
+ (= (port-line port) 5))
+ (pass-if "column is correct at EOF"
+ (= (port-column port) final-column))))
+ ports port-list-names)
+ (for-each close-port ports)
+ (delete-file port-loop-temp))))
+
+ (with-test-prefix "newline"
+ (test-line-counter
+ (string-append "x\n"
+ "He who receives an idea from me, receives instruction\n"
+ "himself without lessening mine; as he who lights his\n"
+ "taper at mine, receives light without darkening me.\n"
+ " --- Thomas Jefferson\n")
+ "He who receives an idea from me, receives instruction"
+ 0))
+
+ (with-test-prefix "no newline"
+ (test-line-counter
+ (string-append "x\n"
+ "He who receives an idea from me, receives instruction\n"
+ "himself without lessening mine; as he who lights his\n"
+ "taper at mine, receives light without darkening me.\n"
+ " --- Thomas Jefferson\n"
+ "no newline here")
+ "He who receives an idea from me, receives instruction"
+ 15)))
+
+;; Test port-line and port-column for output ports
+
+(define (test-output-line-counter text final-column)
+ (with-test-prefix "port-line and port-column for output ports"
+ (let ((port (open-output-string)))
+ (pass-if "at beginning of input"
+ (and (= (port-line port) 0)
+ (= (port-column port) 0)))
+ (write-char #\x port)
+ (pass-if "after writing one character"
+ (and (= (port-line port) 0)
+ (= (port-column port) 1)))
+ (write-char #\newline port)
+ (pass-if "after writing first newline char"
+ (and (= (port-line port) 1)
+ (= (port-column port) 0)))
+ (display text port)
+ (pass-if "line count is 5 at end"
+ (= (port-line port) 5))
+ (pass-if "column is correct at end"
+ (= (port-column port) final-column)))))
+
+(test-output-line-counter
+ (string-append "He who receives an idea from me, receives instruction\n"
+ "himself without lessening mine; as he who lights his\n"
+ "taper at mine, receives light without darkening me.\n"
+ " --- Thomas Jefferson\n"
+ "no newline here")
+ 15)
+
+(with-test-prefix "port-column"
+
+ (with-test-prefix "output"
+
+ (pass-if "x"
+ (let ((port (open-output-string)))
+ (display "x" port)
+ (= 1 (port-column port))))
+
+ (pass-if "\\a"
+ (let ((port (open-output-string)))
+ (display "\a" port)
+ (= 0 (port-column port))))
+
+ (pass-if "x\\a"
+ (let ((port (open-output-string)))
+ (display "x\a" port)
+ (= 1 (port-column port))))
+
+ (pass-if "\\x08 backspace"
+ (let ((port (open-output-string)))
+ (display "\x08" port)
+ (= 0 (port-column port))))
+
+ (pass-if "x\\x08 backspace"
+ (let ((port (open-output-string)))
+ (display "x\x08" port)
+ (= 0 (port-column port))))
+
+ (pass-if "\\n"
+ (let ((port (open-output-string)))
+ (display "\n" port)
+ (= 0 (port-column port))))
+
+ (pass-if "x\\n"
+ (let ((port (open-output-string)))
+ (display "x\n" port)
+ (= 0 (port-column port))))
+
+ (pass-if "\\r"
+ (let ((port (open-output-string)))
+ (display "\r" port)
+ (= 0 (port-column port))))
+
+ (pass-if "x\\r"
+ (let ((port (open-output-string)))
+ (display "x\r" port)
+ (= 0 (port-column port))))
+
+ (pass-if "\\t"
+ (let ((port (open-output-string)))
+ (display "\t" port)
+ (= 8 (port-column port))))
+
+ (pass-if "x\\t"
+ (let ((port (open-output-string)))
+ (display "x\t" port)
+ (= 8 (port-column port)))))
+
+ (with-test-prefix "input"
+
+ (pass-if "x"
+ (let ((port (open-input-string "x")))
+ (while (not (eof-object? (read-char port))))
+ (= 1 (port-column port))))
+
+ (pass-if "\\a"
+ (let ((port (open-input-string "\a")))
+ (while (not (eof-object? (read-char port))))
+ (= 0 (port-column port))))
+
+ (pass-if "x\\a"
+ (let ((port (open-input-string "x\a")))
+ (while (not (eof-object? (read-char port))))
+ (= 1 (port-column port))))
+
+ (pass-if "\\x08 backspace"
+ (let ((port (open-input-string "\x08")))
+ (while (not (eof-object? (read-char port))))
+ (= 0 (port-column port))))
+
+ (pass-if "x\\x08 backspace"
+ (let ((port (open-input-string "x\x08")))
+ (while (not (eof-object? (read-char port))))
+ (= 0 (port-column port))))
+
+ (pass-if "\\n"
+ (let ((port (open-input-string "\n")))
+ (while (not (eof-object? (read-char port))))
+ (= 0 (port-column port))))
+
+ (pass-if "x\\n"
+ (let ((port (open-input-string "x\n")))
+ (while (not (eof-object? (read-char port))))
+ (= 0 (port-column port))))
+
+ (pass-if "\\r"
+ (let ((port (open-input-string "\r")))
+ (while (not (eof-object? (read-char port))))
+ (= 0 (port-column port))))
+
+ (pass-if "x\\r"
+ (let ((port (open-input-string "x\r")))
+ (while (not (eof-object? (read-char port))))
+ (= 0 (port-column port))))
+
+ (pass-if "\\t"
+ (let ((port (open-input-string "\t")))
+ (while (not (eof-object? (read-char port))))
+ (= 8 (port-column port))))
+
+ (pass-if "x\\t"
+ (let ((port (open-input-string "x\t")))
+ (while (not (eof-object? (read-char port))))
+ (= 8 (port-column port))))))
+
+(with-test-prefix "port-line"
+
+ ;; in guile 1.8.1 and earlier port-line was truncated to an int, whereas
+ ;; scm_t_port actually holds a long; this restricted the range on 64-bit
+ ;; systems
+ (pass-if "set most-positive-fixnum/2"
+ (let ((n (quotient most-positive-fixnum 2))
+ (port (open-output-string)))
+ (set-port-line! port n)
+ (eqv? n (port-line port)))))
+
+;;;
+;;; port-for-each
+;;;
+
+(with-test-prefix "port-for-each"
+
+ ;; In guile 1.8.0 through 1.8.2, port-for-each could pass a freed cell to
+ ;; its iterator func if a port was inaccessible in the last gc mark but
+ ;; the lazy sweeping has not yet reached it to remove it from the port
+ ;; table (scm_i_port_table). Provoking those gc conditions is a little
+ ;; tricky, but the following code made it happen in 1.8.2.
+ (pass-if "passing freed cell"
+ (throw 'unresolved)
+ (let ((lst '()))
+ ;; clear out the heap
+ (gc) (gc) (gc)
+ ;; allocate cells so the opened ports aren't at the start of the heap
+ (make-list 1000)
+ (open-input-file "/dev/null")
+ (make-list 1000)
+ (open-input-file "/dev/null")
+ ;; this gc leaves the above ports unmarked, ie. inaccessible
+ (gc)
+ ;; but they're still in the port table, so this sees them
+ (port-for-each (lambda (port)
+ (set! lst (cons port lst))))
+ ;; this forces completion of the sweeping
+ (gc) (gc) (gc)
+ ;; and (if the bug is present) the cells accumulated in LST are now
+ ;; freed cells, which give #f from `port?'
+ (not (memq #f (map port? lst))))))
+
+;;;
+;;; seek
+;;;
+
+(with-test-prefix "seek"
+
+ (with-test-prefix "file port"
+
+ (pass-if "SEEK_CUR"
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "abcde" port)))
+ (let ((port (open-file (test-file) "r")))
+ (read-char port)
+ (seek port 2 SEEK_CUR)
+ (eqv? #\d (read-char port))))
+
+ (pass-if "SEEK_SET"
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "abcde" port)))
+ (let ((port (open-file (test-file) "r")))
+ (read-char port)
+ (seek port 3 SEEK_SET)
+ (eqv? #\d (read-char port))))
+
+ (pass-if "SEEK_END"
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "abcde" port)))
+ (let ((port (open-file (test-file) "r")))
+ (read-char port)
+ (seek port -2 SEEK_END)
+ (eqv? #\d (read-char port))))))
+
+;;;
+;;; truncate-file
+;;;
+
+(with-test-prefix "truncate-file"
+
+ (pass-if-exception "flonum file" exception:wrong-type-arg
+ (truncate-file 1.0 123))
+
+ (pass-if-exception "frac file" exception:wrong-type-arg
+ (truncate-file 7/3 123))
+
+ (with-test-prefix "filename"
+
+ (pass-if-exception "flonum length" exception:wrong-type-arg
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "hello" port)))
+ (truncate-file (test-file) 1.0))
+
+ (pass-if "shorten"
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "hello" port)))
+ (truncate-file (test-file) 1)
+ (eqv? 1 (stat:size (stat (test-file)))))
+
+ (pass-if-exception "shorten to current pos" exception:miscellaneous-error
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "hello" port)))
+ (truncate-file (test-file))))
+
+ (with-test-prefix "file descriptor"
+
+ (pass-if "shorten"
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "hello" port)))
+ (let ((fd (open-fdes (test-file) O_RDWR)))
+ (truncate-file fd 1)
+ (close-fdes fd))
+ (eqv? 1 (stat:size (stat (test-file)))))
+
+ (pass-if "shorten to current pos"
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "hello" port)))
+ (let ((fd (open-fdes (test-file) O_RDWR)))
+ (seek fd 1 SEEK_SET)
+ (truncate-file fd)
+ (close-fdes fd))
+ (eqv? 1 (stat:size (stat (test-file))))))
+
+ (with-test-prefix "file port"
+
+ (pass-if "shorten"
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "hello" port)))
+ (let ((port (open-file (test-file) "r+")))
+ (truncate-file port 1))
+ (eqv? 1 (stat:size (stat (test-file)))))
+
+ (pass-if "shorten to current pos"
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "hello" port)))
+ (let ((port (open-file (test-file) "r+")))
+ (read-char port)
+ (truncate-file port))
+ (eqv? 1 (stat:size (stat (test-file)))))))
+
+
+;;;; testing read-delimited and friends
+
+(with-test-prefix "read-delimited!"
+ (let ((c (make-string 20 #\!)))
+ (call-with-input-string
+ "defdef\nghighi\n"
+ (lambda (port)
+
+ (read-delimited! "\n" c port 'concat)
+ (pass-if "read-delimited! reads a first line"
+ (string=? c "defdef\n!!!!!!!!!!!!!"))
+
+ (read-delimited! "\n" c port 'concat 3)
+ (pass-if "read-delimited! reads a first line"
+ (string=? c "defghighi\n!!!!!!!!!!"))))))
+
+\f
+;;;; char-ready?
+
+(call-with-input-string
+ "howdy"
+ (lambda (port)
+ (pass-if "char-ready? returns true on string port"
+ (char-ready? port))))
+
+;;; This segfaults on some versions of Guile. We really should run
+;;; the tests in a subprocess...
+
+(call-with-input-string
+ "howdy"
+ (lambda (port)
+ (with-input-from-port
+ port
+ (lambda ()
+ (pass-if "char-ready? returns true on string port as default port"
+ (char-ready?))))))
+
+\f
+;;;; Close current-input-port, and make sure everyone can handle it.
+
+(with-test-prefix "closing current-input-port"
+ (for-each (lambda (procedure name)
+ (with-input-from-port
+ (call-with-input-string "foo" (lambda (p) p))
+ (lambda ()
+ (close-port (current-input-port))
+ (pass-if-exception name
+ exception:wrong-type-arg
+ (procedure)))))
+ (list read read-char read-line)
+ '("read" "read-char" "read-line")))
+
+(delete-file (test-file))
projects / lilypond.git / blobdiff