Fixing bug in XML where prolog isn't considered; whenever you write XML, the encoding is listed as UTF-8.

db4
Daniel Ehrenberg 2009-02-04 12:32:47 -06:00
parent 354830e983
commit 009ea7ad45
5 changed files with 26 additions and 9 deletions

View File

@ -9,7 +9,7 @@ M: no-tag summary
drop "The tag-dispatching word has no method for the given tag name" ; drop "The tag-dispatching word has no method for the given tag name" ;
: compile-tags ( word xtable -- quot ) : compile-tags ( word xtable -- quot )
>alist swap '[ _ no-tag boa throw ] [ ] like suffix >alist swap '[ _ no-tag boa throw ] suffix
'[ dup main>> _ case ] ; '[ dup main>> _ case ] ;
: define-tags ( word -- ) : define-tags ( word -- )

View File

@ -67,3 +67,4 @@ SYMBOL: xml-file
[ "x" "<" ] [ "<x value='&lt;'/>" string>xml [ name>> main>> ] [ "value" attr ] bi ] unit-test [ "x" "<" ] [ "<x value='&lt;'/>" string>xml [ name>> main>> ] [ "value" attr ] bi ] unit-test
[ "foo" ] [ "<!DOCTYPE foo [<!ENTITY bar 'foo'>]><x>&bar;</x>" string>xml children>string ] unit-test [ "foo" ] [ "<!DOCTYPE foo [<!ENTITY bar 'foo'>]><x>&bar;</x>" string>xml children>string ] unit-test
[ T{ xml-chunk f V{ "hello" } } ] [ "hello" string>xml-chunk ] unit-test [ T{ xml-chunk f V{ "hello" } } ] [ "hello" string>xml-chunk ] unit-test
[ "1.1" ] [ "<?xml version='1.1'?><x/>" string>xml prolog>> version>> ] unit-test

View File

@ -1,7 +1,8 @@
! Copyright (C) 2005, 2009 Daniel Ehrenberg ! Copyright (C) 2005, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: xml.data xml.writer tools.test fry xml kernel multiline USING: xml.data xml.writer tools.test fry xml kernel multiline
xml.writer.private io.streams.string xml.utilities sequences ; xml.writer.private io.streams.string xml.utilities sequences
io.encodings.utf8 io.files accessors io.directories ;
IN: xml.writer.tests IN: xml.writer.tests
\ write-xml must-infer \ write-xml must-infer
@ -59,3 +60,9 @@ IN: xml.writer.tests
[ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<foo>\n bar\n</foo>" ] [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<foo>\n bar\n</foo>" ]
[ "<foo> bar </foo>" string>xml pprint-xml>string ] unit-test [ "<foo> bar </foo>" string>xml pprint-xml>string ] unit-test
[ "<foo'>" ] [ "<foo'>" <unescaped> xml>string ] unit-test [ "<foo'>" ] [ "<foo'>" <unescaped> xml>string ] unit-test
: test-file "resource:basis/xml/writer/test.xml" ;
[ ] [ "<?xml version='1.0' encoding='UTF-16BE'?><x/>" string>xml test-file utf8 [ write-xml ] with-file-writer ] unit-test
[ "x" ] [ test-file file>xml body>> name>> main>> ] unit-test
[ ] [ test-file delete-file ] unit-test

View File

@ -164,7 +164,7 @@ M: sequence write-xml
M: prolog write-xml M: prolog write-xml
"<?xml version=" write "<?xml version=" write
[ version>> write-quoted ] [ version>> write-quoted ]
[ " encoding=" write encoding>> write-quoted ] [ drop " encoding=\"UTF-8\"" write ]
[ standalone>> [ " standalone=\"yes\"" write ] when ] tri [ standalone>> [ " standalone=\"yes\"" write ] when ] tri
"?>" write ; "?>" write ;

View File

@ -4,7 +4,7 @@ USING: accessors arrays io io.encodings.binary io.files
io.streams.string kernel namespaces sequences strings io.encodings.utf8 io.streams.string kernel namespaces sequences strings io.encodings.utf8
xml.data xml.errors xml.elements ascii xml.entities xml.data xml.errors xml.elements ascii xml.entities
xml.writer xml.state xml.autoencoding assocs xml.tokenize xml.writer xml.state xml.autoencoding assocs xml.tokenize
combinators.short-circuit xml.name ; combinators.short-circuit xml.name splitting ;
IN: xml IN: xml
<PRIVATE <PRIVATE
@ -25,7 +25,7 @@ M: object process add-child ;
M: prolog process M: prolog process
xml-stack get xml-stack get
{ V{ { f V{ "" } } } V{ { f V{ } } } } member? { V{ { f V{ "" } } } V{ { f V{ } } } } member?
[ bad-prolog ] unless drop ; [ bad-prolog ] unless add-child ;
: before-main? ( -- ? ) : before-main? ( -- ? )
xml-stack get { xml-stack get {
@ -82,14 +82,23 @@ M: closer process
! this does *not* affect the contents of the stack ! this does *not* affect the contents of the stack
[ notags ] unless* ; [ notags ] unless* ;
: ?first ( seq -- elt/f ) 0 swap ?nth ;
: get-prolog ( seq -- prolog ) : get-prolog ( seq -- prolog )
first dup prolog? [ drop default-prolog ] unless ; { "" } ?head drop
?first dup prolog?
[ drop default-prolog ] unless ;
: cut-prolog ( seq -- newseq )
[ [ prolog? not ] [ "" = not ] bi and ] filter ;
: make-xml-doc ( seq -- xml-doc ) : make-xml-doc ( seq -- xml-doc )
[ get-prolog ] keep [ get-prolog ] keep
dup [ tag? ] find dup [ tag? ] find [
[ assure-tags cut rest no-pre/post no-post-tags ] dip assure-tags cut
swap <xml> ; [ cut-prolog ] [ rest ] bi*
no-pre/post no-post-tags
] dip swap <xml> ;
! * Views of XML ! * Views of XML