From 0714c7222cafd216d6ba4fc6dd7673a5131c2160 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Thu, 27 Jan 2011 13:38:08 -0700
Subject: [PATCH] Fixing PR11661

---
 collects/tests/xml/test.rkt     | 37 ++++++++++++++++++++++++++++++++-
 collects/xml/private/reader.rkt |  9 ++++++++
 collects/xml/xml.scrbl          |  4 ++++
 3 files changed, 49 insertions(+), 1 deletion(-)

diff --git a/collects/tests/xml/test.rkt b/collects/tests/xml/test.rkt
index b86295da6f..04f1d118b1 100644
--- a/collects/tests/xml/test.rkt
+++ b/collects/tests/xml/test.rkt
@@ -18,7 +18,9 @@
      (read-xml (open-input-string str)))))
 
 (define test-read-xml/exn (mk-test-read-xml/exn read-xml))
-(define (test-read-xml str xml)
+(define (test-read-xml str xml #:document-different? [diff? #f])
+  (unless diff?
+   (test-equal? str (document->list (read-xml/document (open-input-string str))) xml))
   (test-equal? str (document->list (read-xml (open-input-string str))) xml))
 
 (define test-syntax:read-xml/exn (mk-test-read-xml/exn syntax:read-xml))
@@ -253,6 +255,39 @@ END
         (make-prolog (list) #f (list))
         (make-element (make-source (make-location 1 16 17) (make-location 1 22 23)) 'br (list) (list))
         (list)))
+
+     (test-read-xml
+      "<?xml version=\"1.0\"? encoding=\"UTF-8\" standalone=\"yes\"?><br />"
+      '(make-document
+  (make-prolog
+   (list
+    (make-p-i
+     (make-source (make-location 1 0 1) (make-location 1 56 57))
+     xml
+     "version=\"1.0\"? encoding=\"UTF-8\" standalone=\"yes\""))
+   #f
+   (list))
+  (make-element
+   (make-source (make-location 1 56 57) (make-location 1 62 63))
+   'br
+   (list)
+   (list))
+  (list)))
+
+     (test-read-xml #:document-different? #t
+      "<br /><?xml version=\"1.0\"? encoding=\"UTF-8\" standalone=\"yes\"?>"
+      '(make-document
+  (make-prolog (list) #f (list))
+  (make-element
+   (make-source (make-location 1 0 1) (make-location 1 6 7))
+   'br
+   (list)
+   (list))
+  (list
+   (make-p-i
+    (make-source (make-location 1 6 7) (make-location 1 62 63))
+    xml
+    "version=\"1.0\"? encoding=\"UTF-8\" standalone=\"yes\""))))
      
      ; XXX need more read-xml tests
      
diff --git a/collects/xml/private/reader.rkt b/collects/xml/private/reader.rkt
index 51ce4c7a9f..43f567dfae 100644
--- a/collects/xml/private/reader.rkt
+++ b/collects/xml/private/reader.rkt
@@ -3,6 +3,7 @@
 
 (provide/contract
  [read-xml (() (input-port?) . ->* . document?)]
+ [read-xml/document (() (input-port?) . ->* . document?)]
  [read-xml/element (() (input-port?) . ->* . element?)]
  [read-comments (parameter/c boolean?)]
  [collapse-whitespace (parameter/c boolean?)]
@@ -40,6 +41,14 @@
                                       end-of-file))
                        misc1)))))
 
+;; read-xml : [Input-port] -> Document
+(define (read-xml/document [in (current-input-port)])
+  (let*-values ([(in pos) (positionify in)]
+                [(misc0 start) (read-misc in pos)])
+    (make-document (make-prolog misc0 #f empty)
+                   (read-xml-element-helper pos in start)
+                   empty)))
+
 ;; read-xml/element : [Input-port] -> Element
 (define read-xml/element
   (lambda ([in (current-input-port)])
diff --git a/collects/xml/xml.scrbl b/collects/xml/xml.scrbl
index f95dd00388..0436126d9c 100644
--- a/collects/xml/xml.scrbl
+++ b/collects/xml/xml.scrbl
@@ -201,6 +201,10 @@ about creating ports that return non-character values.
                         "<doc><bold>hi</bold> there!</doc>"))))
 ]}
 
+@defproc[(read-xml/document [in input-port? (current-input-port)]) document?]{
+
+Like @racket[read-xml], except that the reader stops after the single element, rather than attempting to read "miscellaneous" XML content after the element. The document returned by @racket[read-xml/document] always has an empty @racket[document-misc].}
+
 @defproc[(read-xml/element [in input-port? (current-input-port)]) element?]{
 
 Reads a single XML element from the port.  The next non-whitespace