tests/io-ports.test

   1 ;;; R6RS I/O Ports.
   2 ;;;
   3 ;;; Copyright 2007  Ludovic Courtès <ludovic.courtes@laas.fr>
   4 ;;;
   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 of the License, or
   9 ;;; (at your option) 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 program; if not, write to the Free Software
  18 ;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
  19
  20 (define-module (test-i/o-ports)
  21   :use-module (test-suite lib)
  22   :use-module (srfi srfi-1)
  23   :use-module (r6rs i/o ports)
  24   :use-module (r6rs bytevector))
  25
  26 ;;; All these tests assume Guile 1.8's port system, where characters are
  27 ;;; treated as octets.
  28
  29 \f
  30 (with-test-prefix "7.2.5 End-of-File Object"
  31
  32   (pass-if "eof-object"
  33     (and (eqv? (eof-object) (eof-object))
  34          (eq?  (eof-object) (eof-object)))))
  35
  36 \f
  37 (with-test-prefix "7.2.8 Binary Input"
  38
  39   (pass-if "get-u8"
  40     (let ((port (open-input-string "A")))
  41       (and (= (char->integer #\A) (get-u8 port))
  42            (eof-object? (get-u8 port)))))
  43
  44   (pass-if "lookahead-u8"
  45     (let ((port (open-input-string "A")))
  46       (and (= (char->integer #\A) (lookahead-u8 port))
  47            (not (eof-object? port))
  48            (= (char->integer #\A) (get-u8 port))
  49            (eof-object? (get-u8 port)))))
  50
  51   (pass-if "get-bytevector-n [short]"
  52     (let* ((port (open-input-string "GNU Guile"))
  53            (bv (get-bytevector-n port 4)))
  54       (and (bytevector? bv)
  55            (equal? (bytevector->u8-list bv)
  56                    (map char->integer (string->list "GNU "))))))
  57
  58   (pass-if "get-bytevector-n [long]"
  59     (let* ((port (open-input-string "GNU Guile"))
  60            (bv (get-bytevector-n port 256)))
  61       (and (bytevector? bv)
  62            (equal? (bytevector->u8-list bv)
  63                    (map char->integer (string->list "GNU Guile"))))))
  64
  65   (pass-if "get-bytevector-n! [short]"
  66     (let* ((port (open-input-string "GNU Guile"))
  67            (bv   (make-bytevector 4))
  68            (read (get-bytevector-n! port bv 0 4)))
  69       (and (equal? read 4)
  70            (equal? (bytevector->u8-list bv)
  71                    (map char->integer (string->list "GNU "))))))
  72
  73   (pass-if "get-bytevector-n! [long]"
  74     (let* ((str  "GNU Guile")
  75            (port (open-input-string str))
  76            (bv   (make-bytevector 256))
  77            (read (get-bytevector-n! port bv 0 256)))
  78       (and (equal? read (string-length str))
  79            (equal? (map (lambda (i)
  80                           (bytevector-u8-ref bv i))
  81                         (iota read))
  82                    (map char->integer (string->list str))))))
  83
  84   (pass-if "get-bytevector-some [simple]"
  85     (let* ((str  "GNU Guile")
  86            (port (open-input-string str))
  87            (bv   (get-bytevector-some port)))
  88       (and (bytevector? bv)
  89            (equal? (bytevector->u8-list bv)
  90                    (map char->integer (string->list str))))))
  91
  92   (pass-if "get-bytevector-some [only-some]"
  93     (let* ((str   "GNU Guile")
  94            (index 0)
  95            (port  (make-soft-port
  96                    (vector #f #f #f
  97                            (lambda ()
  98                              (if (>= index (string-length str))
  99                                  (eof-object)
 100                                  (let ((c (string-ref str index)))
 101                                    (set! index (+ index 1))
 102                                    c)))
 103                            (lambda () #t)
 104                            (lambda ()
 105                              ;; Number of readily available octets: falls to
 106                              ;; zero after 4 octets have been read.
 107                              (- 4 (modulo index 5))))
 108                    "r"))
 109            (bv    (get-bytevector-some port)))
 110       (and (bytevector? bv)
 111            (= index 4)
 112            (= (bytevector-length bv) index)
 113            (equal? (bytevector->u8-list bv)
 114                    (map char->integer (string->list "GNU "))))))
 115
 116   (pass-if "get-bytevector-all"
 117     (let* ((str   "GNU Guile")
 118            (index 0)
 119            (port  (make-soft-port
 120                    (vector #f #f #f
 121                            (lambda ()
 122                              (if (>= index (string-length str))
 123                                  (eof-object)
 124                                  (let ((c (string-ref str index)))
 125                                    (set! index (+ index 1))
 126                                    c)))
 127                            (lambda () #t)
 128                            (let ((cont? #f))
 129                              (lambda ()
 130                                ;; Number of readily available octets: falls to
 131                                ;; zero after 4 octets have been read and then
 132                                ;; starts again.
 133                                (let ((a (if cont?
 134                                             (- (string-length str) index)
 135                                             (- 4 (modulo index 5)))))
 136                                  (if (= 0 a) (set! cont? #t))
 137                                  a))))
 138                    "r"))
 139            (bv    (get-bytevector-all port)))
 140       (and (bytevector? bv)
 141            (= index (string-length str))
 142            (= (bytevector-length bv) (string-length str))
 143            (equal? (bytevector->u8-list bv)
 144                    (map char->integer (string->list str)))))))
 145
 146 \f
 147 (define (make-soft-output-port)
 148   (let* ((bv (make-bytevector 1024))
 149          (read-index  0)
 150          (write-index 0)
 151          (write-char (lambda (chr)
 152                        (bytevector-u8-set! bv write-index
 153                                            (char->integer chr))
 154                        (set! write-index (+ 1 write-index)))))
 155     (make-soft-port
 156      (vector write-char
 157              (lambda (str)   ;; write-string
 158                (for-each write-char (string->list str)))
 159              (lambda () #t)  ;; flush-output
 160              (lambda ()      ;; read-char
 161                (if (>= read-index (bytevector-length bv))
 162                    (eof-object)
 163                    (let ((c (bytevector-u8-ref bv read-index)))
 164                      (set! read-index (+ read-index 1))
 165                      (integer->char c))))
 166              (lambda () #t)) ;; close-port
 167      "rw")))
 168
 169 (with-test-prefix "7.2.11 Binary Output"
 170
 171   (pass-if "put-u8"
 172     (let ((port (make-soft-output-port)))
 173       (put-u8 port 77)
 174       (equal? (get-u8 port) 77)))
 175
 176   (pass-if "put-bytevector [2 args]"
 177     (let ((port (make-soft-output-port))
 178           (bv   (make-bytevector 256)))
 179       (put-bytevector port bv)
 180       (equal? (bytevector->u8-list bv)
 181               (bytevector->u8-list
 182                (get-bytevector-n port (bytevector-length bv))))))
 183
 184   (pass-if "put-bytevector [3 args]"
 185     (let ((port  (make-soft-output-port))
 186           (bv    (make-bytevector 256))
 187           (start 10))
 188       (put-bytevector port bv start)
 189       (equal? (drop (bytevector->u8-list bv) start)
 190               (bytevector->u8-list
 191                (get-bytevector-n port (- (bytevector-length bv) start))))))
 192
 193   (pass-if "put-bytevector [4 args]"
 194     (let ((port  (make-soft-output-port))
 195           (bv    (make-bytevector 256))
 196           (start 10)
 197           (count 77))
 198       (put-bytevector port bv start count)
 199       (equal? (take (drop (bytevector->u8-list bv) start) count)
 200               (bytevector->u8-list
 201                (get-bytevector-n port count))))))
 202
 203 \f
 204 (with-test-prefix "7.2.7 Input Ports"
 205
 206   ;; This section appears here so that it can use the binary input
 207   ;; primitives.
 208
 209   (pass-if "open-bytevector-input-port [1 arg]"
 210     (let* ((str "Hello Port!")
 211            (bv (u8-list->bytevector (map char->integer
 212                                          (string->list str))))
 213            (port (open-bytevector-input-port bv))
 214            (read-to-string
 215             (lambda (port)
 216               (let loop ((chr (read-char port))
 217                          (result '()))
 218                 (if (eof-object? chr)
 219                     (apply string (reverse! result))
 220                     (loop (read-char port)
 221                           (cons chr result)))))))
 222
 223       (equal? (read-to-string port) str)))
 224
 225   (pass-if-exception "bytevector-input-port is read-only"
 226     exception:wrong-type-arg
 227
 228     (let* ((str "Hello Port!")
 229            (bv (u8-list->bytevector (map char->integer
 230                                          (string->list str))))
 231            (port (open-bytevector-input-port bv)))
 232
 233       (write "hello" port)))
 234
 235   (pass-if "bytevector input port supports seeking"
 236     (let* ((str "Hello Port!")
 237            (bv (u8-list->bytevector (map char->integer
 238                                          (string->list str))))
 239            (port (open-bytevector-input-port bv)))
 240
 241       (and (port-has-port-position? port)
 242            (= 0 (port-position port))
 243            (port-has-set-port-position!? port)
 244            (begin
 245              (set-port-position! port 6)
 246              (= 6 (port-position port)))
 247            (bytevector=? (get-bytevector-all port)
 248                          (u8-list->bytevector
 249                           (map char->integer (string->list "Port!")))))))
 250
 251   (pass-if "make-custom-binary-input-port"
 252     (let* ((source (make-bytevector 7777))
 253            (read! (let ((pos 0)
 254                         (len (bytevector-length source)))
 255                     (lambda (bv start count)
 256                       (let ((amount (min count (- len pos))))
 257                         (if (> amount 0)
 258                             (bytevector-copy! source pos
 259                                               bv start amount))
 260                         (set! pos (+ pos amount))
 261                         amount))))
 262            (port (make-custom-binary-input-port "the port" read!)))
 263
 264       (bytevector=? (get-bytevector-all port) source))))
 265
 266
 267 ;;; Local Variables:
 268 ;;; coding: latin-1
 269 ;;; mode: scheme
 270 ;;; End:
 271
 272 ;;; arch-tag: fc4f49fa-18a5-4a0c-bee8-ef7554f9cf1d