Fix subtle Unicode encodings autodetection bug

db4
Daniel Ehrenberg 2009-01-15 15:25:00 -06:00
parent db0fee9e3c
commit b9d773b3f0
4 changed files with 47 additions and 18 deletions

View File

@ -1,7 +1,8 @@
USING: xml xml.data xml.utilities tools.test ;
USING: xml xml.data xml.utilities tools.test accessors kernel ;
[ "\u000131" ] [ "resource:basis/xml/tests/latin5.xml" file>xml children>string ] unit-test
[ "\u0000e9" ] [ "resource:basis/xml/tests/latin1.xml" file>xml children>string ] unit-test
[ "\u0000e9" ] [ "resource:basis/xml/tests/spaces.xml" file>xml children>string ] unit-test
[ "\u0000e9" ] [ "resource:basis/xml/tests/utf8.xml" file>xml children>string ] unit-test
[ "\u0000e9" ] [ "resource:basis/xml/tests/utf16.xml" file>xml children>string ] unit-test
[ "\u0000e9" ] [ "resource:basis/xml/tests/utf16be.xml" file>xml children>string ] unit-test
@ -10,3 +11,4 @@ USING: xml xml.data xml.utilities tools.test ;
[ "\u0000e9" ] [ "resource:basis/xml/tests/utf16le-bom.xml" file>xml children>string ] unit-test
[ "\u0000e9" ] [ "resource:basis/xml/tests/prologless.xml" file>xml children>string ] unit-test
[ "e" ] [ "resource:basis/xml/tests/ascii.xml" file>xml children>string ] unit-test
[ "\u0000e9" "x" ] [ "resource:basis/xml/tests/unitag.xml" file>xml [ name>> main>> ] [ children>string ] bi ] unit-test

View File

@ -0,0 +1,3 @@
<x>é</x>

View File

@ -0,0 +1 @@
<é>x</é>

View File

@ -1,9 +1,10 @@
! Copyright (C) 2005, 2006 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays ascii assocs combinators fry io.encodings
io.encodings.iana io.encodings.utf16 io.encodings.utf8 kernel
make math.parser namespaces sequences sets splitting state-parser
xml.char-classes xml.data xml.entities xml.errors strings ;
USING: accessors arrays ascii assocs combinators
combinators.short-circuit fry io.encodings io.encodings.iana
io.encodings.string io.encodings.utf16 io.encodings.utf8 kernel make
math math.parser namespaces sequences sets splitting state-parser
strings xml.char-classes xml.data xml.entities xml.errors ;
IN: xml.tokenize
! XML namespace processing: ns = namespace
@ -53,17 +54,23 @@ SYMBOL: ns-stack
! version=1.0? is calculated once and passed around for efficiency
: (parse-name) ( -- str )
version=1.0? dup
get-char name-start? [
[ dup get-char name-char? not ] take-until nip
] [
"Malformed name" xml-string-error
] if ;
: assure-name ( str version=1.0? -- str )
over {
[ first name-start? ]
[ rest-slice [ name-char? ] with all? ]
} 2&& [ "Malformed name" xml-string-error ] unless ;
: (parse-name) ( start -- str )
version=1.0?
[ [ get-char name-char? not ] curry take-until append ]
[ assure-name ] bi ;
: parse-name-starting ( start -- name )
(parse-name) get-char CHAR: : =
[ next "" (parse-name) ] [ "" swap ] if f <name> ;
: parse-name ( -- name )
(parse-name) get-char CHAR: : =
[ next (parse-name) ] [ "" swap ] if f <name> ;
"" parse-name-starting ;
! -- Parsing strings
@ -99,7 +106,7 @@ SYMBOL: ns-stack
: parse-text ( -- string )
CHAR: < parse-char ;
! Parsing tags
: start-tag ( -- name ? )
@ -274,7 +281,7 @@ SYMBOL: string-input?
dup prolog-data set ;
: instruct ( -- instruction )
(parse-name) dup "xml" =
"" (parse-name) dup "xml" =
[ drop parse-prolog ] [
dup >lower "xml" =
[ capitalized-prolog ]
@ -294,17 +301,33 @@ SYMBOL: string-input?
! Autodetecting encodings
: continue-make-tag ( str -- tag )
parse-name-starting middle-tag end-tag CHAR: > expect ;
: start-utf16le ( -- tag )
utf16le decode-input-if
CHAR: ? expect
0 expect instruct ;
: 10xxxxxx? ( ch -- ? )
-6 shift 3 bitand 2 = ;
: start<name ( ch -- tag )
ascii?
[ utf8 decode-input-if next make-tag ] [
next
[ get-next 10xxxxxx? not ] take-until
get-char suffix utf8 decode
utf8 decode-input-if next
continue-make-tag
] if ;
: start< ( -- tag )
get-next {
{ 0 [ next next start-utf16le ] }
{ CHAR: ? [ next next instruct ] } ! XML prolog parsing sets the encoding
[ drop utf8 decode-input-if next make-tag ]
! That is a hack. It fails if you have <nonascii
{ CHAR: ! [ utf8 decode-input next next direct ] }
[ start<name ]
} case ;
: skip-utf8-bom ( -- tag )