[clhp-cvs] CVS update: clhp/tests/cgi-test.lisp
Anthony Ventimiglia
aventimiglia at common-lisp.net
Fri Oct 3 05:14:23 UTC 2003
Update of /project/clhp/cvsroot/clhp/tests
In directory common-lisp.net:/tmp/cvs-serv4163/tests
Modified Files:
cgi-test.lisp
Log Message:
(SIDE-EFFECT-FUNCTION-TEST-DATA): Test class
for functions to test side effects that set globals. Still don't
have it working right. Also improved the run-test methods by
writing some macros, there's more work to do here as well.
Date: Fri Oct 3 01:14:23 2003
Author: aventimiglia
Index: clhp/tests/cgi-test.lisp
diff -u clhp/tests/cgi-test.lisp:1.4 clhp/tests/cgi-test.lisp:1.5
--- clhp/tests/cgi-test.lisp:1.4 Thu Oct 2 22:40:39 2003
+++ clhp/tests/cgi-test.lisp Fri Oct 3 01:14:23 2003
@@ -29,14 +29,16 @@
(unless (find-package :cgi)
(load "library:cgi")))
+;; These macros Used for run-test methods
(defmacro call-if-function (form)
`(when (functionp ,form) (funcall ,form)))
-(defmacro test-result (result)
- "Used to return results of tests for run-test methods"
- ;; This will work as long as all RUN-TEST methods use DATA for their
- ;; TEST-DATA object.
- `(cons (test-data-symbol data) ,result))
+(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
@@ -57,11 +59,6 @@
(:documentation "Abstract supertype for CLASS, STRUCTURE, VARIABLE
and FUNCTION test-data"))
-(defmethod run-test ((data test-data) &optional stream)
- "Since TEST-DATA is an abstract test class, we cannot actually use it."
- (declare (ignore stream))
- (test-result :error))
-
(defclass function-test-data (test-data)
((test-args :initform NIL
:type list
@@ -77,24 +74,6 @@
(: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"))
-
-(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)
- (test-result
- (let ((test-result (function-test-data-result-form data)))
- (if (equal result test-result)
- (progn
- (format stream "OK~%") :OK)
- (progn
- (format stream "FAILED ~S expected~%" test-result) :error))))))
- (call-if-function (test-data-post-function data))))
(defclass output-function-test-data (function-test-data)
((output :initform NIL
@@ -106,9 +85,44 @@
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."))
+
+
+(defmethod run-test ((data test-data) &optional stream)
+ "Since TEST-DATA is an abstract test class, we cannot actually use it."
+ (declare (ignore stream))
+ (test-result :error))
+
+;; 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*))
- (call-if-function (test-data-pre-function data))
(unwind-protect
(progn
(call-if-function (test-data-pre-function data))
@@ -120,16 +134,34 @@
(*standard-output* output)
(eval test-form))))
(format stream "~S --> ~S ~S : " test-form output result)
- (test-result
- (let ((test-output (output-function-test-data-output data))
- (test-result (function-test-data-result-form data)))
- (if (and (equal result test-result)
- (string= output test-output))
- (progn (format stream "OK~%") :OK)
- (progn (format stream "FAILED ~S ~S expected~%" test-output
- test-result) :ERROR))))))
+ (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
@@ -138,14 +170,11 @@
;
;* (run-test list-test)
;> (LIST 1 2 3 4 5) --> (1 2 3 4 5) : OK
-;> (1 2 3 4 5)
+;> (LIST . :OK )
(defvar *cgi-tests*)
;; Still to be tested
-;; All functions which print to stdout, I'll have to devise a test for them:
-;; DEBUG HEADER
-;;
;; Functions which have side effects and no return values
;; INIT
;;
@@ -192,6 +221,7 @@
(push (list :query_string
"index=foo&type=bar%20baz")
cgi:*server-env*))
+ :post-function #'(lambda () (setq cgi:*server-env* nil))
:test-args nil
:result-form '(#\i #\n #\d #\e #\x #\= #\f #\o #\o #\& #\t
#\y #\p #\e #\= #\b #\a #\r #\% #\2 #\0 #\b
@@ -225,4 +255,19 @@
(fmakunbound 'cgi:header)
(load "library:cgi"))
:symbol 'cgi:header
- :output "")))
+ :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)))))
+; (make-instance 'side-effect-function-test-data
+; :symbol 'cgi:init
+; :pre-function #'(lambda ()
+; (setq ext:*environment-list*
+; '((:request_method . "post")
+; (:query_string . "hi=4&a=5"))))
+; :post-function #'(lambda ()
+; (setq ext:*environment-list* "nil"))
+; :result-form '(values)
+; :var-list '((cgi:*server-env* t)))))
+;
More information about the Clhp-cvs
mailing list