Update of /project/clhp/cvsroot/clhp/tests In directory common-lisp.net:/tmp/cvs-serv10945/tests

Modified Files: cgi-test.lisp Added Files: test-suite.lisp Makefile Log Message: Moved test-suite out of cgi-test into its own file, now I can write tests for clhp as well. Modified Makefiles to deal with the new directory. Now running make check from the toplevel runs the tests.

Date: Wed Oct 15 10:05:57 2003 Author: aventimiglia

Index: clhp/tests/cgi-test.lisp diff -u clhp/tests/cgi-test.lisp:1.7 clhp/tests/cgi-test.lisp:1.8 --- clhp/tests/cgi-test.lisp:1.7 Wed Oct 15 08:50:51 2003 +++ clhp/tests/cgi-test.lisp Wed Oct 15 10:05:56 2003 @@ -27,144 +27,12 @@

(eval-when (:load-toplevel :compile-toplevel) (unless (find-package :cgi) - (load "library:cgi"))) + (load "library:cgi")) + (unless (find-package :net.common-lisp.aventimiglia.test-suite) + (load "test-suite")) + (when (find-package :clhp) (delete-package :clhp)))

-;; These macros Used for run-test methods -(defmacro call-if-function (form) - `(when (functionp ,form) (funcall ,form))) - -(defmacro test-return (test &rest args) - `(cons (test-data-symbol data) - (if ,test - (progn (princ 'ok stream) (terpri) :OK) - (progn (princ 'failed stream) (format stream ,@args) - (terpri) :FAILED)))) - -(defclass test-data () - ((symbol :initform NIL - :type symbol - :reader test-data-symbol - :initarg :symbol - :documentation "The symbol name to be tested") - (pre-function :initform NIL - :type (or function nil) - :reader test-data-pre-function - :initarg :pre-function - :documentation "Function to be called prior to running tests") - (post-function :initform NIL - :type (or function nil) - :reader test-data-post-function - :initarg :post-function - :documentation "Function to be called after running tests")) - (:documentation "Abstract supertype for CLASS, STRUCTURE, VARIABLE -and FUNCTION test-data")) - -(defclass function-test-data (test-data) - ((test-args :initform NIL - :type list - :reader function-test-data-test-args - :initarg :test-args - :documentation "A list of arguments to be passed to the -function for testing") - (result-form :initform NIL - :reader function-test-data-result-form - :initarg :result-form - :documentation "The expected return value when SYMBOL -is called with TEST-ARGS")) - (:documentation "A class to test functions or macros, taking -TEST-ARGS as a list of arguments to call the function with and -expecting RESULT-FORM to be the result")) - -(defclass output-function-test-data (function-test-data) - ((output :initform NIL - :type string - :reader output-function-test-data-output - :initarg :output - :documentation "A string which should be equal to the output")) - (:documentation "A subclass of function-test-data for testing macros -or functions, but this is used when thye output to *STANDARD-OUTPUT* -must be tested as well.")) - -(defclass side-effect-function-test-data (function-test-data) - ((var-list :initform NIL - :type list - :reader side-effect-function-test-data-var-list - :initarg :var-list - :documentation "An a-list of ((SYMBOL VALUE)) pairs. All -Symbols should be EQUAL to the VALUES after test function is -evaluated.")) - (:documentation "A subclass of function-test-data used to test -functions which have side effects of setting global variables.")) - -;; It's important that the RUN-TEST methods below all use DATA as the -;; TEST-DATA object name, because some of the macros defined at the -;; top of the file are hard coded to use the common names. - - -(defmethod run-test ((data function-test-data) - &optional (stream *standard-output*)) - (unwind-protect - (progn - (call-if-function (test-data-pre-function data)) - (let* ((test-form (cons (test-data-symbol data) - (function-test-data-test-args data))) - (result (eval test-form))) - (format stream "~S --> ~S : " test-form result) - (let ((test-result (function-test-data-result-form data))) - (test-return (equal result test-result) - "~S expected" test-result)))) - (call-if-function (test-data-post-function data)))) - -(defmethod run-test ((data output-function-test-data) - &optional (stream *standard-output*)) - (unwind-protect - (progn - (call-if-function (test-data-pre-function data)) - (let* ((test-form (cons (test-data-symbol data) - (function-test-data-test-args data))) - (output (make-array 0 :element-type 'base-char - :fill-pointer 0 :adjustable t)) - (result (with-output-to-string - (*standard-output* output) - (eval test-form)))) - (format stream "~S --> ~S ~S : " test-form output result) - (let ((test-output (output-function-test-data-output data)) - (test-result (function-test-data-result-form data))) - (test-return (and (equal result test-result) - (string= output test-output)) - "~S -> ~S expected" test-output test-result)))) - (call-if-function (test-data-post-function data)))) - -(defmethod run-test ((data side-effect-function-test-data) - &optional stream) - (unwind-protect - (progn - (call-if-function (test-data-pre-function data)) - (let* ((test-form (cons (test-data-symbol data) - (function-test-data-test-args data))) - (result (eval test-form)) - (test-var-list (side-effect-function-test-data-var-list - data)) - (vars (mapcar #'(lambda (c) (car c)) test-var-list)) - (var-list (mapcar - #'(lambda (|v|) (list |v| (eval |v|))) vars))) - (format stream "~S --> ~S ~S : " - test-form result var-list) - (let ((test-result (output-function-test-data-output data))) - (test-return (and (equal result test-result) - (equal test-var-list var-list)) - "~S and ~S expected" test-result test-var-list)))) - (call-if-function (test-data-post-function data)))) - -;; Example -;(defvar list-test (make-instance 'function-test-data -; :symbol 'list -; :test-args '(1 2 3 4 5) -; :result-form '(1 2 3 4 5))) -; -;* (run-test list-test) -;> (LIST 1 2 3 4 5) --> (1 2 3 4 5) : OK -;> (LIST . :OK ) +(use-package :test-suite)

(defvar *cgi-tests*)

@@ -229,6 +97,10 @@ :test-args '('(list 1 2 3)) :output (format nil "(CGI:DEBUG: (LIST 1 2 3) --> (1 2 3))~%")) + (make-instance 'function-test-data + :symbol 'cgi::ca-list-to-a-list + :test-args '('((a . 1)(b . 2)(c . 3))) + :result-form '((a 1)(b 2)(c 3))) (make-instance 'output-function-test-data :symbol 'cgi:header :output (format nil @@ -249,11 +121,8 @@ (fmakunbound 'cgi:header) (load "library:cgi")) :symbol 'cgi:header - :output "") - (make-instance 'function-test-data - :symbol 'cgi::ca-list-to-a-list - :test-args '('((a . 1)(b . 2)(c . 3))) - :result-form '((a 1)(b 2)(c 3))))) + :output ""))) + ; (make-instance 'side-effect-function-test-data ; :symbol 'cgi:init ; :pre-function #'(lambda () @@ -266,5 +135,8 @@ ; :var-list '((cgi:*server-env* t))))) ;

-(defun run () - (mapcar #'run-test *cgi-tests*)) \ No newline at end of file +(eval-when (load) + (unix:unix-exit (cadr (multiple-value-list (run-tests *cgi-tests*))))) + + + \ No newline at end of file