Initial revision.

diff --git a/v7/src/xml/test-parser.scm b/v7/src/xml/test-parser.scm
new file mode 100644 (file)
index 0000000..807e279
--- /dev/null
+++ b/v7/src/xml/test-parser.scm
@@ -0,0 +1,43 @@
+;;; -*-Scheme-*-
+;;;
+;;; $Id: test-parser.scm,v 1.1 2001/07/06 21:17:04 cph Exp $
+;;;
+;;; Copyright (c) 2001 Massachusetts Institute of Technology
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation; either version 2 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;;; 02111-1307, USA.
+
+(define (test-parser pathname)
+  (call-with-input-file pathname
+    (lambda (port)
+      (parse-xml-document (input-port->parser-buffer port)))))
+
+(define (test-directory directory)
+  (map (lambda (pathname)
+        (let ((v (ignore-errors (lambda () (test-parser pathname)))))
+          (write-string ";")
+          (write-string (file-namestring pathname))
+          (write-string ":\t")
+          (cond ((not v)
+                 (write-string "No match."))
+                ((condition? v)
+                 (write-condition-report v (current-output-port)))
+                (else
+                 (write-string "Parsed: ")
+                 (write v)))
+          (newline)
+          v))
+       (directory-read
+       (merge-pathnames "*.xml" (pathname-as-directory directory)))))
\ No newline at end of file