diff --git a/test-suite/README b/test-suite/README new file mode 100644 index 000000000..57eda036b --- /dev/null +++ b/test-suite/README @@ -0,0 +1,21 @@ +This directory contains some tests for Guile, and some generic test +support code. + +Right now, we only have tests for I/O ports. + +To run the test suite, you'll need to: +- edit the path to the guile interpreter in `guile-test', and +- edit the paths in `paths.scm', so `guile-test' can find the test + scripts. + +Once that's done, you can just run the `guile-test' script. That +script has usage instructions in the comments at the top. + +You can reference the file `lib.scm' from your own code as the module +(test-suite lib); it also has comments at the top and before each +function explaining what's going on. + +Please write more Guile tests, and send them to bug-guile@gnu.org. +We'll merge them into the distribution. All test suites must be +licensed for our use under the GPL, but I don't think I'm going to +collect assignment papers for them. diff --git a/test-suite/guile-test b/test-suite/guile-test new file mode 100755 index 000000000..f46bcae62 --- /dev/null +++ b/test-suite/guile-test @@ -0,0 +1,162 @@ +#!/usr/local/bin/guile \ +-e main -s +!# + +;;;; guile-test --- run the Guile test suite +;;;; Jim Blandy --- May 1999 +;;;; +;;;; 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 + + + +;;;; Usage: guile-test [--log-file LOG] [TEST ...] +;;;; +;;;; Run tests from the Guile test suite. Report failures and +;;;; unexpected passes to the standard output, along with a summary of +;;;; all the results. Record each reported test outcome in the log +;;;; file, `guile.log'. +;;;; +;;;; Normally, guile-test scans the test directory, and executes all +;;;; files whose names end in `.test'. (It assumes they contain +;;;; Scheme code.) However, you can have it execute specific tests by +;;;; listing their filenames on the command line. +;;;; +;;;; If present, the `--log-file LOG' option tells `guile-test' to put +;;;; the log output in a file named LOG. +;;;; +;;;; Installation: +;;;; +;;;; Change the #! line at the top of this script to point at the +;;;; Guile interpreter you want to test. Edit `test-suite/paths.scm' +;;;; so that datadir points to the parent directory of the `tests' tree. +;;;; +;;;; Shortcomings: +;;;; +;;;; At the moment, due to a simple-minded implementation, test files +;;;; must live in the test directory, and you must specify their names +;;;; relative to the top of the test directory. If you want to send +;;;; me a patche that fixes this, but still leaves sane test names in +;;;; the log file, that would be great. At the moment, all the tests +;;;; I care about are in the test directory, though. +;;;; +;;;; It would be nice if you could specify the Guile interpreter you +;;;; want to test on the command line. As it stands, if you want to +;;;; change which Guile interpreter you're testing, you need to edit +;;;; the #! line at the top of this file, which is stupid. + +(use-modules (test-suite lib) + (test-suite paths) + (ice-9 getopt-long) + (ice-9 and-let*)) + + +;;; General utilities, that probably should be in a library somewhere. + +;;; Traverse the directory tree at ROOT, applying F to the name of +;;; each file in the tree, including ROOT itself. For a subdirectory +;;; SUB, if (F SUB) is true, we recurse into SUB. Do not follow +;;; symlinks. +(define (for-each-file f root) + + ;; A "hard directory" is a path that denotes a directory and is not a + ;; symlink. + (define (file-is-hard-directory? filename) + (eq? (stat:type (lstat filename)) 'directory)) + + (let visit ((root root)) + (let ((should-recur (f root))) + (if (and should-recur (file-is-hard-directory? root)) + (let ((dir (opendir root))) + (let loop () + (let ((entry (readdir dir))) + (cond + ((eof-object? entry) #f) + ((or (string=? entry ".") + (string=? entry "..")) + (loop)) + (else + (visit (string-append root "/" entry)) + (loop)))))))))) + + + +;;; The test driver. + +(define test-root (in-vicinity datadir "tests")) + +(define (test-file-name test) + (in-vicinity test-root test)) + +;;; Return a list of all the test files in the test tree. +(define (enumerate-tests) + (let ((root-len (+ 1 (string-length test-root))) + (tests '())) + (for-each-file (lambda (file) + (if (has-suffix? file ".test") + (let ((short-name + (substring file root-len))) + (set! tests (cons short-name tests)))) + #t) + test-root) + + ;; for-each-file presents the files in whatever order it finds + ;; them in the directory. We sort them here, so they'll always + ;; appear in the same order. This makes it easier to compare test + ;; log files mechanically. + (sort tests string --- 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")))