Initial checkin of the Guile test suite.

test-suite/tests/ports.test

@@ -0,0 +1,193 @@
+;;;; ports.test --- test suite for Guile I/O ports
+;;;; Jim Blandy <jimb@red-bean.com> --- October 1998
+;;;;
+;;;; 	Copyright (C) 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))
+
+(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.
+(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.
+(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))
+
+
+;;;; Pipe ports.
+
+;;; Run a command, and read its output.
+(let* ((pipe (open-pipe "echo 'Howdy there, partner!'" "r"))
+       (in-string (read-all pipe)))
+  (close-port 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.
+(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-port 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.
+
+;;; Write text to a string port.
+(let* ((string "Howdy there, partner!")
+       (in-string (call-with-output-string
+		   (lambda (port)
+		     (display string port)
+		     (newline port)))))
+  (pass-if "output string: display text"
+	   (equal? in-string (string-append string "\n"))))
+		   
+;;; Write an s-expression to a string port.
+(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 "input and output string: 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)
+    (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))
+	     (let loop ()
+	       (if (not (eof-object? (read-line port)))
+		   (loop)))
+	     (pass-if "line count is 5 at EOF"
+		      (= (port-line port) 5))))
+	 ports port-list-names)
+	(for-each close-port ports)
+	(delete-file port-loop-temp))))
+
+  (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"))
+
+  (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")))