diff --git a/README.html b/README.html index 939873e..ac3588a 100644 --- a/README.html +++ b/README.html @@ -114,6 +114,8 @@ $ cvs co cxml to parse-dtd-stream; SAX proxy class
  • Minor bugfixes: Workaround for CMUCL problem with fd-streams (can read from cmucl sockets now)
    • +
  • Port to OpenMCL (thanks to Rudi Schlatte).
    • +
  • Port to LispWorks (thanks to Edi Weitz).

    • patch-357 (2004-10-10)

    Incomplete port: diff --git a/cxml.asd b/cxml.asd index 11a585f..8f3cadc 100644 --- a/cxml.asd +++ b/cxml.asd @@ -53,7 +53,9 @@ #+(and allegro-version>= (version>= 5.0)) "dep-acl5" #+(and allegro-version>= (not (version>= 5.0))) "dep-acl" #+openmcl "dep-openmcl" - #-(or sbcl CLISP CMU allegro openmcl) #.(error "Configure!") + #+lispworks "dep-lw" + #-(or sbcl CLISP CMU allegro openmcl lispworks) + #.(error "unsupported lisp implementation!") :depends-on ("package")) (:file runes :pathname diff --git a/runes/characters.lisp b/runes/characters.lisp index 828a40c..58674f5 100644 --- a/runes/characters.lisp +++ b/runes/characters.lisp @@ -24,9 +24,9 @@ (in-package :runes) -(deftype rune () 'character) -(deftype rod () '(vector character)) -(deftype simple-rod () '(simple-array character)) +(deftype rune () #-lispworks 'character #+lispworks 'lw:simple-char) +(deftype rod () '(vector rune)) +(deftype simple-rod () '(simple-array rune)) (definline rune (rod index) (char rod index)) @@ -101,7 +101,7 @@ (string-equal x y)) (definline make-rod (size) - (make-string size)) + (make-string size :element-type 'rune)) (defun char-rune (char) char) diff --git a/runes/dep-lw.lisp b/runes/dep-lw.lisp new file mode 100644 index 0000000..b6bfbbd --- /dev/null +++ b/runes/dep-lw.lisp @@ -0,0 +1,30 @@ +;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*- +;;; --------------------------------------------------------------------------- +;;; Title: LispWorks dependent stuff + fixups +;;; Created: 2005-01-28 09:43 +;;; Author: Edi Weitz (Copied from dep-cmucl.lisp) +;;; License: LLGPL (See file COPYING for details). +;;; --------------------------------------------------------------------------- +;;; (c) copyright 1999 by Gilbert Baumann + +;;; This code is free software; you can redistribute it and/or modify it +;;; under the terms of the version 2.1 of the GNU Lesser General Public +;;; License as published by the Free Software Foundation, as clarified +;;; by the "Preamble to the Gnu Lesser General Public License" found in +;;; the file COPYING. +;;; +;;; This code 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 +;;; Lesser General Public License for more details. +;;; +;;; Version 2.1 of the GNU Lesser General Public License is in the file +;;; COPYING that was distributed with this file. If it is not present, +;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until +;;; superseded by a newer version) or write to the Free Software +;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +(defmacro runes::definline (name args &body body) + `(progn + (declaim (inline ,name)) + (defun ,name ,args .,body))) diff --git a/test/xmlconf.lisp b/test/xmlconf.lisp index 7f7c752..d4b53ea 100644 --- a/test/xmlconf.lisp +++ b/test/xmlconf.lisp @@ -6,25 +6,37 @@ (defun get-attribute (element name) (rod-string (dom:get-attribute element name))) -(defun relevant-test-p (test) - (and (equal (get-attribute test "TYPE") "valid") - (let ((version (get-attribute test "RECOMMENDATION"))) - (cond - ((or (equal version "") ;XXX - (equal version "XML1.0")) - (cond - ((equal (get-attribute test "NAMESPACE") "no") - (format t "~A: test applies to parsers without namespace support, skipping~%" - (get-attribute test "URI")) - nil) - (t - t))) - ((equal version "XML1.1") - ;; not supported - nil) - (t - (warn "unrecognized RECOMMENDATION value: ~S" version) - nil))))) +(defparameter *bad-tests* + '(;; TS14 + ;; http://lists.w3.org/Archives/Public/public-xml-testsuite/2002Mar/0001.html + "ibm-valid-P28-ibm28v02.xml" + "ibm-valid-P29-ibm29v01.xml" + "ibm-valid-P29-ibm29v02.xml")) + +(defun test-class (test) + (cond + ((not (and (let ((version (get-attribute test "RECOMMENDATION"))) + (cond + ((or (equal version "") ;XXX + (equal version "XML1.0")) + (cond + ((equal (get-attribute test "NAMESPACE") "no") + (format t "~A: test applies to parsers without namespace support, skipping~%" + (get-attribute test "URI")) + nil) + (t + t))) + ((equal version "XML1.1") + ;; not supported + nil) + (t + (warn "unrecognized RECOMMENDATION value: ~S" version) + nil))) + (not (member (get-attribute test "ID") *bad-tests* :test 'equal)))) + nil) + ((equal (get-attribute test "TYPE") "valid") :valid) + ((equal (get-attribute test "TYPE") "invalid") :invalid) + (t nil))) (defun test-pathnames (directory test) (let* ((sub-directory @@ -42,10 +54,10 @@ (defun serialize-document (document) (map 'vector #'char-code (with-output-to-string (s) - (xml:unparse-document document s)))) + (cxml:unparse-document document s :canonical 2)))) (defun file-contents (pathname) - (with-open-file (s pathname) + (with-open-file (s pathname :element-type '(unsigned-byte 8)) (let ((result (make-array (file-length s) :element-type '(unsigned-byte 8)))) (read-sequence result s ) @@ -54,51 +66,94 @@ (defun run-all-tests (directory) (let* ((pathname (merge-pathnames "xmlconf.xml" directory)) (builder (dom:make-dom-builder)) - (xmlconf (xml:parse-file pathname builder)) + (xmlconf (cxml:parse-file pathname builder)) (ntried 0) (nfailed 0) - (nskipped 0)) + (nskipped 0) + ;; XXX someone found it funny to include invalid URIs in the + ;; test suite. And no, in "invalid" not "not-wf". + (puri:*strict-parse* nil)) (dom:do-node-list (test (dom:get-elements-by-tag-name xmlconf "TEST")) - (cond - ((relevant-test-p test) - (incf ntried) - (multiple-value-bind (pathname output) - (test-pathnames directory test) - (princ pathname) - (unless (probe-file pathname) - (error "file not found: ~A" pathname)) - (with-simple-restart (skip-test "Skip this test") - (handler-case - (progn - (mp:with-timeout (60) - (let ((document - (xml:parse-file pathname (dom:make-dom-builder)))) - (cond - ((null output) - (format t " ok (output not checked)~%")) - ((equalp (file-contents output) - (serialize-document document)) - (format t " ok~%")) - (t - (let ((error-output - (make-pathname :type "error" :defaults output))) - (with-open-file (s error-output - :direction :output - :if-exists :supersede) - (write-sequence (serialize-document document) s)) - (error "well-formed, but output ~S not the expected ~S~%" - error-output output))))))) - ((and serious-condition (not excl:interrupt-signal)) (c) - (incf nfailed) - (format t " FAILED:~% ~A~%[~A]~%" - c - (rod-string - (dom:data - (dom:item (dom:child-nodes test) 0))))))))) - (t - (incf nskipped)))) + (let ((description + (rod-string (dom:data (dom:item (dom:child-nodes test) 0)))) + (class (test-class test))) + (cond + (class + (incf ntried) + (multiple-value-bind (pathname output) + (test-pathnames directory test) + (princ pathname) + (unless (probe-file pathname) + (error "file not found: ~A" pathname)) + (with-simple-restart (skip-test "Skip this test") + (unless (run-test class pathname output description) + (incf nfailed)) + (fresh-line)))) + (t + (incf nskipped))))) (format t "~&~D/~D tests failed; ~D test~:P were skipped" nfailed ntried nskipped))) +(defmethod run-test :around (class pathname output description &rest args) + (declare (ignore class pathname output args)) + (handler-case + (call-next-method) + (serious-condition (c) + (format t " FAILED:~% ~A~%[~A]~%" c description) + nil))) + +(defmethod run-test ((class null) pathname output description &rest args) + (declare (ignore description)) + (let ((document (apply #'cxml:parse-file + pathname + (dom:make-dom-builder) + args))) + (cond + ((null output) + (format t " input")) + ((equalp (file-contents output) (serialize-document document)) + (format t " input/output")) + (t + (let ((error-output (make-pathname :type "error" :defaults output))) + (with-open-file (s error-output + :element-type '(unsigned-byte 8) + :direction :output + :if-exists :supersede) + (write-sequence (serialize-document document) s)) + (error "well-formed, but output ~S not the expected ~S~%" + error-output output)))) + t)) + +(defmethod run-test + ((class (eql :valid)) pathname output description &rest args) + (assert (null args)) + (and (progn + (format t " [not validating:]") + (run-test nil pathname output description :validate nil)) + (progn + (format t " [validating:]") + (run-test nil pathname output description :validate t)))) + +(defmethod run-test + ((class (eql :invalid)) pathname output description &rest args) + (assert (null args)) + (and (progn + (format t " [not validating:]") + (run-test nil pathname output description :validate nil)) + (handler-case + (progn + (format t " [validating:]") + (cxml:parse-file pathname (dom:make-dom-builder) :validate t) + (error "validity error not detected") + nil) + (cxml:validity-error () + (format t " invalid") + t)))) + #+(or) (xmlconf::run-all-tests "/mnt/debian/space/xmlconf/") + +#+(or) +(progn + (#+allegro mp:with-timeout #+allegro (60) #-allegro progn + )) diff --git a/xml/package.lisp b/xml/package.lisp index 6722810..db5f744 100644 --- a/xml/package.lisp +++ b/xml/package.lisp @@ -1,17 +1,23 @@ +;;;; package.lisp -- Paketdefinition +;;;; +;;;; This file is part of the CXML parser, released under (L)LGPL. +;;;; See file COPYING for details. + (in-package :cl-user) -(defpackage :Encoding - (:use :glisp) +(defpackage :cxml + (:use :cl :runes :encoding) + (:import-from #+sbcl :sb-gray + #+allegro :excl + #+cmu :ext + #+clisp :gray + #+openmcl :ccl + #+lispworks :stream + #-(or sbcl allegro cmu clisp openmcl lispworks) ... + #:fundamental-binary-input-stream + #-(or clisp openmcl) #:stream-read-sequence + stream-read-byte) (:export - #:find-encoding - #:decode-sequence)) - -(defpackage :XML - (:use - :glisp - :encoding) - - (:Export ;; xstreams #:make-xstream #:make-rod-xstream @@ -38,4 +44,41 @@ #:parse-file #:parse-stream - #:parse-string) ) + ;; XXX encoding is mis-handled by parse-string, don't export it + ;; #:parse-string + #:parse-octets + + #:make-character-stream-sink + #:make-octet-vector-sink + #:make-octet-stream-sink + #:unparse-document + #:unparse-document-to-octets + + #:with-xml-output + #:with-element + #:attribute + #:cdata + #:text + + #:parse-dtd-file + #:parse-dtd-stream + #:validity-error + #:make-validator + + #:*cache-all-dtds* + #:*dtd-cache* + #:getdtd + #:remdtd + #:make-dtd-cache + #:clear-dtd-cache + #:make-extid + + #:*catalog* + #:*prefer* + #:make-catalog + #:resolve-uri + #:resolve-extid + + #:make-recoder + #:sax-proxy + #:proxy-chained-handler)) diff --git a/xml/xml-name-rune-p.lisp b/xml/xml-name-rune-p.lisp index 2f5a8a0..26dc699 100644 --- a/xml/xml-name-rune-p.lisp +++ b/xml/xml-name-rune-p.lisp @@ -162,43 +162,45 @@ (<= 12540 rune 12542))) (base-rune-p (rune) - (or - (<= 65 rune 90) (<= 97 rune 122) (<= 192 rune 214) (<= 216 rune 246) (<= 248 rune 255) (<= 256 rune 305) - (<= 308 rune 318) (<= 321 rune 328) (<= 330 rune 382) (<= 384 rune 451) (<= 461 rune 496) (<= 500 rune 501) - (<= 506 rune 535) (<= 592 rune 680) (<= 699 rune 705) (= 902 rune) (<= 904 rune 906) (= 908 rune) - (<= 910 rune 929) (<= 931 rune 974) (<= 976 rune 982) (= 986 rune) (= 988 rune) (= 990 rune) (= 992 rune) - (<= 994 rune 1011) (<= 1025 rune 1036) (<= 1038 rune 1103) (<= 1105 rune 1116) (<= 1118 rune 1153) - (<= 1168 rune 1220) (<= 1223 rune 1224) (<= 1227 rune 1228) (<= 1232 rune 1259) (<= 1262 rune 1269) - (<= 1272 rune 1273) (<= 1329 rune 1366) (= 1369 rune) (<= 1377 rune 1414) (<= 1488 rune 1514) - (<= 1520 rune 1522) (<= 1569 rune 1594) (<= 1601 rune 1610) (<= 1649 rune 1719) (<= 1722 rune 1726) - (<= 1728 rune 1742) (<= 1744 rune 1747) (= 1749 rune) (<= 1765 rune 1766) (<= 2309 rune 2361) (= 2365 rune) - (<= 2392 rune 2401) (<= 2437 rune 2444) (<= 2447 rune 2448) (<= 2451 rune 2472) (<= 2474 rune 2480) - (= 2482 rune) (<= 2486 rune 2489) (<= 2524 rune 2525) (<= 2527 rune 2529) (<= 2544 rune 2545) - (<= 2565 rune 2570) (<= 2575 rune 2576) (<= 2579 rune 2600) (<= 2602 rune 2608) (<= 2610 rune 2611) - (<= 2613 rune 2614) (<= 2616 rune 2617) (<= 2649 rune 2652) (= 2654 rune) (<= 2674 rune 2676) - (<= 2693 rune 2699) (= 2701 rune) (<= 2703 rune 2705) (<= 2707 rune 2728) (<= 2730 rune 2736) - (<= 2738 rune 2739) (<= 2741 rune 2745) (= 2749 rune) (= 2784 rune) (<= 2821 rune 2828) (<= 2831 rune 2832) - (<= 2835 rune 2856) (<= 2858 rune 2864) (<= 2866 rune 2867) (<= 2870 rune 2873) (= 2877 rune) - (<= 2908 rune 2909) (<= 2911 rune 2913) (<= 2949 rune 2954) (<= 2958 rune 2960) (<= 2962 rune 2965) - (<= 2969 rune 2970) (= 2972 rune) (<= 2974 rune 2975) (<= 2979 rune 2980) (<= 2984 rune 2986) - (<= 2990 rune 2997) (<= 2999 rune 3001) (<= 3077 rune 3084) (<= 3086 rune 3088) (<= 3090 rune 3112) - (<= 3114 rune 3123) (<= 3125 rune 3129) (<= 3168 rune 3169) (<= 3205 rune 3212) (<= 3214 rune 3216) - (<= 3218 rune 3240) (<= 3242 rune 3251) (<= 3253 rune 3257) (= 3294 rune) (<= 3296 rune 3297) - (<= 3333 rune 3340) (<= 3342 rune 3344) (<= 3346 rune 3368) (<= 3370 rune 3385) (<= 3424 rune 3425) - (<= 3585 rune 3630) (= 3632 rune) (<= 3634 rune 3635) (<= 3648 rune 3653) (<= 3713 rune 3714) (= 3716 rune) - (<= 3719 rune 3720) (= 3722 rune) (= 3725 rune) (<= 3732 rune 3735) (<= 3737 rune 3743) (<= 3745 rune 3747) - (= 3749 rune) (= 3751 rune) (<= 3754 rune 3755) (<= 3757 rune 3758) (= 3760 rune) (<= 3762 rune 3763) (= 3773 rune) - (<= 3776 rune 3780) (<= 3904 rune 3911) (<= 3913 rune 3945) (<= 4256 rune 4293) (<= 4304 rune 4342) - (= 4352 rune) (<= 4354 rune 4355) (<= 4357 rune 4359) (= 4361 rune) (<= 4363 rune 4364) (<= 4366 rune 4370) - (= 4412 rune) (= 4414 rune) (= 4416 rune) (= 4428 rune) (= 4430 rune) (= 4432 rune) (<= 4436 rune 4437) (= 4441 rune) - (<= 4447 rune 4449) (= 4451 rune) (= 4453 rune) (= 4455 rune) (= 4457 rune) (<= 4461 rune 4462) (<= 4466 rune 4467) - (= 4469 rune) (= 4510 rune) (= 4520 rune) (= 4523 rune) (<= 4526 rune 4527) (<= 4535 rune 4536) (= 4538 rune) - (<= 4540 rune 4546) (= 4587 rune) (= 4592 rune) (= 4601 rune) (<= 7680 rune 7835) (<= 7840 rune 7929) - (<= 7936 rune 7957) (<= 7960 rune 7965) (<= 7968 rune 8005) (<= 8008 rune 8013) (<= 8016 rune 8023) - (= 8025 rune) (= 8027 rune) (= 8029 rune) (<= 8031 rune 8061) (<= 8064 rune 8116) (<= 8118 rune 8124) (= 8126 rune) - (<= 8130 rune 8132) (<= 8134 rune 8140) (<= 8144 rune 8147) (<= 8150 rune 8155) (<= 8160 rune 8172) - (<= 8178 rune 8180) (<= 8182 rune 8188) (= 8486 rune) (<= 8490 rune 8491) (= 8494 rune) (<= 8576 rune 8578) - (<= 12353 rune 12436) (<= 12449 rune 12538) (<= 12549 rune 12588) (<= 44032 rune 55203))) + ;; split into two ORs for LispWorks... + (or + (or (<= 65 rune 90) (<= 97 rune 122) (<= 192 rune 214) (<= 216 rune 246) (<= 248 rune 255) (<= 256 rune 305) + (<= 308 rune 318) (<= 321 rune 328) (<= 330 rune 382) (<= 384 rune 451) (<= 461 rune 496) (<= 500 rune 501) + (<= 506 rune 535) (<= 592 rune 680) (<= 699 rune 705) (= 902 rune) (<= 904 rune 906) (= 908 rune) + (<= 910 rune 929) (<= 931 rune 974) (<= 976 rune 982) (= 986 rune) (= 988 rune) (= 990 rune) (= 992 rune) + (<= 994 rune 1011) (<= 1025 rune 1036) (<= 1038 rune 1103) (<= 1105 rune 1116) (<= 1118 rune 1153) + (<= 1168 rune 1220) (<= 1223 rune 1224) (<= 1227 rune 1228) (<= 1232 rune 1259) (<= 1262 rune 1269) + (<= 1272 rune 1273) (<= 1329 rune 1366) (= 1369 rune) (<= 1377 rune 1414) (<= 1488 rune 1514) + (<= 1520 rune 1522) (<= 1569 rune 1594) (<= 1601 rune 1610) (<= 1649 rune 1719) (<= 1722 rune 1726) + (<= 1728 rune 1742) (<= 1744 rune 1747) (= 1749 rune) (<= 1765 rune 1766) (<= 2309 rune 2361) (= 2365 rune) + (<= 2392 rune 2401) (<= 2437 rune 2444) (<= 2447 rune 2448) (<= 2451 rune 2472) (<= 2474 rune 2480) + (= 2482 rune) (<= 2486 rune 2489) (<= 2524 rune 2525) (<= 2527 rune 2529) (<= 2544 rune 2545) + (<= 2565 rune 2570) (<= 2575 rune 2576) (<= 2579 rune 2600) (<= 2602 rune 2608) (<= 2610 rune 2611) + (<= 2613 rune 2614) (<= 2616 rune 2617) (<= 2649 rune 2652) (= 2654 rune) (<= 2674 rune 2676) + (<= 2693 rune 2699) (= 2701 rune) (<= 2703 rune 2705) (<= 2707 rune 2728) (<= 2730 rune 2736) + (<= 2738 rune 2739) (<= 2741 rune 2745) (= 2749 rune) (= 2784 rune) (<= 2821 rune 2828) (<= 2831 rune 2832) + (<= 2835 rune 2856) (<= 2858 rune 2864) (<= 2866 rune 2867) (<= 2870 rune 2873) (= 2877 rune) + (<= 2908 rune 2909) (<= 2911 rune 2913) (<= 2949 rune 2954) (<= 2958 rune 2960) (<= 2962 rune 2965) + (<= 2969 rune 2970) (= 2972 rune)) + (or (<= 2974 rune 2975) (<= 2979 rune 2980) (<= 2984 rune 2986) + (<= 2990 rune 2997) (<= 2999 rune 3001) (<= 3077 rune 3084) (<= 3086 rune 3088) (<= 3090 rune 3112) + (<= 3114 rune 3123) (<= 3125 rune 3129) (<= 3168 rune 3169) (<= 3205 rune 3212) (<= 3214 rune 3216) + (<= 3218 rune 3240) (<= 3242 rune 3251) (<= 3253 rune 3257) (= 3294 rune) (<= 3296 rune 3297) + (<= 3333 rune 3340) (<= 3342 rune 3344) (<= 3346 rune 3368) (<= 3370 rune 3385) (<= 3424 rune 3425) + (<= 3585 rune 3630) (= 3632 rune) (<= 3634 rune 3635) (<= 3648 rune 3653) (<= 3713 rune 3714) (= 3716 rune) + (<= 3719 rune 3720) (= 3722 rune) (= 3725 rune) (<= 3732 rune 3735) (<= 3737 rune 3743) (<= 3745 rune 3747) + (= 3749 rune) (= 3751 rune) (<= 3754 rune 3755) (<= 3757 rune 3758) (= 3760 rune) (<= 3762 rune 3763) (= 3773 rune) + (<= 3776 rune 3780) (<= 3904 rune 3911) (<= 3913 rune 3945) (<= 4256 rune 4293) (<= 4304 rune 4342) + (= 4352 rune) (<= 4354 rune 4355) (<= 4357 rune 4359) (= 4361 rune) (<= 4363 rune 4364) (<= 4366 rune 4370) + (= 4412 rune) (= 4414 rune) (= 4416 rune) (= 4428 rune) (= 4430 rune) (= 4432 rune) (<= 4436 rune 4437) (= 4441 rune) + (<= 4447 rune 4449) (= 4451 rune) (= 4453 rune) (= 4455 rune) (= 4457 rune) (<= 4461 rune 4462) (<= 4466 rune 4467) + (= 4469 rune) (= 4510 rune) (= 4520 rune) (= 4523 rune) (<= 4526 rune 4527) (<= 4535 rune 4536) (= 4538 rune) + (<= 4540 rune 4546) (= 4587 rune) (= 4592 rune) (= 4601 rune) (<= 7680 rune 7835) (<= 7840 rune 7929) + (<= 7936 rune 7957) (<= 7960 rune 7965) (<= 7968 rune 8005) (<= 8008 rune 8013) (<= 8016 rune 8023) + (= 8025 rune) (= 8027 rune) (= 8029 rune) (<= 8031 rune 8061) (<= 8064 rune 8116) (<= 8118 rune 8124) (= 8126 rune) + (<= 8130 rune 8132) (<= 8134 rune 8140) (<= 8144 rune 8147) (<= 8150 rune 8155) (<= 8160 rune 8172) + (<= 8178 rune 8180) (<= 8182 rune 8188) (= 8486 rune) (<= 8490 rune 8491) (= 8494 rune) (<= 8576 rune 8578) + (<= 12353 rune 12436) (<= 12449 rune 12538) (<= 12549 rune 12588) (<= 44032 rune 55203)))) (ideographic-rune-p (rune) (or (<= 19968 rune 40869) (= 12295 rune) (<= 12321 rune 12329))) diff --git a/xml/xml-parse.lisp b/xml/xml-parse.lisp index da5579f..655a90f 100644 --- a/xml/xml-parse.lisp +++ b/xml/xml-parse.lisp @@ -3004,8 +3004,10 @@ (elt octets pos) (incf pos))))) -(defmethod stream-read-sequence ((stream octet-input-stream) sequence - &optional (start 0) (end (length sequence))) +(defmethod stream-read-sequence + #-lispworks ((stream octet-input-stream) sequence + &optional (start 0) (end (length sequence))) + #+lispworks ((stream octet-input-stream) sequence start end) (with-slots (octets pos) stream (let* ((length (min (- end start) (- (length octets) pos))) (end1 (+ start length))