Update of /project/cxml/cvsroot/cxml/test In directory common-lisp.net:/tmp/cvs-serv15147/test
Modified Files: domtest.lisp Log Message: update DOM test suite driver
Date: Wed Apr 6 23:14:41 2005 Author: dlichteblau
Index: cxml/test/domtest.lisp diff -u cxml/test/domtest.lisp:1.1.1.14 cxml/test/domtest.lisp:1.2 --- cxml/test/domtest.lisp:1.1.1.14 Sun Mar 13 19:02:51 2005 +++ cxml/test/domtest.lisp Wed Apr 6 23:14:41 2005 @@ -192,6 +192,7 @@ (defun translate-condition (element) (string-case (tag-name element) ("equals" (translate-equals element)) + ("notEquals" (translate-not-equals element)) ("contentType" (translate-content-type element)) ("hasFeature" (translate-has-feature element)) ("implementationAttribute" (assert-have-implementation-attribute element)) @@ -200,6 +201,7 @@ ("notNull" (translate-not-null element)) ("or" (translate-or element)) ("same" (translate-same element)) + ("less" (translate-less element)) (t (error "unknown condition: ~A" element))))
(defun equalsp (a b test) @@ -223,10 +225,17 @@ ,(parse-java-literal |expected|) ',(if (parse-java-literal |ignoreCase|) '%equal '%equal))))
+(defun translate-not-equals (element) + `(not ,(translate-equals element))) + (defun translate-same (element) (with-attributes (|actual| |expected|) element `(eql ,(%intern |actual|) ,(parse-java-literal |expected|))))
+(defun translate-less (element) + (with-attributes (|actual| |expected|) element + `(< ,(%intern |actual|) ,(parse-java-literal |expected|)))) + (defun translate-or (element) `(or ,@(map-child-elements 'list #'translate-condition element)))
@@ -317,6 +326,7 @@ ("assertTrue" (translate-assert-true element)) ("assertFalse" (translate-assert-false element)) ("assertURIEquals" (translate-assert-uri-equals element)) + ("assign" (translate-assign element)) ("for-each" (translate-for-each element)) ("fail" (translate-fail element)) ("hasFeature" (translate-has-feature element)) @@ -337,6 +347,10 @@ `(,fn ,(parse-java-literal |op1|) ,(parse-java-literal |op2|)))))
+(defun translate-assign (element) + (with-attributes (|var| |value|) element + (maybe-setf (%intern |var|) (parse-java-literal |value|)))) + (defun translate-unary-assignment (fn element) (with-attributes (|var| |value|) element (maybe-setf (%intern |var|) @@ -599,7 +613,8 @@ document))
(defparameter *bad-tests* - '("hc_elementnormalize2.xml" "hc_nodereplacechildnewchildexists.xml")) + '("hc_nodereplacechildnewchildexists.xml" + "characterdatadeletedatanomodificationallowederr.xml"))
(defun run-all-tests (*directory* &optional verbose) (let* ((cxml::*redefinition-warning* nil) @@ -613,13 +628,15 @@ (nfailed 0)) (do-child-elements (member suite) (unless - (member (runes:rod-string (dom:get-attribute member "href")) - *bad-tests* - :test 'equal) + (or (equal (dom:tag-name member) "metadata") + (member (runes:rod-string (dom:get-attribute member "href")) + *bad-tests* + :test 'equal)) (incf n))) (do-child-elements (member suite) (let ((href (runes:rod-string (dom:get-attribute member "href")))) - (unless (member href *bad-tests* :test 'equal) + (unless (or (equal (dom:tag-name member) "metadata") + (member href *bad-tests* :test 'equal)) (format t "~&~D/~D ~A~%" i n href) (let ((lisp (slurp-test (merge-pathnames href test-directory)))) (when verbose