[clhp-cvs] CVS update: clhp/tests/cgi-test.lisp
Anthony Ventimiglia
aventimiglia at common-lisp.net
Fri Oct 3 00:38:18 UTC 2003
Update of /project/clhp/cvsroot/clhp/tests
In directory common-lisp.net:/tmp/cvs-serv24566/tests
Modified Files:
cgi-test.lisp
Log Message:
* tests/cgi-test.lisp (output-function-test-data): Designed a
class to test functions which print to *standard-output*. These
test classes will be reused for clhp.lisp, and eventually moved
into their own package.
Date: Thu Oct 2 20:38:18 2003
Author: aventimiglia
Index: clhp/tests/cgi-test.lisp
diff -u clhp/tests/cgi-test.lisp:1.2 clhp/tests/cgi-test.lisp:1.3
--- clhp/tests/cgi-test.lisp:1.2 Thu Oct 2 13:43:05 2003
+++ clhp/tests/cgi-test.lisp Thu Oct 2 20:38:17 2003
@@ -1,4 +1,4 @@
-(ext:file-comment "$Id")
+#+cmu (ext:file-comment "$Id")
;;
;; CLHP the Common Lisp Hypertext Preprocessor
;; (C) 2003 Anthony J Ventimiglia
@@ -25,9 +25,19 @@
;; These classes and methods should be a separate package
+(eval-when (:load-toplevel :compile-toplevel)
+ (unless (find-package :cgi)
+ (load "library:cgi")))
+
(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))
+
(defclass test-data ()
((symbol :initform NIL
:type symbol
@@ -50,7 +60,7 @@
(defmethod run-test ((data test-data) &optional stream)
"Since TEST-DATA is an abstract test class, we cannot actually use it."
(declare (ignore stream))
- 'error)
+ (test-result :error))
(defclass function-test-data (test-data)
((test-args :initform NIL
@@ -70,19 +80,56 @@
(defmethod run-test ((data function-test-data)
&optional (stream *standard-output*))
- (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)
- (if (equal result (function-test-data-result-form data))
- (format stream "OK~%")
- (format stream "FAILED ~S expected~%"
- (function-test-data-result-form data)))
- (prog1
- result
- (call-if-function (test-data-post-function data)))))
+ (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
+ :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."))
+
+(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))
+ (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)
+ (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))))))
+ (call-if-function (test-data-post-function data))))
+
;; Example
;(defvar list-test (make-instance 'function-test-data
; :symbol 'list
@@ -95,10 +142,6 @@
(defvar *cgi-tests*)
-(eval-when (:load-toplevel :compile-toplevel)
- (unless (find-package :cgi)
- (load "library:cgi")))
-
;; Still to be tested
;; All functions which print to stdout, I'll have to devise a test for them:
;; DEBUG HEADER
@@ -110,7 +153,7 @@
;; POST-DATA QUERY-TO-A-LIST HANDLE-GENERAL-ERROR
;; Use the following to run-tests
-;; (mapcar #'run-tests *cgi-tests*)
+;; (mapcar #'run-test *cgi-tests*)
(setf *cgi-tests*
(list
(make-instance 'function-test-data
@@ -152,4 +195,34 @@
:test-args nil
:result-form '(#\i #\n #\d #\e #\x #\= #\f #\o #\o #\& #\t
#\y #\p #\e #\= #\b #\a #\r #\% #\2 #\0 #\b
- #\a #\z))))
+ #\a #\z))
+ (make-instance 'function-test-data
+ :symbol 'cgi::a-list-value
+ :test-args '(2 '((1 . f) (3 . g) (6 . h) (2 . y)))
+ :result-form 'y)
+ (make-instance 'output-function-test-data
+ :symbol 'cgi:debug
+ :test-args '('(list 1 2 3))
+ :output (format nil
+ "(CGI:DEBUG: (LIST 1 2 3) --> (1 2 3))~%"))
+ (make-instance 'output-function-test-data
+ :symbol 'cgi:header
+ :output (format nil
+ "Content-type: TEXT/PLAIN~%~%")
+ :result-form t)
+ ;; We test header twice to make sure it only outputs the first
+ ;; time. The post-function should reset the internals of the header
+ ;; function so successive tests will pass, but by reloading the
+ ;; package, all the symbols in this list get uninterned, however
+ ;; they are still bound to the functions. so in order to run the
+ ;; tests again, you have to re evaluate this setq. This is only a
+ ;; problem in interactive env. if these tests are being run as a
+ ;; one time deal (which is the eventual goal) none of this will be
+ ;; a problem.
+ (make-instance 'output-function-test-data
+ :post-function #'(lambda ()
+ (delete-package :cgi)
+ (fmakunbound 'cgi:header)
+ (load "library:cgi"))
+ :symbol 'cgi:header
+ :output "")))
More information about the Clhp-cvs
mailing list