[closure-cvs] CVS update: cxml/test/domtest.lisp

[David Lichteblau]

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