2 ;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA
4 ;; This code is free software; you can redistribute it and/or
5 ;; modify it under the terms of the version 2.1 of
6 ;; the GNU Lesser General Public License as published by
7 ;; the Free Software Foundation, as clarified by the AllegroServe
8 ;; prequel found in license-allegroserve.txt.
10 ;; This code is distributed in the hope that it will be useful,
11 ;; but without any warranty; without even the implied warranty of
12 ;; merchantability or fitness for a particular purpose. See the GNU
13 ;; Lesser General Public License for more details.
15 ;; Version 2.1 of the GNU Lesser General Public License is in the file
16 ;; license-lgpl.txt that was distributed with this file.
17 ;; If it is not present, you can access it from
18 ;; http://www.gnu.org/copyleft/lesser.txt (until superseded by a newer
19 ;; version) or write to the Free Software Foundation, Inc., 59 Temple Place,
20 ;; Suite 330, Boston, MA 02111-1307 USA
25 ;; 10/14/00 add namespace example; xml-error related change
27 (eval-when (compile load eval)
30 (defpackage :user (:use :net.uri :net.xml.parser)) ;; assumes pxml.cl loaded
33 ;; these functions are used in the OASIS xmltest subdirectories
34 ;; see pxml.txt for more information
36 (defun file-callback (filename token &optional public)
37 (declare (ignorable token public))
38 ;;(format t "filename: ~s token: ~s public: ~s~%" filename token public)
39 (ignore-errors (open (uri-path filename))))
41 (defun test-one-file (int external-callback)
42 (let ((filename (concatenate 'string (format nil "~3,'0d" int) ".xml")))
43 (equalp (with-open-file (p filename)
44 (parse-xml p :external-callback external-callback
46 (with-open-file (p (concatenate 'string "out/" filename))
49 (defun test-some-files (max &key skip-list external-callback)
51 (if* (member (+ 1 i) skip-list) then
52 (format t "i: ~s skipping...~%" (+ 1 i))
54 (format t "i: ~s equalp: ~s~%" (+ 1 i) (test-one-file (+ 1 i) external-callback)))))
56 ;; have to be in valid/sa directory when this is run
57 (defun test-sa-files ()
58 (test-some-files 119 :external-callback 'file-callback :skip-list (list 52 64 89)))
60 ;; have to be in valid/ext-sa directory when this is run
61 (defun test-ext-sa-files ()
62 (test-some-files 14 :external-callback 'file-callback ))
64 ;; have to be in valid/not-sa directory when this is run
65 (defun test-not-sa-files ()
66 (test-some-files 31 :external-callback 'file-callback ))
68 (defun test-one-bad-file (filename external-callback)
70 (with-open-file (p filename)
71 (parse-xml p :external-callback external-callback
74 (defun test-some-bad-files (max external-callback)
76 (let* ((index (+ 1 i))
77 (filename (concatenate 'string (format nil "~3,'0d" index) ".xml")))
78 (multiple-value-bind (val error)
79 (test-one-bad-file filename external-callback)
80 (format t "i: ~s error: ~s~%"
82 (simple-condition-format-arguments error) val))))))
84 ;; have to be in not-wf/sa directory when this is run
85 (defun test-not-wf-sa-files ()
86 (test-some-bad-files 186 'file-callback))
88 ;; have to be in not-wf/ext-sa directory when this is run
89 (defun test-not-wf-ext-sa-files ()
90 (test-some-bad-files 3 'file-callback))
92 ;; have to be in not-wf/not-sa directory when this is run
93 (defun test-not-wf-not-sa-files ()
94 (test-some-bad-files 8 'file-callback))
96 ;; the next stuff is used in the .txt file for documentation
98 (defvar *xml-example-external-url*
99 "<!ENTITY ext1 'this is some external entity %param1;'>")
101 (defun example-callback (var-name token &optional public)
102 (declare (ignorable token public))
103 (setf var-name (uri-path var-name))
104 (if* (equal var-name "null") then nil
106 (let ((string (eval (intern var-name (find-package :user)))))
107 (make-string-input-stream string))))
109 (defvar *xml-example-string*
110 "<?xml version='1.0' encoding='utf-8'?>
111 <!-- the following XML input is well-formed but its validity has not been checked ... -->
112 <?piexample this is an example processing instruction tag ?>
113 <!DOCTYPE example SYSTEM '*xml-example-external-url*' [
114 <!ELEMENT item1 (item2* | (item3+ , item4))>
116 <!ELEMENT item3 (#PCDATA)>
117 <!ELEMENT item4 (#PCDATA)>
119 att1 CDATA #FIXED 'att1-default'
121 att3 ( one | two | three ) 'one'
122 att4 NOTATION ( four | five ) 'four' >
123 <!ENTITY % param1 'text'>
124 <!ENTITY nentity SYSTEM 'null' NDATA somedata>
125 <!NOTATION notation SYSTEM 'notation-processor'>
127 <item1 att2='1'><item3>&ext1;</item3></item1>")
129 (defvar *xml-example-string2*)
130 (defvar *xml-example-string3*)
133 (setf *xml-example-string2*
135 <!ELEMENT item1 (item2* | (item3+ , item4))>
139 (setf *xml-example-string3*
141 <!ELEMENT item1 (item2* | (item3+ , item4*))>
145 (defvar *xml-example-string4*)
147 (setf *xml-example-string4*
149 xmlns:bib='http://www.bibliography.org/XML/bib.ns'
150 xmlns='urn:com:books-r-us'>
151 <bib:book owner='Smith'>
152 <bib:title>A Tale of Two Cities</bib:title>
154 xmlns:bib='http://www.franz.com/XML/bib.ns'
155 xmlns='urn:com:books-r-us'>
156 <bib:library branch='Main'>UK Library</bib:library>
157 <bib:date calendar='Julian'>1999</bib:date>
159 <bib:date calendar='Julian'>1999</bib:date>