summaryrefslogtreecommitdiff
path: root/test-suite/tests/ports.test
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite/tests/ports.test')
-rw-r--r--test-suite/tests/ports.test324
1 files changed, 0 insertions, 324 deletions
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
deleted file mode 100644
index ce796d11e..000000000
--- a/test-suite/tests/ports.test
+++ /dev/null
@@ -1,324 +0,0 @@
-;;;; ports.test --- test suite for Guile I/O ports -*- scheme -*-
-;;;; Jim Blandy <jimb@red-bean.com> --- October 1998
-;;;;
-;;;; Copyright (C) 1998, 1999 Free Software Foundation, Inc.
-;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
-;;;;
-;;;; This program is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING. If not, write to
-;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
-;;;; Boston, MA 02111-1307 USA
-
-(use-modules (test-suite lib)
- (ice-9 popen))
-
-(define (display-line . args)
- (for-each display args)
- (newline))
-
-(define (test-file)
- (tmpnam))
-
-
-;;;; Some general utilities for testing ports.
-
-;;; Read from PORT until EOF, and return the result as a string.
-(define (read-all port)
- (let loop ((chars '()))
- (let ((char (read-char port)))
- (if (eof-object? char)
- (list->string (reverse! chars))
- (loop (cons char chars))))))
-
-(define (read-file filename)
- (let* ((port (open-input-file filename))
- (string (read-all port)))
- (close-port port)
- string))
-
-
-;;;; Normal file ports.
-
-;;; Write out an s-expression, and read it back.
-(catch-test-errors
- (let ((string '("From fairest creatures we desire increase,"
- "That thereby beauty's rose might never die,"))
- (filename (test-file)))
- (let ((port (open-output-file filename)))
- (write string port)
- (close-port port))
- (let ((port (open-input-file filename)))
- (let ((in-string (read port)))
- (pass-if "file: write and read back list of strings"
- (equal? string in-string)))
- (close-port port))
- (delete-file filename)))
-
-;;; Write out a string, and read it back a character at a time.
-(catch-test-errors
- (let ((string "This is a test string\nwith no newline at the end")
- (filename (test-file)))
- (let ((port (open-output-file filename)))
- (display string port)
- (close-port port))
- (let ((in-string (read-file filename)))
- (pass-if "file: write and read back characters"
- (equal? string in-string)))
- (delete-file filename)))
-
-;;; Buffered input/output port with seeking.
-(catch-test-errors
- (let* ((filename (test-file))
- (port (open-file filename "w+")))
- (display "J'Accuse" port)
- (seek port -1 SEEK_CUR)
- (pass-if "file: r/w 1"
- (char=? (read-char port) #\e))
- (pass-if "file: r/w 2"
- (eof-object? (read-char port)))
- (seek port -1 SEEK_CUR)
- (write-char #\x port)
- (seek port 7 SEEK_SET)
- (pass-if "file: r/w 3"
- (char=? (read-char port) #\x))
- (seek port -2 SEEK_END)
- (pass-if "file: r/w 4"
- (char=? (read-char port) #\s))
- (delete-file filename)))
-
-;;; Unbuffered input/output port with seeking.
-(catch-test-errors
- (let* ((filename (test-file))
- (port (open-file filename "w+0")))
- (display "J'Accuse" port)
- (seek port -1 SEEK_CUR)
- (pass-if "file: ub r/w 1"
- (char=? (read-char port) #\e))
- (pass-if "file: ub r/w 2"
- (eof-object? (read-char port)))
- (seek port -1 SEEK_CUR)
- (write-char #\x port)
- (seek port 7 SEEK_SET)
- (pass-if "file: ub r/w 3"
- (char=? (read-char port) #\x))
- (seek port -2 SEEK_END)
- (pass-if "file: ub r/w 4"
- (char=? (read-char port) #\s))
- (delete-file filename)))
-
-;;; unusual characters.
-(catch-test-errors
- (let* ((filename (test-file))
- (port (open-output-file filename)))
- (display (string #\nul (integer->char 255) (integer->char 128)
- #\nul) port)
- (close-port port)
- (let* ((port (open-input-file filename))
- (line (read-line port)))
- (pass-if "file: read back NUL 1"
- (char=? (string-ref line 0) #\nul))
- (pass-if "file: read back 255"
- (char=? (string-ref line 1) (integer->char 255)))
- (pass-if "file: read back 128"
- (char=? (string-ref line 2) (integer->char 128)))
- (pass-if "file: read back NUL 2"
- (char=? (string-ref line 3) #\nul))
- (pass-if "file: EOF"
- (eof-object? (read-char port))))
- (delete-file filename)))
-
-;;; line buffering mode.
-(catch-test-errors
- (let* ((filename (test-file))
- (port (open-file filename "wl"))
- (test-string "one line more or less"))
- (write-line test-string port)
- (let* ((in-port (open-input-file filename))
- (line (read-line in-port)))
- (close-port in-port)
- (close-port port)
- (pass-if "file: line buffering"
- (string=? line test-string)))
- (delete-file filename)))
-
-
-;;;; Pipe ports.
-
-;;; Run a command, and read its output.
-(catch-test-errors
- (let* ((pipe (open-pipe "echo 'Howdy there, partner!'" "r"))
- (in-string (read-all pipe)))
- (close-pipe pipe)
- (pass-if "pipe: read"
- (equal? in-string "Howdy there, partner!\n"))))
-
-;;; Run a command, send some output to it, and see if it worked.
-(catch-test-errors
- (let* ((filename (test-file))
- (pipe (open-pipe (string-append "grep Mommy > " filename) "w")))
- (display "Now Jimmy lives on a mushroom cloud\n" pipe)
- (display "Mommy, why does everybody have a bomb?\n" pipe)
- (close-pipe pipe)
- (let ((in-string (read-file filename)))
- (pass-if "pipe: write"
- (equal? in-string "Mommy, why does everybody have a bomb?\n")))
- (delete-file filename)))
-
-
-;;;; Void ports. These are so trivial we don't test them.
-
-
-;;;; String ports.
-
-(with-test-prefix "string ports"
-
- ;; Write text to a string port.
- (catch-test-errors
- (let* ((string "Howdy there, partner!")
- (in-string (call-with-output-string
- (lambda (port)
- (display string port)
- (newline port)))))
- (pass-if "display text"
- (equal? in-string (string-append string "\n")))))
-
- ;; Write an s-expression to a string port.
- (catch-test-errors
- (let* ((sexpr '("more utterly random text" 1729 #(a vector) 3.1415926))
- (in-sexpr
- (call-with-input-string (call-with-output-string
- (lambda (port)
- (write sexpr port)))
- read)))
- (pass-if "write/read sexpr"
- (equal? in-sexpr sexpr)))))
-
-
-;;;; Soft ports. No tests implemented yet.
-
-
-;;;; Generic operations across all port types.
-
-(let ((port-loop-temp (test-file)))
-
- ;; Return a list of input ports that all return the same text.
- ;; We map tests over this list.
- (define (input-port-list text)
-
- ;; Create a text file some of the ports will use.
- (let ((out-port (open-output-file port-loop-temp)))
- (display text out-port)
- (close-port out-port))
-
- (list (open-input-file port-loop-temp)
- (open-input-pipe (string-append "cat " port-loop-temp))
- (call-with-input-string text (lambda (x) x))
- ;; We don't test soft ports at the moment.
- ))
-
- (define port-list-names '("file" "pipe" "string"))
-
- ;; Test the line counter.
- (define (test-line-counter text second-line final-column)
- (with-test-prefix "line counter"
- (let ((ports (input-port-list text)))
- (for-each
- (lambda (port port-name)
- (with-test-prefix port-name
- (pass-if "at beginning of input"
- (= (port-line port) 0))
- (pass-if "read first character"
- (eqv? (read-char port) #\x))
- (pass-if "after reading one character"
- (= (port-line port) 0))
- (pass-if "read first newline"
- (eqv? (read-char port) #\newline))
- (pass-if "after reading first newline char"
- (= (port-line port) 1))
- (pass-if "second line read correctly"
- (equal? (read-line port) second-line))
- (pass-if "read-line increments line number"
- (= (port-line port) 2))
- (pass-if "read-line returns EOF"
- (let loop ((i 0))
- (cond
- ((eof-object? (read-line port)) #t)
- ((> i 20) #f)
- (else (loop (+ i 1))))))
- (pass-if "line count is 5 at EOF"
- (= (port-line port) 5))
- (pass-if "column is correct at EOF"
- (= (port-column port) final-column))))
- ports port-list-names)
- (for-each close-port ports)
- (delete-file port-loop-temp))))
-
- (catch-test-errors
- (with-test-prefix "newline"
- (test-line-counter
- (string-append "x\n"
- "He who receives an idea from me, receives instruction\n"
- "himself without lessening mine; as he who lights his\n"
- "taper at mine, receives light without darkening me.\n"
- " --- Thomas Jefferson\n")
- "He who receives an idea from me, receives instruction"
- 0)))
-
- (catch-test-errors
- (with-test-prefix "no newline"
- (test-line-counter
- (string-append "x\n"
- "He who receives an idea from me, receives instruction\n"
- "himself without lessening mine; as he who lights his\n"
- "taper at mine, receives light without darkening me.\n"
- " --- Thomas Jefferson\n"
- "no newline here")
- "He who receives an idea from me, receives instruction"
- 15))))
-
-
-;;;; testing read-delimited and friends
-
-(with-test-prefix "read-delimited!"
- (let ((c (make-string 20 #\!)))
- (call-with-input-string
- "defdef\nghighi\n"
- (lambda (port)
-
- (read-delimited! "\n" c port 'concat)
- (pass-if "read-delimited! reads a first line"
- (string=? c "defdef\n!!!!!!!!!!!!!"))
-
- (read-delimited! "\n" c port 'concat 3)
- (pass-if "read-delimited! reads a first line"
- (string=? c "defghighi\n!!!!!!!!!!"))))))
-
-
-;;;; char-ready?
-
-(call-with-input-string
- "howdy"
- (lambda (port)
- (pass-if "char-ready? returns true on string port"
- (char-ready? port))))
-
-;;; This segfaults on some versions of Guile. We really should run
-;;; the tests in a subprocess...
-
-(call-with-input-string
- "howdy"
- (lambda (port)
- (with-input-from-port
- port
- (lambda ()
- (pass-if "char-ready? returns true on string port as default port"
- (char-ready?))))))