Provide a default reporter, so that results don't just go into the bit

[bpt/guile.git] / test-suite / tests / ports.test

;;;; ports.test --- test suite for Guile I/O ports     -*- scheme -*-
;;;; 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))

\f
;;;; 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))

\f
;;;; 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)))

\f
;;;; 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-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.
(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-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)))

\f
;;;; Void ports.  These are so trivial we don't test them.

\f
;;;; 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 "output string: 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 "input and output string: write/read sexpr"
	    (equal? in-sexpr sexpr))))

\f
;;;; Soft ports.  No tests implemented yet.

\f
;;;; 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))))

  (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")))

  (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"))))