steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
basis/xml/syntax/syntax.factor
View File

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

4
basis/xml/tests/templating.factor
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 ; accessors xml.data xml.traversal xml.writer generic sequences.deep multiline ;
IN: xml.tests IN: xml.tests
: sub-tag CONSTANT: sub-tag
T{ name f f "sub" "http://littledan.onigirihouse.com/namespaces/replace" } ; T{ name f f "sub" "http://littledan.onigirihouse.com/namespaces/replace" }
SYMBOL: ref-table SYMBOL: ref-table

2
basis/xml/tests/xmltest.factor
View File

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

2
basis/xml/writer/writer-tests.factor
View File

@ -61,7 +61,7 @@ IN: xml.writer.tests
[ "<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" ; 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 [ ] [ "<?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 [ "x" ] [ test-file file>xml body>> name>> main>> ] unit-test