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 ,@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))))) +;