diff options
Diffstat (limited to 'test-suite/tests/ports.test')
-rw-r--r-- | test-suite/tests/ports.test | 324 |
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?)))))) |