Commit 3fbf1731 authored by david's avatar david

Revision: cxml--devel--1.0--patch-5

Archive: david@knowledgetools.de--cxml
Creator: David Lichteblau <david@knowledgetools.de>
Date: Fri Jan  9 16:58:44 CET 2004
Standard-date: 2004-01-09 15:58:44 GMT
Modified-files: xml/package.lisp xml/sax-tests/tests.lisp
    xml/xml-parse.lisp xml/xml-stream.lisp
New-patches: david@knowledgetools.de--cxml/cxml--devel--1.0--patch-5
Summary: (assert (eql initial-speed 1)) in make-xstream
Keywords:

MAKE-XSTREAM: xstreams must be created with an INITIAL-SPEED of 1, otherwise
the first buffer will the read with a fixed encoding instead of the encoding
declared in the processing instruction.  Not sure if xstreams are used for
non-XML data, so I've left the argument in, but added an assertion.

PARSE-FILE: works now.

PARSE-STRING remains broken, don't export it
parent e982b8dd
......@@ -39,6 +39,7 @@
#:parse-file
#:parse-stream
#:parse-string
;; XXX encoding is mis-handled by parse-string, don't export it
;; #:parse-string
#:unparse-document))
(in-package :sax-tests)
(defun first-start-element-event (string)
(let ((events (xml:parse-string string (make-instance 'event-collecting-handler))))
(let ((events (xml::parse-string string (make-instance 'event-collecting-handler))))
(find :start-element events :key #'car)))
......@@ -17,7 +17,7 @@
(deftest attribute-uniqueness-1
(handler-case
(xml:parse-string "<x xmlns:a='http://example.com' xmlns:b='http://example.com' a:a='1' b:a='1'/>")
(xml::parse-string "<x xmlns:a='http://example.com' xmlns:b='http://example.com' a:a='1' b:a='1'/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
......@@ -26,7 +26,7 @@
(deftest attribute-uniqueness-2
(handler-case
(xml:parse-string "<x xmlns:a='http://example.com' xmlns='http://example.com' a:a='1' a='1'/>")
(xml::parse-string "<x xmlns:a='http://example.com' xmlns='http://example.com' a:a='1' a='1'/>")
(error () nil)
(:no-error (&rest junk)
(declare (ignore junk))
......@@ -36,7 +36,7 @@
(deftest attribute-uniqueness-3
(let ((sax:*namespace-processing* nil))
(handler-case
(xml:parse-string "<x xmlns:a='http://example.com' xmlns:b='http://example.com' a:a='1' b:a='1'/>")
(xml::parse-string "<x xmlns:a='http://example.com' xmlns:b='http://example.com' a:a='1' b:a='1'/>")
(error () nil)
(:no-error (&rest junk)
(declare (ignore junk))
......@@ -46,7 +46,7 @@
;;; Namespace undeclaring
(deftest undeclare-default-namespace-1
(let* ((evts (xml:parse-string "<x xmlns='http://example.com'><y xmlns='' a='1'/></x>"
(let* ((evts (xml::parse-string "<x xmlns='http://example.com'><y xmlns='' a='1'/></x>"
(make-instance 'event-collecting-handler)))
(start-elt-events (remove :start-element evts :test (complement #'eql) :key #'car))
(evt1 (first start-elt-events))
......@@ -59,7 +59,7 @@
(deftest undeclare-other-namespace
(handler-case
(xml:parse-string "<x:x xmlns:x='http://example.com'><x:y xmlns:x='' a='1'/></x:x>")
(xml::parse-string "<x:x xmlns:x='http://example.com'><x:y xmlns:x='' a='1'/></x:x>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
......@@ -71,7 +71,7 @@
(deftest pi-names-are-ncnames-when-namespace-processing-1
(handler-case
(xml:parse-string "<?a:b c?><x/>")
(xml::parse-string "<?a:b c?><x/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
......@@ -81,7 +81,7 @@
(deftest pi-names-are-ncnames-when-namespace-processing-2
(let ((sax:*namespace-processing* nil))
(handler-case
(xml:parse-string "<?a:b c?><x/>")
(xml::parse-string "<?a:b c?><x/>")
(error () nil)
(:no-error (&rest junk)
(declare (ignore junk))
......@@ -90,7 +90,7 @@
(deftest entity-names-are-ncnames-when-namespace-processing-1
(handler-case
(xml:parse-string "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x>&y:z;</x>")
(xml::parse-string "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x>&y:z;</x>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
......@@ -99,7 +99,7 @@
(deftest entity-names-are-ncnames-when-namespace-processing-2
(handler-case
(xml:parse-string "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x/>")
(xml::parse-string "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
......@@ -109,7 +109,7 @@
(deftest entity-names-are-ncnames-when-namespace-processing-3
(let ((sax:*namespace-processing* nil))
(handler-case
(xml:parse-string "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x>&y:z;</x>")
(xml::parse-string "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x>&y:z;</x>")
(error () nil)
(:no-error (&rest junk)
(declare (ignore junk))
......@@ -119,7 +119,7 @@
(deftest entity-names-are-ncnames-when-namespace-processing-4
(let ((sax:*namespace-processing* nil))
(handler-case
(xml:parse-string "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x/>")
(xml::parse-string "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x/>")
(error () nil)
(:no-error (&rest junk)
(declare (ignore junk))
......@@ -259,7 +259,7 @@
(deftest redefine-xml-namespace-1
(handler-case
(xml:parse-string "<x xmlns:xml='http://www.w3.org/XML/1998/namespace'/>")
(xml::parse-string "<x xmlns:xml='http://www.w3.org/XML/1998/namespace'/>")
(error () nil)
(:no-error (&rest junk)
(declare (ignore junk))
......@@ -268,7 +268,7 @@
(deftest redefine-xml-namespace-2
(handler-case
(xml:parse-string "<x xmlns:xml='http://example.com/wrong-uri'/>")
(xml::parse-string "<x xmlns:xml='http://example.com/wrong-uri'/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
......@@ -277,7 +277,7 @@
(deftest redefine-xml-namespace-3
(handler-case
(xml:parse-string "<x xmlns:wrong='http://www.w3.org/XML/1998/namespace'/>")
(xml::parse-string "<x xmlns:wrong='http://www.w3.org/XML/1998/namespace'/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
......@@ -286,7 +286,7 @@
(deftest redefine-xml-namespace-4
(handler-case
(xml:parse-string "<x xmlns:wrong='http://www.w3.org/XML/1998/namespace'/>")
(xml::parse-string "<x xmlns:wrong='http://www.w3.org/XML/1998/namespace'/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
......@@ -295,7 +295,7 @@
(deftest redefine-xmlns-namespace-1
(handler-case
(xml:parse-string "<x xmlns:xmlns='http://www.w3.org/2000/xmlns/'/>")
(xml::parse-string "<x xmlns:xmlns='http://www.w3.org/2000/xmlns/'/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
......@@ -304,7 +304,7 @@
(deftest redefine-xmlns-namespace-2
(handler-case
(xml:parse-string "<x xmlns:xmlns='http://example.com/wrong-ns'/>")
(xml::parse-string "<x xmlns:xmlns='http://example.com/wrong-ns'/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
......@@ -313,7 +313,7 @@
(deftest redefine-xmlns-namespace-3
(handler-case
(xml:parse-string "<x xmlns:wrong='http://www.w3.org/2000/xmlns/'/>")
(xml::parse-string "<x xmlns:wrong='http://www.w3.org/2000/xmlns/'/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
......@@ -322,7 +322,7 @@
(deftest redefine-xmlns-namespace-4
(handler-case
(xml:parse-string "<x xmlns='http://www.w3.org/2000/xmlns/'/>")
(xml::parse-string "<x xmlns='http://www.w3.org/2000/xmlns/'/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
......
......@@ -2191,11 +2191,13 @@
(p/document zstream handler)))
(defun parse-string (string &optional (handler (make-instance 'dom-impl::dom-builder)))
;; XXX this function mis-handles encoding
(let* ((x (string->xstream string))
(z (make-zstream :input-stack (list x))))
(p/document z handler)))
(defun string->xstream (string)
;; XXX encoding is mis-handled by this kind of stream
(make-rod-xstream (string-rod string)))
;;;;
......
......@@ -304,7 +304,9 @@
;;; constructor
(defun make-xstream (os-stream &key name (speed 8192) (initial-speed speed))
(defun make-xstream (os-stream &key name (speed 8192) (initial-speed 1))
;; XXX if initial-speed isn't 1, encoding will me munged up
(assert (eql initial-speed 1))
(let ()
(multiple-value-bind (encoding preread) (figure-encoding os-stream)
(let ((osbuf (make-array speed :element-type '(unsigned-byte 8))))
......@@ -328,6 +330,7 @@
(values (xml::find-encoding :iso-8859-1) nil))
(defun make-rod-xstream (string &key name)
;; XXX encoding is mis-handled by this kind of stream
(let ((n (length string)))
(let ((buffer (make-array (1+ n) :element-type 'buffer-byte)))
(declare (type (simple-array buffer-byte (*)) buffer))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment