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
+ "
"
+ '(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
+ "
"
+ '(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.
"hi there!"))))
]}
+@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