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 "")))