test-suite/tests/ports.test

   1 ;;;; ports.test --- test suite for Guile I/O ports     -*- scheme -*-
   2 ;;;; Jim Blandy <jimb@red-bean.com> --- October 1998
   3 ;;;;
   4 ;;;;    Copyright (C) 1998, 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    (lseek 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    (lseek port -1 SEEK_CUR)
  89    (write-char #\x port)
  90    (lseek port 7 SEEK_SET)
  91    (pass-if "file: r/w 3"
  92             (char=? (read-char port) #\x))
  93    (lseek 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    (lseek 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    (lseek port -1 SEEK_CUR)
 109    (write-char #\x port)
 110    (lseek port 7 SEEK_SET)
 111    (pass-if "file: ub r/w 3"
 112             (char=? (read-char port) #\x))
 113    (lseek port -2 SEEK_END)
 114    (pass-if "file: ub r/w 4"
 115             (char=? (read-char port) #\s))
 116    (delete-file filename)))
 117
 118 \f
 119 ;;;; Pipe ports.
 120
 121 ;;; Run a command, and read its output.
 122 (catch-test-errors
 123  (let* ((pipe (open-pipe "echo 'Howdy there, partner!'" "r"))
 124         (in-string (read-all pipe)))
 125    (close-pipe pipe)
 126    (pass-if "pipe: read"
 127             (equal? in-string "Howdy there, partner!\n"))))
 128
 129 ;;; Run a command, send some output to it, and see if it worked.
 130 (catch-test-errors
 131  (let* ((filename (test-file))
 132         (pipe (open-pipe (string-append "grep Mommy > " filename) "w")))
 133    (display "Now Jimmy lives on a mushroom cloud\n" pipe)
 134    (display "Mommy, why does everybody have a bomb?\n" pipe)
 135    (close-pipe pipe)
 136    (let ((in-string (read-file filename)))
 137      (pass-if "pipe: write"
 138               (equal? in-string "Mommy, why does everybody have a bomb?\n")))
 139    (delete-file filename)))
 140
 141 \f
 142 ;;;; Void ports.  These are so trivial we don't test them.
 143
 144 \f
 145 ;;;; String ports.
 146
 147 (with-test-prefix "string ports"
 148
 149   ;; Write text to a string port.
 150   (catch-test-errors
 151    (let* ((string "Howdy there, partner!")
 152           (in-string (call-with-output-string
 153                       (lambda (port)
 154                         (display string port)
 155                         (newline port)))))
 156      (pass-if "display text"
 157               (equal? in-string (string-append string "\n")))))
 158
 159   ;; Write an s-expression to a string port.
 160   (catch-test-errors
 161    (let* ((sexpr '("more utterly random text" 1729 #(a vector) 3.1415926))
 162           (in-sexpr
 163            (call-with-input-string (call-with-output-string
 164                                     (lambda (port)
 165                                       (write sexpr port)))
 166                                    read)))
 167      (pass-if "write/read sexpr"
 168               (equal? in-sexpr sexpr)))))
 169
 170 \f
 171 ;;;; Soft ports.  No tests implemented yet.
 172
 173 \f
 174 ;;;; Generic operations across all port types.
 175
 176 (let ((port-loop-temp (test-file)))
 177
 178   ;; Return a list of input ports that all return the same text.
 179   ;; We map tests over this list.
 180   (define (input-port-list text)
 181
 182     ;; Create a text file some of the ports will use.
 183     (let ((out-port (open-output-file port-loop-temp)))
 184       (display text out-port)
 185       (close-port out-port))
 186
 187     (list (open-input-file port-loop-temp)
 188           (open-input-pipe (string-append "cat " port-loop-temp))
 189           (call-with-input-string text (lambda (x) x))
 190           ;; We don't test soft ports at the moment.
 191           ))
 192
 193   (define port-list-names '("file" "pipe" "string"))
 194
 195   ;; Test the line counter.
 196   (define (test-line-counter text second-line final-column)
 197     (with-test-prefix "line counter"
 198       (let ((ports (input-port-list text)))
 199         (for-each
 200          (lambda (port port-name)
 201            (with-test-prefix port-name
 202              (pass-if "at beginning of input"
 203                       (= (port-line port) 0))
 204              (pass-if "read first character"
 205                       (eqv? (read-char port) #\x))
 206              (pass-if "after reading one character"
 207                       (= (port-line port) 0))
 208              (pass-if "read first newline"
 209                       (eqv? (read-char port) #\newline))
 210              (pass-if "after reading first newline char"
 211                       (= (port-line port) 1))
 212              (pass-if "second line read correctly"
 213                       (equal? (read-line port) second-line))
 214              (pass-if "read-line increments line number"
 215                       (= (port-line port) 2))
 216              (pass-if "read-line returns EOF"
 217                       (let loop ((i 0))
 218                         (cond
 219                          ((eof-object? (read-line port)) #t)
 220                          ((> i 20) #f)
 221                          (else (loop (+ i 1))))))
 222              (pass-if "line count is 5 at EOF"
 223                       (= (port-line port) 5))
 224              (pass-if "column is correct at EOF"
 225                       (= (port-column port) final-column))))
 226          ports port-list-names)
 227         (for-each close-port ports)
 228         (delete-file port-loop-temp))))
 229
 230   (catch-test-errors
 231    (with-test-prefix "newline"
 232      (test-line-counter
 233       (string-append "x\n"
 234                      "He who receives an idea from me, receives instruction\n"
 235                      "himself without lessening mine; as he who lights his\n"
 236                      "taper at mine, receives light without darkening me.\n"
 237                      "  --- Thomas Jefferson\n")
 238       "He who receives an idea from me, receives instruction"
 239       0)))
 240
 241   (catch-test-errors
 242    (with-test-prefix "no newline"
 243      (test-line-counter
 244       (string-append "x\n"
 245                      "He who receives an idea from me, receives instruction\n"
 246                      "himself without lessening mine; as he who lights his\n"
 247                      "taper at mine, receives light without darkening me.\n"
 248                      "  --- Thomas Jefferson\n"
 249                      "no newline here")
 250       "He who receives an idea from me, receives instruction"
 251       15))))
 252
 253 \f
 254 ;;;; testing read-delimited and friends
 255
 256 (with-test-prefix "read-delimited!"
 257   (let ((c (make-string 20 #\!)))
 258     (call-with-input-string
 259      "defdef\nghighi\n"
 260      (lambda (port)
 261
 262        (read-delimited! "\n" c port 'concat)
 263        (pass-if "read-delimited! reads a first line"
 264                 (string=? c "defdef\n!!!!!!!!!!!!!"))
 265
 266        (read-delimited! "\n" c port 'concat 3)
 267        (pass-if "read-delimited! reads a first line"
 268                 (string=? c "defghighi\n!!!!!!!!!!"))))))
 269
 270 \f
 271 ;;;; char-ready?
 272
 273 (call-with-input-string
 274  "howdy"
 275  (lambda (port)
 276    (pass-if "char-ready? returns true on string port"
 277             (char-ready? port))))
 278
 279 ;;; This segfaults on some versions of Guile.  We really should run
 280 ;;; the tests in a subprocess...
 281
 282 (call-with-input-string
 283  "howdy"
 284  (lambda (port)
 285    (with-input-from-port
 286        port
 287      (lambda ()
 288        (pass-if "char-ready? returns true on string port as default port"
 289                 (char-ready?))))))