119
[cxml-rng.git] / test.lisp
blobfb7fbdf0600fd38cdd97d4426069f298485b756b
1 ;;; -*- show-trailing-whitespace: t; indent-tabs: nil -*-
2 ;;;
3 ;;; Copyright (c) 2007 David Lichteblau. All rights reserved.
5 ;;; Redistribution and use in source and binary forms, with or without
6 ;;; modification, are permitted provided that the following conditions
7 ;;; are met:
8 ;;;
9 ;;; * Redistributions of source code must retain the above copyright
10 ;;; notice, this list of conditions and the following disclaimer.
11 ;;;
12 ;;; * Redistributions in binary form must reproduce the above
13 ;;; copyright notice, this list of conditions and the following
14 ;;; disclaimer in the documentation and/or other materials
15 ;;; provided with the distribution.
16 ;;;
17 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
18 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
19 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
20 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
21 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
23 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
24 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
25 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
26 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
27 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30 (in-package :cxml-rng)
32 (defun run-tests (&optional (p "/home/david/src/lisp/cxml-rng/spec-split/*"))
33 (dribble "/home/david/src/lisp/cxml-rng/TEST" :if-exists :rename-and-delete)
34 (let ((pass 0)
35 (total 0)
36 (*package* (find-package :cxml-rng))
37 (*print-level* 3))
38 (dolist (d (directory p))
39 (let ((name (car (last (pathname-directory d)))))
40 (when (parse-integer name :junk-allowed t)
41 (let ((xml (directory (merge-pathnames "*.xml" d))))
42 (incf total (1+ (length xml)))
43 (multiple-value-bind (ok grammar) (test1 d)
44 (cond
45 (ok
46 (incf pass (1+ (run-validation-tests name grammar xml))))
48 (dolist (x xml)
49 (format t "~A-~D: FAIL: cannot run test~%"
50 name
51 (pathname-name x))))))))))
52 (format t "Passed ~D/~D tests.~%" pass total))
53 (dribble))
55 (defun run-validation-test
56 (m n &optional (p "/home/david/src/lisp/cxml-rng/spec-split/"))
57 (let ((d (merge-pathnames (format nil "~3,'0D/" m) p))
58 (*break-on-signals* 'error)
59 (*debug* t)
60 (*print-level* 3))
61 (run-validation-tests m
62 (nth-value 1 (test1 d))
63 (list (let ((v (merge-pathnames
64 (format nil "~A.v.xml" n)
65 d)))
66 (if (probe-file v)
68 (merge-pathnames
69 (format nil "~A.i.xml" n)
70 d)))))))
72 (defun run-validation-tests (name grammar tests)
73 (let ((pass 0))
74 (dolist (x tests)
75 (format t "~A-~D: " name (pathname-name x))
76 (flet ((doit ()
77 (cxml:parse-file x (make-validator grammar))))
78 (if (find #\v (pathname-name x))
79 (handler-case
80 (progn
81 (doit)
82 (incf pass)
83 (format t "PASS~%"))
84 (error (c)
85 (format t "FAIL: ~A~%" c)))
86 (handler-case
87 (progn
88 (doit)
89 (format t "FAIL: didn't detect invalid document~%"))
90 (rng-error (c)
91 (incf pass)
92 (format t "PASS: ~A~%" (type-of c)))
93 (error (c)
94 (format t "FAIL: incorrect condition type: ~A~%" c))))))
95 pass))
97 (defun run-test (n &optional (p "/home/david/src/lisp/cxml-rng/spec-split/"))
98 (test1 (merge-pathnames (format nil "~3,'0D/" n) p)))
100 (defun parse-test (n &optional (p "/home/david/src/lisp/cxml-rng/spec-split/"))
101 (let* ((*debug* t)
102 (d (merge-pathnames (format nil "~3,'0D/" n) p))
103 (i (merge-pathnames "i.rng" d))
104 (c (merge-pathnames "c.rng" d))
105 (rng (if (probe-file c) c i)))
106 (format t "~A: " (car (last (pathname-directory d))))
107 (print rng)
108 (parse-relax-ng rng)))
110 (defun test1 (d)
111 (let* ((i (merge-pathnames "i.rng" d))
112 (c (merge-pathnames "c.rng" d)))
113 (format t "~A: " (car (last (pathname-directory d))))
114 (if (probe-file c)
115 (handler-case
116 (let ((grammar (parse-relax-ng c)))
117 (format t " PASS~%")
118 (values t grammar))
119 (error (c)
120 (format t " FAIL: ~A~%" c)
121 nil))
122 (handler-case
123 (progn
124 (parse-relax-ng i)
125 (format t " FAIL: didn't detect invalid schema~%")
126 nil)
127 (rng-error (c)
128 (format t " PASS: ~S~%" (type-of c))
130 (error (c)
131 (format t " FAIL: incorrect condition type: ~A~%" c)
132 nil)))))