[bpt/guile.git] / test-suite / tests / ports.test

;;;; ports.test --- test suite for Guile I/O ports     -*- scheme -*-
;;;; Jim Blandy <jimb@red-bean.com> --- May 1999
;;;;
;;;; 	Copyright (C) 1999 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., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA

(use-modules (test-suite lib)
	     (ice-9 popen)
	     (ice-9 rdelim))

(define (display-line . args)
  (for-each display args)
  (newline))

(define (test-file)
  (tmpnam))

\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))
  (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))
  (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))))
  (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 "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))))


\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)))

\f
;;;; 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")))
Commit	Line	Data
0d572e91	1	;;;; ports.test --- test suite for Guile I/O ports -- scheme --
7ef450bf	2	;;;; Jim Blandy <jimb@red-bean.com> --- May 1999
000ee07f	3	;;;;
7ef450bf	4	;;;; Copyright (C) 1999 Free Software Foundation, Inc.
000ee07f JB	5	;;;;
	6	;;;; This program is free software; you can redistribute it and/or modify
	7	;;;; it under the terms of the GNU General Public License as published by
	8	;;;; the Free Software Foundation; either version 2, or (at your option)
	9	;;;; any later version.
	10	;;;;
	11	;;;; This program is distributed in the hope that it will be useful,
	12	;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	13	;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	;;;; GNU General Public License for more details.
	15	;;;;
	16	;;;; You should have received a copy of the GNU General Public License
	17	;;;; along with this software; see the file COPYING. If not, write to
	18	;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
	19	;;;; Boston, MA 02111-1307 USA
	20
f5d4dde3	21	(use-modules (test-suite lib)
22d35615 GH	22	(ice-9 popen)
22d35615 GH	23	(ice-9 rdelim))
000ee07f JB	24
	25	(define (display-line . args)
	26	(for-each display args)
	27	(newline))
	28
	29	(define (test-file)
	30	(tmpnam))
	31
	32	\f
	33	;;;; Some general utilities for testing ports.
	34
	35	;;; Read from PORT until EOF, and return the result as a string.
	36	(define (read-all port)
	37	(let loop ((chars '()))
	38	(let ((char (read-char port)))
	39	(if (eof-object? char)
	40	(list->string (reverse! chars))
	41	(loop (cons char chars))))))
	42
	43	(define (read-file filename)
	44	(let* ((port (open-input-file filename))
	45	(string (read-all port)))
	46	(close-port port)
	47	string))
	48
	49	\f
	50	;;;; Normal file ports.
	51
	52	;;; Write out an s-expression, and read it back.
57e7f270 DH	53	(let ((string '("From fairest creatures we desire increase,"
	54	"That thereby beauty's rose might never die,"))
	55	(filename (test-file)))
	56	(let ((port (open-output-file filename)))
	57	(write string port)
	58	(close-port port))
	59	(let ((port (open-input-file filename)))
	60	(let ((in-string (read port)))
	61	(pass-if "file: write and read back list of strings"
	62	(equal? string in-string)))
	63	(close-port port))
	64	(delete-file filename))
000ee07f JB	65
000ee07f JB	66	;;; Write out a string, and read it back a character at a time.
57e7f270 DH	67	(let ((string "This is a test string\nwith no newline at the end")
	68	(filename (test-file)))
	69	(let ((port (open-output-file filename)))
	70	(display string port)
	71	(close-port port))
	72	(let ((in-string (read-file filename)))
	73	(pass-if "file: write and read back characters"
	74	(equal? string in-string)))
	75	(delete-file filename))
000ee07f	76
7c035009	77	;;; Buffered input/output port with seeking.
57e7f270 DH	78	(let* ((filename (test-file))
	79	(port (open-file filename "w+")))
	80	(display "J'Accuse" port)
	81	(seek port -1 SEEK_CUR)
	82	(pass-if "file: r/w 1"
	83	(char=? (read-char port) #\e))
	84	(pass-if "file: r/w 2"
	85	(eof-object? (read-char port)))
	86	(seek port -1 SEEK_CUR)
	87	(write-char #\x port)
	88	(seek port 7 SEEK_SET)
	89	(pass-if "file: r/w 3"
	90	(char=? (read-char port) #\x))
	91	(seek port -2 SEEK_END)
	92	(pass-if "file: r/w 4"
	93	(char=? (read-char port) #\s))
	94	(delete-file filename))
7c035009 GH	95
7c035009 GH	96	;;; Unbuffered input/output port with seeking.
57e7f270 DH	97	(let* ((filename (test-file))
	98	(port (open-file filename "w+0")))
	99	(display "J'Accuse" port)
	100	(seek port -1 SEEK_CUR)
	101	(pass-if "file: ub r/w 1"
	102	(char=? (read-char port) #\e))
	103	(pass-if "file: ub r/w 2"
	104	(eof-object? (read-char port)))
	105	(seek port -1 SEEK_CUR)
	106	(write-char #\x port)
	107	(seek port 7 SEEK_SET)
	108	(pass-if "file: ub r/w 3"
	109	(char=? (read-char port) #\x))
	110	(seek port -2 SEEK_END)
	111	(pass-if "file: ub r/w 4"
	112	(char=? (read-char port) #\s))
	113	(delete-file filename))
7c035009	114
4fcd6551	115	;;; Buffered output-only and input-only ports with seeking.
57e7f270 DH	116	(let* ((filename (test-file))
	117	(port (open-output-file filename)))
	118	(display "J'Accuse" port)
	119	(pass-if "file: out tell"
	120	(= (seek port 0 SEEK_CUR) 8))
	121	(seek port -1 SEEK_CUR)
	122	(write-char #\x port)
	123	(close-port port)
	124	(let ((iport (open-input-file filename)))
	125	(pass-if "file: in tell 0"
	126	(= (seek iport 0 SEEK_CUR) 0))
	127	(read-char iport)
	128	(pass-if "file: in tell 1"
	129	(= (seek iport 0 SEEK_CUR) 1))
	130	(unread-char #\z iport)
	131	(pass-if "file: in tell 0 after unread"
	132	(= (seek iport 0 SEEK_CUR) 0))
	133	(pass-if "file: unread char still there"
	134	(char=? (read-char iport) #\z))
	135	(seek iport 7 SEEK_SET)
	136	(pass-if "file: in last char"
	137	(char=? (read-char iport) #\x))
	138	(close-port iport))
	139	(delete-file filename))
4fcd6551	140
7f214e60	141	;;; unusual characters.
57e7f270 DH	142	(let* ((filename (test-file))
	143	(port (open-output-file filename)))
	144	(display (string #\nul (integer->char 255) (integer->char 128)
	145	#\nul) port)
	146	(close-port port)
	147	(let* ((port (open-input-file filename))
	148	(line (read-line port)))
	149	(pass-if "file: read back NUL 1"
	150	(char=? (string-ref line 0) #\nul))
	151	(pass-if "file: read back 255"
	152	(char=? (string-ref line 1) (integer->char 255)))
	153	(pass-if "file: read back 128"
	154	(char=? (string-ref line 2) (integer->char 128)))
	155	(pass-if "file: read back NUL 2"
	156	(char=? (string-ref line 3) #\nul))
	157	(pass-if "file: EOF"
	158	(eof-object? (read-char port))))
	159	(delete-file filename))
7f214e60	160
0eb2e8cd	161	;;; line buffering mode.
57e7f270 DH	162	(let* ((filename (test-file))
	163	(port (open-file filename "wl"))
	164	(test-string "one line more or less"))
	165	(write-line test-string port)
	166	(let* ((in-port (open-input-file filename))
	167	(line (read-line in-port)))
	168	(close-port in-port)
	169	(close-port port)
	170	(pass-if "file: line buffering"
	171	(string=? line test-string)))
	172	(delete-file filename))
0eb2e8cd	173
d1b143e9	174	;;; ungetting characters and strings.
57e7f270 DH	175	(with-input-from-string "walk on the moon\nmoon"
	176	(lambda ()
	177	(read-char)
	178	(unread-char #\a (current-input-port))
	179	(pass-if "unread-char"
	180	(char=? (read-char) #\a))
	181	(read-line)
	182	(let ((replacenoid "chicken enchilada"))
	183	(unread-char #\newline (current-input-port))
	184	(unread-string replacenoid (current-input-port))
	185	(pass-if "unread-string"
	186	(string=? (read-line) replacenoid)))
	187	(pass-if "unread residue"
	188	(string=? (read-line) "moon"))))
d1b143e9	189
6e822cce	190	;;; non-blocking mode on a port. create a pipe and set O_NONBLOCK on
8cc58ec1 GH	191	;;; the reading end. try to read a byte: should get EAGAIN or
8cc58ec1 GH	192	;;; EWOULDBLOCK error.
57e7f270 DH	193	(let* ((p (pipe))
	194	(r (car p)))
	195	(fcntl r F_SETFL (logior (fcntl r F_GETFL) O_NONBLOCK))
	196	(pass-if "non-blocking-I/O"
	197	(catch 'system-error
	198	(lambda () (read-char r) #f)
	199	(lambda (key . args)
	200	(and (eq? key 'system-error)
	201	(let ((errno (car (list-ref args 3))))
	202	(or (= errno EAGAIN)
	203	(= errno EWOULDBLOCK))))))))
22d35615	204
000ee07f	205	\f
6e822cce	206	;;;; Pipe (popen) ports.
000ee07f JB	207
000ee07f JB	208	;;; Run a command, and read its output.
57e7f270 DH	209	(let* ((pipe (open-pipe "echo 'Howdy there, partner!'" "r"))
	210	(in-string (read-all pipe)))
	211	(close-pipe pipe)
	212	(pass-if "pipe: read"
	213	(equal? in-string "Howdy there, partner!\n")))
000ee07f JB	214
000ee07f JB	215	;;; Run a command, send some output to it, and see if it worked.
57e7f270 DH	216	(let* ((filename (test-file))
	217	(pipe (open-pipe (string-append "grep Mommy > " filename) "w")))
	218	(display "Now Jimmy lives on a mushroom cloud\n" pipe)
	219	(display "Mommy, why does everybody have a bomb?\n" pipe)
	220	(close-pipe pipe)
	221	(let ((in-string (read-file filename)))
	222	(pass-if "pipe: write"
	223	(equal? in-string "Mommy, why does everybody have a bomb?\n")))
	224	(delete-file filename))
000ee07f JB	225
	226	\f
	227	;;;; Void ports. These are so trivial we don't test them.
	228
	229	\f
	230	;;;; String ports.
	231
73cb0a97 JB	232	(with-test-prefix "string ports"
	233
	234	;; Write text to a string port.
57e7f270 DH	235	(let* ((string "Howdy there, partner!")
	236	(in-string (call-with-output-string
	237	(lambda (port)
	238	(display string port)
	239	(newline port)))))
	240	(pass-if "display text"
	241	(equal? in-string (string-append string "\n"))))
000ee07f	242
73cb0a97	243	;; Write an s-expression to a string port.
57e7f270 DH	244	(let* ((sexpr '("more utterly random text" 1729 #(a vector) 3.1415926))
	245	(in-sexpr
	246	(call-with-input-string (call-with-output-string
	247	(lambda (port)
	248	(write sexpr port)))
	249	read)))
	250	(pass-if "write/read sexpr"
	251	(equal? in-sexpr sexpr)))
2d9e5bca GH	252
2d9e5bca GH	253	;; seeking and unreading from an input string.
57e7f270 DH	254	(let ((text "that text didn't look random to me"))
	255	(call-with-input-string text
	256	(lambda (p)
	257	(pass-if "input tell 0"
	258	(= (seek p 0 SEEK_CUR) 0))
	259	(read-char p)
	260	(pass-if "input tell 1"
	261	(= (seek p 0 SEEK_CUR) 1))
	262	(unread-char #\x p)
	263	(pass-if "input tell back to 0"
	264	(= (seek p 0 SEEK_CUR) 0))
	265	(pass-if "input ungetted char"
	266	(char=? (read-char p) #\x))
	267	(seek p 0 SEEK_END)
	268	(pass-if "input seek to end"
	269	(= (seek p 0 SEEK_CUR)
	270	(string-length text)))
	271	(unread-char #\x p)
	272	(pass-if "input seek to beginning"
	273	(= (seek p 0 SEEK_SET) 0))
	274	(pass-if "input reread first char"
	275	(char=? (read-char p)
	276	(string-ref text 0))))))
	277
2d9e5bca	278	;; seeking an output string.
57e7f270 DH	279	(let* ((text "123456789")
	280	(len (string-length text))
	281	(result (call-with-output-string
	282	(lambda (p)
	283	(pass-if "output tell 0"
	284	(= (seek p 0 SEEK_CUR) 0))
	285	(display text p)
	286	(pass-if "output tell end"
	287	(= (seek p 0 SEEK_CUR) len))
	288	(pass-if "output seek to beginning"
	289	(= (seek p 0 SEEK_SET) 0))
	290	(write-char #\a p)
	291	(seek p -1 SEEK_END)
	292	(pass-if "output seek to last char"
	293	(= (seek p 0 SEEK_CUR)
	294	(- len 1)))
	295	(write-char #\b p)))))
	296	(string-set! text 0 #\a)
	297	(string-set! text (- len 1) #\b)
	298	(pass-if "output check"
	299	(string=? text result))))
2d9e5bca	300
000ee07f JB	301
	302	\f
	303	;;;; Soft ports. No tests implemented yet.
	304
	305	\f
	306	;;;; Generic operations across all port types.
	307
	308	(let ((port-loop-temp (test-file)))
	309
	310	;; Return a list of input ports that all return the same text.
	311	;; We map tests over this list.
	312	(define (input-port-list text)
	313
	314	;; Create a text file some of the ports will use.
	315	(let ((out-port (open-output-file port-loop-temp)))
	316	(display text out-port)
	317	(close-port out-port))
	318
	319	(list (open-input-file port-loop-temp)
	320	(open-input-pipe (string-append "cat " port-loop-temp))
	321	(call-with-input-string text (lambda (x) x))
	322	;; We don't test soft ports at the moment.
	323	))
	324
	325	(define port-list-names '("file" "pipe" "string"))
	326
	327	;; Test the line counter.
73cb0a97	328	(define (test-line-counter text second-line final-column)
000ee07f JB	329	(with-test-prefix "line counter"
	330	(let ((ports (input-port-list text)))
	331	(for-each
	332	(lambda (port port-name)
	333	(with-test-prefix port-name
	334	(pass-if "at beginning of input"
	335	(= (port-line port) 0))
	336	(pass-if "read first character"
	337	(eqv? (read-char port) #\x))
	338	(pass-if "after reading one character"
	339	(= (port-line port) 0))
	340	(pass-if "read first newline"
	341	(eqv? (read-char port) #\newline))
	342	(pass-if "after reading first newline char"
	343	(= (port-line port) 1))
	344	(pass-if "second line read correctly"
	345	(equal? (read-line port) second-line))
	346	(pass-if "read-line increments line number"
	347	(= (port-line port) 2))
0b8faa0e JB	348	(pass-if "read-line returns EOF"
	349	(let loop ((i 0))
	350	(cond
	351	((eof-object? (read-line port)) #t)
	352	((> i 20) #f)
	353	(else (loop (+ i 1))))))
000ee07f	354	(pass-if "line count is 5 at EOF"
73cb0a97 JB	355	(= (port-line port) 5))
	356	(pass-if "column is correct at EOF"
	357	(= (port-column port) final-column))))
000ee07f JB	358	ports port-list-names)
	359	(for-each close-port ports)
	360	(delete-file port-loop-temp))))
	361
57e7f270 DH	362	(with-test-prefix "newline"
	363	(test-line-counter
	364	(string-append "x\n"
	365	"He who receives an idea from me, receives instruction\n"
	366	"himself without lessening mine; as he who lights his\n"
	367	"taper at mine, receives light without darkening me.\n"
	368	" --- Thomas Jefferson\n")
	369	"He who receives an idea from me, receives instruction"
	370	0))
	371
	372	(with-test-prefix "no newline"
	373	(test-line-counter
	374	(string-append "x\n"
	375	"He who receives an idea from me, receives instruction\n"
	376	"himself without lessening mine; as he who lights his\n"
	377	"taper at mine, receives light without darkening me.\n"
	378	" --- Thomas Jefferson\n"
	379	"no newline here")
	380	"He who receives an idea from me, receives instruction"
	381	15)))
5bc1201f JB	382
	383	\f
	384	;;;; testing read-delimited and friends
	385
	386	(with-test-prefix "read-delimited!"
	387	(let ((c (make-string 20 #\!)))
	388	(call-with-input-string
	389	"defdef\nghighi\n"
	390	(lambda (port)
	391
	392	(read-delimited! "\n" c port 'concat)
	393	(pass-if "read-delimited! reads a first line"
	394	(string=? c "defdef\n!!!!!!!!!!!!!"))
	395
	396	(read-delimited! "\n" c port 'concat 3)
	397	(pass-if "read-delimited! reads a first line"
	398	(string=? c "defghighi\n!!!!!!!!!!"))))))
1b054952 JB	399
	400	\f
	401	;;;; char-ready?
	402
	403	(call-with-input-string
	404	"howdy"
	405	(lambda (port)
	406	(pass-if "char-ready? returns true on string port"
	407	(char-ready? port))))
	408
	409	;;; This segfaults on some versions of Guile. We really should run
	410	;;; the tests in a subprocess...
	411
	412	(call-with-input-string
	413	"howdy"
	414	(lambda (port)
	415	(with-input-from-port
	416	port
	417	(lambda ()
	418	(pass-if "char-ready? returns true on string port as default port"
	419	(char-ready?))))))
fe5b6beb JB	420
	421	\f
	422	;;;; Close current-input-port, and make sure everyone can handle it.
	423
	424	(with-test-prefix "closing current-input-port"
	425	(for-each (lambda (procedure name)
	426	(with-input-from-port
	427	(call-with-input-string "foo" (lambda (p) p))
	428	(lambda ()
	429	(close-port (current-input-port))
6b4113af DH	430	(pass-if-exception name
	431	exception:wrong-type-arg
	432	(procedure)))))
fe5b6beb JB	433	(list read read-char read-line)
fe5b6beb JB	434	'("read" "read-char" "read-line")))