Skip to content

Commit 4d6b5ec

Browse files
committed
Proposed fix for iss18.
Modify `parse-to-list` to return `nil` when given an empty document.
1 parent 310ba84 commit 4d6b5ec

File tree

1 file changed

+27
-13
lines changed

1 file changed

+27
-13
lines changed

xmls.lisp

+27-13
Original file line numberDiff line numberDiff line change
@@ -112,7 +112,7 @@ the line number.")
112112
ns
113113
attrs
114114
children)
115-
115+
116116
(defun make-node (&key name ns attrs child children)
117117
"Convenience function for creating a new xml node."
118118
(when (and child children)
@@ -154,7 +154,7 @@ fixed."
154154
(node-name node))
155155
(node-attrs node)
156156
(mapcar 'node->nodelist (node-children node))))))
157-
157+
158158

159159
;;;-----------------------------------------------------------------------------
160160

@@ -355,7 +355,7 @@ character translation."
355355
(when (char= char #\newline)
356356
(decf *parser-line-number*))
357357
(common-lisp:unread-char char stream))
358-
358+
359359
;;;END shadowing--------------------------------------------------------------
360360

361361
(define-symbol-macro next-char (peek-stream (state-stream s)))
@@ -551,12 +551,12 @@ character translation."
551551
(match #\'))))
552552
t)
553553
(if (string= "xmlns" name)
554-
(list 'nsdecl suffix val)
555-
;; If SUFFIX is true, then NAME is Prefix and SUFFIX is
556-
;; LocalPart.
557-
(if suffix
558-
(list 'attr suffix val :attr-ns name)
559-
(list 'attr name val))))))
554+
(list 'nsdecl suffix val)
555+
;; If SUFFIX is true, then NAME is Prefix and SUFFIX is
556+
;; LocalPart.
557+
(if suffix
558+
(list 'attr suffix val :attr-ns name)
559+
(list 'attr name val))))))
560560

561561
(defrule ws ()
562562
(and (match+ ws-char)
@@ -797,7 +797,7 @@ character translation."
797797
((and (eql (element-type c) 'pi)
798798
(not *discard-processing-instructions*))
799799
(return (setf elem c))))))
800-
800+
801801
(and elem (element-val elem))))
802802

803803
;;;-----------------------------------------------------------------------------
@@ -827,7 +827,14 @@ character translation."
827827
(write-xml e s :indent indent)))
828828

829829
(defun parse (s &key (compress-whitespace t) (quash-errors t))
830-
"Parses the supplied stream or string into a lisp node tree."
830+
"Parses the supplied stream or string into a lisp node tree.
831+
832+
:QUASH-ERRORS, if true, will cause this function to return NIL
833+
instead of raising an error if it encounters an XML parsing
834+
error. Other errors may not be quashed.
835+
836+
Note: This function accepts empty XML documents as input, and returns
837+
NIL in that case."
831838
(let* ((*compress-whitespace* compress-whitespace)
832839
(*discard-processing-instructions* t)
833840
(stream
@@ -844,7 +851,14 @@ character translation."
844851
(document (make-state :stream stream)))))
845852

846853
(defun parse-to-list (&rest args)
847-
(node->nodelist (apply #'parse args)))
854+
"Parses the supplied stream or string into the legacy XMLS
855+
s-expression format.
856+
857+
Note: This function accepts empty XML documents as input, and returns
858+
NIL in that case."
859+
(let ((parsed (apply #'parse args)))
860+
(when parsed
861+
(node->nodelist parsed))))
848862

849863
(defparameter *test-files*
850864
(mapcar #'(lambda (x) (asdf:system-relative-pathname "xmls" (format nil "tests/~a" x)))
@@ -884,7 +898,7 @@ character translation."
884898
"xml-rpc/methodResponse.xml"
885899
"xml-rpc/struct.xml")))
886900

887-
#+(or sbcl cmu allegro abcl ccl clisp ecl)
901+
#+(or sbcl cmu allegro abcl ccl clisp ecl)
888902
(defun test (&key interactive (test-files *test-files*))
889903
"Run the test suite. If it fails, either return NIL \(if INTERACTIVE\),
890904
otherwise exit with an error exit status."

0 commit comments

Comments
 (0)