[clhp-cvs] CVS update: clhp/tests/test-suite.lisp clhp/tests/Makefile clhp/tests/cgi-test.lisp
Anthony Ventimiglia
aventimiglia at common-lisp.net
Wed Oct 15 14:05:58 UTC 2003
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 , at 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
More information about the Clhp-cvs
mailing list