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