xml: update XML-NS: for define-memoized stack effect change and get all unit tests to pass

db4
Slava Pestov 2009-03-22 18:37:28 -05:00
parent 4fc2182ac8
commit 5408191724
4 changed files with 11 additions and 11 deletions

View File

@ -17,8 +17,8 @@ M: no-tag summary
>alist swap '[ _ no-tag boa throw ] suffix
'[ dup main>> _ case ] ;
: define-tags ( word -- )
dup dup "xtable" word-prop compile-tags define ;
: define-tags ( word effect -- )
[ dup dup "xtable" word-prop compile-tags ] dip define-declared ;
:: define-tag ( string word quot -- )
quot string word "xtable" word-prop set-at
@ -27,16 +27,16 @@ M: no-tag summary
PRIVATE>
SYNTAX: TAGS:
CREATE
[ H{ } clone "xtable" set-word-prop ]
[ define-tags ] bi ;
CREATE complete-effect
[ drop H{ } clone "xtable" set-word-prop ]
[ define-tags ]
2bi ;
SYNTAX: TAG:
scan scan-word parse-definition define-tag ;
SYNTAX: XML-NS:
CREATE-WORD (( string -- name )) over set-stack-effect
scan '[ f swap _ <name> ] define-memoized ;
CREATE-WORD scan '[ f swap _ <name> ] (( string -- name )) define-memoized ;
<PRIVATE

View File

@ -2,8 +2,8 @@ USING: kernel xml sequences assocs tools.test io arrays namespaces fry
accessors xml.data xml.traversal xml.writer generic sequences.deep multiline ;
IN: xml.tests
: sub-tag
T{ name f f "sub" "http://littledan.onigirihouse.com/namespaces/replace" } ;
CONSTANT: sub-tag
T{ name f f "sub" "http://littledan.onigirihouse.com/namespaces/replace" }
SYMBOL: ref-table

View File

@ -17,7 +17,7 @@ TUPLE: xml-test id uri sections description type ;
: parse-tests ( xml -- tests )
"TEST" tags-named [ >xml-test ] map ;
: base "vocab:xml/tests/xmltest/" ;
CONSTANT: base "vocab:xml/tests/xmltest/"
MACRO: drop-output ( quot -- newquot )
dup infer out>> '[ @ _ ndrop ] ;

View File

@ -61,7 +61,7 @@ IN: xml.writer.tests
[ "<foo> bar </foo>" string>xml pprint-xml>string ] unit-test
[ "<foo'>" ] [ "<foo'>" <unescaped> xml>string ] unit-test
: test-file "resource:basis/xml/writer/test.xml" ;
CONSTANT: 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