pxml-test.cl

   1 ;;
   2 ;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA
   3 ;;
   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.
   9 ;;
  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.
  14 ;;
  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
  21 ;;
  22
  23 ;; Change Log
  24 ;;
  25 ;; 10/14/00 add namespace example; xml-error related change
  26
  27 (eval-when (compile load eval)
  28   (require :tester))
  29
  30 (defpackage :user (:use :net.uri :net.xml.parser))  ;; assumes pxml.cl loaded
  31 (in-package :user)
  32
  33 ;; these functions are used in the OASIS xmltest subdirectories
  34 ;; see pxml.txt for more information
  35
  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))))
  40
  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
  45                          :content-only t))
  46             (with-open-file (p (concatenate 'string "out/" filename))
  47               (parse-xml p)))))
  48
  49 (defun test-some-files (max &key skip-list external-callback)
  50   (dotimes (i max)
  51     (if* (member (+ 1 i) skip-list) then
  52             (format t "i: ~s skipping...~%" (+ 1 i))
  53        else
  54             (format t "i: ~s equalp: ~s~%" (+ 1 i) (test-one-file (+ 1 i) external-callback)))))
  55
  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)))
  59
  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 ))
  63
  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 ))
  67
  68 (defun test-one-bad-file (filename external-callback)
  69   (ignore-errors
  70    (with-open-file (p filename)
  71      (parse-xml p :external-callback external-callback
  72                 :content-only t))))
  73
  74 (defun test-some-bad-files (max external-callback)
  75   (dotimes (i max)
  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~%"
  81                 index (if error
  82                           (simple-condition-format-arguments error) val))))))
  83
  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))
  87
  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))
  91
  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))
  95
  96 ;; the next stuff is used in the .txt file for documentation
  97
  98 (defvar *xml-example-external-url*
  99     "<!ENTITY ext1 'this is some external entity %param1;'>")
 100
 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
 105      else
 106           (let ((string (eval (intern var-name (find-package :user)))))
 107             (make-string-input-stream string))))
 108
 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))>
 115    <!ELEMENT item2 ANY>
 116    <!ELEMENT item3 (#PCDATA)>
 117    <!ELEMENT item4 (#PCDATA)>
 118    <!ATTLIST item1
 119         att1 CDATA #FIXED 'att1-default'
 120         att2 ID #REQUIRED
 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'>
 126 ]>
 127 <item1 att2='1'><item3>&ext1;</item3></item1>")
 128
 129 (defvar *xml-example-string2*)
 130 (defvar *xml-example-string3*)
 131
 132 ;; bug fix testing
 133 (setf *xml-example-string2*
 134     "<!DOCTYPE example [
 135 <!ELEMENT item1 (item2* | (item3+ , item4))>
 136 ]>
 137 <item1/>")
 138
 139 (setf *xml-example-string3*
 140     "<!DOCTYPE example [
 141 <!ELEMENT item1 (item2* | (item3+ , item4*))>
 142 ]>
 143 <item1/>")
 144
 145 (defvar *xml-example-string4*)
 146
 147 (setf *xml-example-string4*
 148   "<bibliography
 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>
 153        <bib:bibliography
 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>
 158         </bib:bibliography>
 159        <bib:date calendar='Julian'>1999</bib:date>
 160        </bib:book>
 161      </bibliography>")