test-suite/tests/ports.test

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