3 ;;; Copyright 2007, 2009 Ludovic Courtès <ludo@gnu.org>
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 of the License, or
9 ;;; (at your option) 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 program; if not, write to the Free Software
18 ;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
20 (define-module (test-io-ports)
21 :use-module (test-suite lib)
22 :use-module (srfi srfi-1)
23 :use-module (srfi srfi-11)
24 :use-module (rnrs io ports)
25 :use-module (rnrs bytevector))
27 ;;; All these tests assume Guile 1.8's port system, where characters are
28 ;;; treated as octets.
31 (with-test-prefix "7.2.5 End-of-File Object"
34 (and (eqv? (eof-object) (eof-object))
35 (eq? (eof-object) (eof-object)))))
38 (with-test-prefix "7.2.8 Binary Input"
41 (let ((port (open-input-string "A")))
42 (and (= (char->integer #\A) (get-u8 port))
43 (eof-object? (get-u8 port)))))
45 (pass-if "lookahead-u8"
46 (let ((port (open-input-string "A")))
47 (and (= (char->integer #\A) (lookahead-u8 port))
48 (not (eof-object? port))
49 (= (char->integer #\A) (get-u8 port))
50 (eof-object? (get-u8 port)))))
52 (pass-if "get-bytevector-n [short]"
53 (let* ((port (open-input-string "GNU Guile"))
54 (bv (get-bytevector-n port 4)))
56 (equal? (bytevector->u8-list bv)
57 (map char->integer (string->list "GNU "))))))
59 (pass-if "get-bytevector-n [long]"
60 (let* ((port (open-input-string "GNU Guile"))
61 (bv (get-bytevector-n port 256)))
63 (equal? (bytevector->u8-list bv)
64 (map char->integer (string->list "GNU Guile"))))))
66 (pass-if-exception "get-bytevector-n with closed port"
67 exception:wrong-type-arg
69 (let ((port (%make-void-port "r")))
72 (get-bytevector-n port 3)))
74 (pass-if "get-bytevector-n! [short]"
75 (let* ((port (open-input-string "GNU Guile"))
76 (bv (make-bytevector 4))
77 (read (get-bytevector-n! port bv 0 4)))
79 (equal? (bytevector->u8-list bv)
80 (map char->integer (string->list "GNU "))))))
82 (pass-if "get-bytevector-n! [long]"
83 (let* ((str "GNU Guile")
84 (port (open-input-string str))
85 (bv (make-bytevector 256))
86 (read (get-bytevector-n! port bv 0 256)))
87 (and (equal? read (string-length str))
88 (equal? (map (lambda (i)
89 (bytevector-u8-ref bv i))
91 (map char->integer (string->list str))))))
93 (pass-if "get-bytevector-some [simple]"
94 (let* ((str "GNU Guile")
95 (port (open-input-string str))
96 (bv (get-bytevector-some port)))
98 (equal? (bytevector->u8-list bv)
99 (map char->integer (string->list str))))))
101 (pass-if "get-bytevector-some [only-some]"
102 (let* ((str "GNU Guile")
104 (port (make-soft-port
107 (if (>= index (string-length str))
109 (let ((c (string-ref str index)))
110 (set! index (+ index 1))
114 ;; Number of readily available octets: falls to
115 ;; zero after 4 octets have been read.
116 (- 4 (modulo index 5))))
118 (bv (get-bytevector-some port)))
119 (and (bytevector? bv)
121 (= (bytevector-length bv) index)
122 (equal? (bytevector->u8-list bv)
123 (map char->integer (string->list "GNU "))))))
125 (pass-if "get-bytevector-all"
126 (let* ((str "GNU Guile")
128 (port (make-soft-port
131 (if (>= index (string-length str))
133 (let ((c (string-ref str index)))
134 (set! index (+ index 1))
139 ;; Number of readily available octets: falls to
140 ;; zero after 4 octets have been read and then
143 (- (string-length str) index)
144 (- 4 (modulo index 5)))))
145 (if (= 0 a) (set! cont? #t))
148 (bv (get-bytevector-all port)))
149 (and (bytevector? bv)
150 (= index (string-length str))
151 (= (bytevector-length bv) (string-length str))
152 (equal? (bytevector->u8-list bv)
153 (map char->integer (string->list str)))))))
156 (define (make-soft-output-port)
157 (let* ((bv (make-bytevector 1024))
160 (write-char (lambda (chr)
161 (bytevector-u8-set! bv write-index
163 (set! write-index (+ 1 write-index)))))
166 (lambda (str) ;; write-string
167 (for-each write-char (string->list str)))
168 (lambda () #t) ;; flush-output
169 (lambda () ;; read-char
170 (if (>= read-index (bytevector-length bv))
172 (let ((c (bytevector-u8-ref bv read-index)))
173 (set! read-index (+ read-index 1))
175 (lambda () #t)) ;; close-port
178 (with-test-prefix "7.2.11 Binary Output"
181 (let ((port (make-soft-output-port)))
183 (equal? (get-u8 port) 77)))
185 (pass-if "put-bytevector [2 args]"
186 (let ((port (make-soft-output-port))
187 (bv (make-bytevector 256)))
188 (put-bytevector port bv)
189 (equal? (bytevector->u8-list bv)
191 (get-bytevector-n port (bytevector-length bv))))))
193 (pass-if "put-bytevector [3 args]"
194 (let ((port (make-soft-output-port))
195 (bv (make-bytevector 256))
197 (put-bytevector port bv start)
198 (equal? (drop (bytevector->u8-list bv) start)
200 (get-bytevector-n port (- (bytevector-length bv) start))))))
202 (pass-if "put-bytevector [4 args]"
203 (let ((port (make-soft-output-port))
204 (bv (make-bytevector 256))
207 (put-bytevector port bv start count)
208 (equal? (take (drop (bytevector->u8-list bv) start) count)
210 (get-bytevector-n port count)))))
212 (pass-if-exception "put-bytevector with closed port"
213 exception:wrong-type-arg
215 (let* ((bv (make-bytevector 4))
216 (port (%make-void-port "w")))
219 (put-bytevector port bv)))
221 (pass-if "open-bytevector-output-port"
222 (let-values (((port get-content)
223 (open-bytevector-output-port)))
224 (let ((source (make-bytevector 7777)))
225 (put-bytevector port source)
226 (and (bytevector=? (get-content) source)
227 (bytevector=? (get-content) (make-bytevector 0))))))
229 (pass-if "open-bytevector-output-port [put-u8]"
230 (let-values (((port get-content)
231 (open-bytevector-output-port)))
233 (and (bytevector=? (get-content) (make-bytevector 1 77))
234 (bytevector=? (get-content) (make-bytevector 0)))))
236 (pass-if "open-bytevector-output-port [display]"
237 (let-values (((port get-content)
238 (open-bytevector-output-port)))
239 (display "hello" port)
240 (and (bytevector=? (get-content) (string->utf8 "hello"))
241 (bytevector=? (get-content) (make-bytevector 0)))))
243 (pass-if "bytevector output port supports `port-position'"
244 (let-values (((port get-content)
245 (open-bytevector-output-port)))
246 (let ((source (make-bytevector 7777))
247 (overwrite (make-bytevector 33)))
248 (and (port-has-port-position? port)
249 (port-has-set-port-position!? port)
251 (put-bytevector port source)
252 (= (bytevector-length source)
253 (port-position port)))
255 (set-port-position! port 10)
256 (= 10 (port-position port)))
258 (put-bytevector port overwrite)
259 (bytevector-copy! overwrite 0 source 10
260 (bytevector-length overwrite))
261 (= (port-position port)
262 (+ 10 (bytevector-length overwrite))))
263 (bytevector=? (get-content) source)
264 (bytevector=? (get-content) (make-bytevector 0)))))))
267 (with-test-prefix "7.2.7 Input Ports"
269 ;; This section appears here so that it can use the binary input
272 (pass-if "open-bytevector-input-port [1 arg]"
273 (let* ((str "Hello Port!")
274 (bv (u8-list->bytevector (map char->integer
275 (string->list str))))
276 (port (open-bytevector-input-port bv))
279 (let loop ((chr (read-char port))
281 (if (eof-object? chr)
282 (apply string (reverse! result))
283 (loop (read-char port)
284 (cons chr result)))))))
286 (equal? (read-to-string port) str)))
288 (pass-if-exception "bytevector-input-port is read-only"
289 exception:wrong-type-arg
291 (let* ((str "Hello Port!")
292 (bv (u8-list->bytevector (map char->integer
293 (string->list str))))
294 (port (open-bytevector-input-port bv)))
296 (write "hello" port)))
298 (pass-if "bytevector input port supports seeking"
299 (let* ((str "Hello Port!")
300 (bv (u8-list->bytevector (map char->integer
301 (string->list str))))
302 (port (open-bytevector-input-port bv)))
304 (and (port-has-port-position? port)
305 (= 0 (port-position port))
306 (port-has-set-port-position!? port)
308 (set-port-position! port 6)
309 (= 6 (port-position port)))
310 (bytevector=? (get-bytevector-all port)
312 (map char->integer (string->list "Port!")))))))
314 (pass-if-exception "make-custom-binary-input-port [wrong-num-args]"
315 exception:wrong-num-args
317 ;; Prior to Guile-R6RS-Libs 0.2, the last 3 arguments were wrongfully
319 (make-custom-binary-input-port "port" (lambda args #t)))
321 (pass-if "make-custom-binary-input-port"
322 (let* ((source (make-bytevector 7777))
324 (len (bytevector-length source)))
325 (lambda (bv start count)
326 (let ((amount (min count (- len pos))))
328 (bytevector-copy! source pos
330 (set! pos (+ pos amount))
332 (port (make-custom-binary-input-port "the port" read!
335 (bytevector=? (get-bytevector-all port) source)))
337 (pass-if "custom binary input port does not support `port-position'"
338 (let* ((str "Hello Port!")
339 (source (open-bytevector-input-port
341 (map char->integer (string->list str)))))
342 (read! (lambda (bv start count)
343 (let ((r (get-bytevector-n! source bv start count)))
347 (port (make-custom-binary-input-port "the port" read!
349 (not (or (port-has-port-position? port)
350 (port-has-set-port-position!? port)))))
352 (pass-if "custom binary input port supports `port-position'"
353 (let* ((str "Hello Port!")
354 (source (open-bytevector-input-port
356 (map char->integer (string->list str)))))
357 (read! (lambda (bv start count)
358 (let ((r (get-bytevector-n! source bv start count)))
363 (port-position source)))
364 (set-pos! (lambda (pos)
365 (set-port-position! source pos)))
366 (port (make-custom-binary-input-port "the port" read!
367 get-pos set-pos! #f)))
369 (and (port-has-port-position? port)
370 (= 0 (port-position port))
371 (port-has-set-port-position!? port)
373 (set-port-position! port 6)
374 (= 6 (port-position port)))
375 (bytevector=? (get-bytevector-all port)
377 (map char->integer (string->list "Port!")))))))
379 (pass-if "custom binary input port `close-proc' is called"
381 (read! (lambda (bv start count) 0))
382 (get-pos (lambda () 0))
383 (set-pos! (lambda (pos) #f))
384 (close! (lambda () (set! closed? #t)))
385 (port (make-custom-binary-input-port "the port" read!