More descriptive XML errors

db4
Daniel Ehrenberg 2009-01-15 16:35:55 -06:00
parent 26b81f4677
commit 79d4bb04e9
4 changed files with 61 additions and 34 deletions

View File

@ -6,22 +6,27 @@ IN: xml.errors.tests
'[ _ string>xml ] swap '[ _ = ] must-fail-with ;
T{ no-entity f 1 10 "nbsp" } "<x>&nbsp;</x>" xml-error-test
T{ mismatched f 1 8 T{ name f "" "x" "" } T{ name f "" "y" "" }
} "<x></y>" xml-error-test
T{ mismatched f 1 8 T{ name f "" "x" "" } T{ name f "" "y" "" } }
"<x></y>" xml-error-test
T{ unclosed f 1 4 V{ T{ name f "" "x" "" } } } "<x>" xml-error-test
T{ nonexist-ns f 1 5 "x" } "<x:y/>" xml-error-test
T{ unopened f 1 5 } "</x>" xml-error-test
T{ not-yes/no f 1 41 "maybe" } "<?xml version='1.0' standalone='maybe'?><x/>" xml-error-test
T{ not-yes/no f 1 41 "maybe" }
"<?xml version='1.0' standalone='maybe'?><x/>" xml-error-test
T{ extra-attrs f 1 32 V{ T{ name f "" "foo" f } }
} "<?xml version='1.1' foo='bar'?><x/>" xml-error-test
T{ bad-version f 1 28 "5 million" } "<?xml version='5 million'?><x/>" xml-error-test
T{ bad-version f 1 28 "5 million" }
"<?xml version='5 million'?><x/>" xml-error-test
T{ notags f } "" xml-error-test
T{ multitags } "<x/><y/>" xml-error-test
T{ bad-prolog f 1 26 T{ prolog f "1.0" "UTF-8" f }
} "<x/><?xml version='1.0'?>" xml-error-test
T{ bad-prolog f 1 26 T{ prolog f "1.0" "UTF-8" f } }
"<x/><?xml version='1.0'?>" xml-error-test
T{ capitalized-prolog f 1 6 "XmL" } "<?XmL version='1.0'?><x/>"
xml-error-test
xml-error-test
T{ pre/post-content f "x" t } "x<y/>" xml-error-test
T{ versionless-prolog f 1 8 } "<?xml?><x/>" xml-error-test
T{ bad-instruction f 1 11 T{ instruction f "xsl" }
} "<x><?xsl?></x>" xml-error-test
T{ bad-instruction f 1 11 T{ instruction f "xsl" } }
"<x><?xsl?></x>" xml-error-test
T{ unclosed-quote f 1 13 } "<x value='/>" xml-error-test
T{ bad-name f 1 3 "-" } "<-/>" xml-error-test
T{ quoteless-attr f 1 10 } "<x value=3/>" xml-error-test

View File

@ -32,17 +32,6 @@ M: no-entity summary ( obj -- str )
"Entity does not exist: &" write thing>> write ";" print
] with-string-writer ;
TUPLE: xml-string-error < parsing-error string ; ! this should not exist
: xml-string-error ( string -- * )
\ xml-string-error parsing-error swap >>string throw ;
M: xml-string-error summary ( obj -- str )
[
dup call-next-method write
string>> print
] with-string-writer ;
TUPLE: mismatched < parsing-error open close ;
: mismatched ( open close -- * )
@ -233,7 +222,34 @@ M: misplaced-directive summary ( obj -- str )
dir>> write-xml-chunk nl
] with-string-writer ;
TUPLE: bad-name < parsing-error name ;
: bad-name ( name -- * )
\ bad-name parsing-error swap >>name throw ;
M: bad-name summary ( obj -- str )
[ call-next-method ]
[ "Invalid name: " swap name>> "\n" 3append ]
bi append ;
TUPLE: unclosed-quote < parsing-error ;
: unclosed-quote ( -- * )
\ unclosed-quote parsing-error throw ;
M: unclosed-quote summary
call-next-method
"XML document ends with quote still open\n" append ;
TUPLE: quoteless-attr < parsing-error ;
: quoteless-attr ( -- * )
\ quoteless-attr parsing-error throw ;
M: quoteless-attr summary
call-next-method "Attribute lacks quotes around value\n" append ;
UNION: xml-parse-error multitags notags extra-attrs nonexist-ns
not-yes/no unclosed mismatched xml-string-error expected no-entity
not-yes/no unclosed mismatched expected no-entity
bad-prolog versionless-prolog capitalized-prolog bad-instruction
bad-directive ;
bad-directive bad-name unclosed-quote quoteless-attr ;

View File

@ -58,7 +58,7 @@ SYMBOL: ns-stack
over {
[ first name-start? ]
[ rest-slice [ name-char? ] with all? ]
} 2&& [ "Malformed name" xml-string-error ] unless ;
} 2&& [ bad-name ] unless ;
: (parse-name) ( start -- str )
version=1.0?
@ -102,7 +102,7 @@ SYMBOL: ns-stack
: parse-quot ( ch -- string )
parse-char get-char
[ "XML file ends in a quote" xml-string-error ] unless ;
[ unclosed-quote ] unless ;
: parse-text ( -- string )
CHAR: < parse-char ;
@ -115,11 +115,8 @@ SYMBOL: ns-stack
parse-name swap ;
: parse-attr-value ( -- seq )
get-char dup "'\"" member? [
next parse-quot
] [
"Attribute lacks quote" xml-string-error
] if ;
get-char dup "'\"" member?
[ next parse-quot ] [ quoteless-attr ] if ;
: parse-attr ( -- )
[ parse-name ] with-scope
@ -358,6 +355,6 @@ SYMBOL: string-input?
{ f [ "" ] }
[ dup blank?
[ drop pass-blank utf8 decode-input-if CHAR: < expect make-tag ]
[ 1string ] if ! Replace with proper error
[ 1string ] if ! Replace with proper error?
]
} case ;

View File

@ -295,9 +295,6 @@ HELP: expected
HELP: no-entity
{ $class-description "XML parsing error describing the use of an undefined entity in a case where standalone is marked yes. Delegates to " { $link parsing-error } ". Contains one slot, thing, containing a string representing the entity." } ;
HELP: xml-string-error
{ $class-description "XML parsing error that delegates to " { $link parsing-error } " and represents an other, unspecified error, which is represented by the slot string, containing a string describing the error." } ;
HELP: open-tag
{ $class-description "represents a tag that does have children, ie is not a contained tag" }
{ $notes "the constructor used for this class is simply " { $link <tag> } "." }
@ -324,6 +321,15 @@ HELP: state-parse
HELP: pre/post-content
{ $class-description "describes the error where a non-whitespace string is used before or after the main tag in an XML document. Contains two slots: string contains the offending string, and pre? is t if it occured before the main tag and f if it occured after" } ;
HELP: unclosed-quote
{ $class-description "describes the error where a quotation for an attribute value is opened but not closed before the end of the document." } ;
HELP: bad-name
{ $class-description "describes the error where a name is used, for example in an XML tag or attribute key, which is invalid." } ;
HELP: quoteless-attr
{ $class-description "describes the error where an attribute of an XML tag is missing quotes around a value." } ;
HELP: entities
{ $description "a hash table from default XML entity names (like &amp; and &lt;) to the characters they represent. This is automatically included when parsing any XML document." }
{ $see-also html-entities } ;
@ -444,6 +450,9 @@ ARTICLE: { "xml" "errors" } "XML parsing errors"
{ $subsection expected }
{ $subsection no-entity }
{ $subsection pre/post-content }
{ $subsection unclosed-quote }
{ $subsection bad-name }
{ $subsection quoteless-attr }
"Additionally, most of these errors delegate to " { $link parsing-error } " in order to provide more information"
$nl
"Note that, in parsing an XML document, only the first error is reported." ;
@ -456,7 +465,7 @@ ARTICLE: { "xml" "entities" } "XML entities"
{ $subsection with-html-entities } ;
ARTICLE: "xml" "XML parser"
"The " { $vocab-link "xml" } " vocabulary implements the XML 1.1 standard, converting strings of text into XML and vice versa."
"The " { $vocab-link "xml" } " vocabulary implements the XML 1.0 and 1.1 standards, converting strings of text into XML and vice versa."
{ $subsection { "xml" "reading" } }
{ $subsection { "xml" "writing" } }
{ $subsection { "xml" "classes" } }