1 ;;;; ports.test --- test suite for Guile I/O ports -*- scheme -*-
2 ;;;; Jim Blandy <jimb@red-bean.com> --- October 1998
4 ;;;; Copyright (C) 1999 Free Software Foundation, Inc.
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.
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.
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
21 (use-modules (test-suite lib)
24 (define (display-line . args)
25 (for-each display args)
32 ;;;; Some general utilities for testing ports.
34 ;;; Read from PORT until EOF, and return the result as a string.
35 (define (read-all port)
36 (let loop ((chars '()))
37 (let ((char (read-char port)))
38 (if (eof-object? char)
39 (list->string (reverse! chars))
40 (loop (cons char chars))))))
42 (define (read-file filename)
43 (let* ((port (open-input-file filename))
44 (string (read-all port)))
49 ;;;; Normal file ports.
51 ;;; Write out an s-expression, and read it back.
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)))
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)))
64 (delete-file filename)))
66 ;;; Write out a string, and read it back a character at a time.
68 (let ((string "This is a test string\nwith no newline at the end")
69 (filename (test-file)))
70 (let ((port (open-output-file filename)))
73 (let ((in-string (read-file filename)))
74 (pass-if "file: write and read back characters"
75 (equal? string in-string)))
76 (delete-file filename)))
81 ;;; Run a command, and read its output.
83 (let* ((pipe (open-pipe "echo 'Howdy there, partner!'" "r"))
84 (in-string (read-all pipe)))
87 (equal? in-string "Howdy there, partner!\n"))))
89 ;;; Run a command, send some output to it, and see if it worked.
91 (let* ((filename (test-file))
92 (pipe (open-pipe (string-append "grep Mommy > " filename) "w")))
93 (display "Now Jimmy lives on a mushroom cloud\n" pipe)
94 (display "Mommy, why does everybody have a bomb?\n" pipe)
96 (let ((in-string (read-file filename)))
97 (pass-if "pipe: write"
98 (equal? in-string "Mommy, why does everybody have a bomb?\n")))
99 (delete-file filename)))
102 ;;;; Void ports. These are so trivial we don't test them.
107 (with-test-prefix "string ports"
109 ;; Write text to a string port.
111 (let* ((string "Howdy there, partner!")
112 (in-string (call-with-output-string
114 (display string port)
116 (pass-if "display text"
117 (equal? in-string (string-append string "\n")))))
119 ;; Write an s-expression to a string port.
121 (let* ((sexpr '("more utterly random text" 1729 #(a vector) 3.1415926))
123 (call-with-input-string (call-with-output-string
127 (pass-if "write/read sexpr"
128 (equal? in-sexpr sexpr)))))
131 ;;;; Soft ports. No tests implemented yet.
134 ;;;; Generic operations across all port types.
136 (let ((port-loop-temp (test-file)))
138 ;; Return a list of input ports that all return the same text.
139 ;; We map tests over this list.
140 (define (input-port-list text)
142 ;; Create a text file some of the ports will use.
143 (let ((out-port (open-output-file port-loop-temp)))
144 (display text out-port)
145 (close-port out-port))
147 (list (open-input-file port-loop-temp)
148 (open-input-pipe (string-append "cat " port-loop-temp))
149 (call-with-input-string text (lambda (x) x))
150 ;; We don't test soft ports at the moment.
153 (define port-list-names '("file" "pipe" "string"))
155 ;; Test the line counter.
156 (define (test-line-counter text second-line final-column)
157 (with-test-prefix "line counter"
158 (let ((ports (input-port-list text)))
160 (lambda (port port-name)
161 (with-test-prefix port-name
162 (pass-if "at beginning of input"
163 (= (port-line port) 0))
164 (pass-if "read first character"
165 (eqv? (read-char port) #\x))
166 (pass-if "after reading one character"
167 (= (port-line port) 0))
168 (pass-if "read first newline"
169 (eqv? (read-char port) #\newline))
170 (pass-if "after reading first newline char"
171 (= (port-line port) 1))
172 (pass-if "second line read correctly"
173 (equal? (read-line port) second-line))
174 (pass-if "read-line increments line number"
175 (= (port-line port) 2))
176 (pass-if "read-line returns EOF"
179 ((eof-object? (read-line port)) #t)
181 (else (loop (+ i 1))))))
182 (pass-if "line count is 5 at EOF"
183 (= (port-line port) 5))
184 (pass-if "column is correct at EOF"
185 (= (port-column port) final-column))))
186 ports port-list-names)
187 (for-each close-port ports)
188 (delete-file port-loop-temp))))
191 (with-test-prefix "newline"
194 "He who receives an idea from me, receives instruction\n"
195 "himself without lessening mine; as he who lights his\n"
196 "taper at mine, receives light without darkening me.\n"
197 " --- Thomas Jefferson\n")
198 "He who receives an idea from me, receives instruction"
202 (with-test-prefix "no newline"
205 "He who receives an idea from me, receives instruction\n"
206 "himself without lessening mine; as he who lights his\n"
207 "taper at mine, receives light without darkening me.\n"
208 " --- Thomas Jefferson\n"
210 "He who receives an idea from me, receives instruction"
214 ;;;; testing read-delimited and friends
216 (with-test-prefix "read-delimited!"
217 (let ((c (make-string 20 #\!)))
218 (call-with-input-string
222 (read-delimited! "\n" c port 'concat)
223 (pass-if "read-delimited! reads a first line"
224 (string=? c "defdef\n!!!!!!!!!!!!!"))
226 (read-delimited! "\n" c port 'concat 3)
227 (pass-if "read-delimited! reads a first line"
228 (string=? c "defghighi\n!!!!!!!!!!"))))))