# Features covered: dom command
#
# This file contains a collection of tests for the dom command of
# tDOM.
#
# dom-1.*: createDocument, createDocumentNS
# dom-2.*: parse
# dom-3.*: isName, isNCName, isCharData, isPIName, isComment, isCDATA
# dom-4.*: parse -useForeignDTD
# dom-5.*: external entities
# dom-6.*: use in slave interpreter
# dom-7.*: setNameCheck, setTextCheck
# dom-8.*: createDocumentNode, documentNodes
# dom-9.*: setObjectCommands
# dom-10.*: createNodeCmd
# dom-11.*: featureinfo
# dom-12.*: -feedbackAfter
#
# Copyright (c) 2002, 2003, 2004 Rolf Ade.
source [file join [file dir [info script]] loadtdom.tcl]
test dom-1.1 {createDocument with root node name not a XML Name} {
list [catch {dom createDocument "root node"} msg] $msg
} "1 {Invalid root element name 'root node'}"
test dom-1.2 {createDocument with root node name not a XML Name} {
list [catch {dom createDocument "1root"} msg] $msg
} "1 {Invalid root element name '1root'}"
test dom-1.3 {createDocument - root name us-ascii} {
dom createDocument "root" doc
set root [$doc documentElement]
set result [$root nodeName]
$doc delete
set result
} "root"
test dom-1.4 {createDocument - root name with UTF-8 chars} {
dom createDocument "\u00c4\u00d4\u00dc" doc
set root [$doc documentElement]
set result [$root nodeName]
$doc delete
set result
} "\u00c4\u00d4\u00dc"
test dom-1.5 {createDocument with FQ root name} {
dom createDocument "foo:bar" doc
set root [$doc documentElement]
set result [$root nodeName]
$doc delete
set result
} "foo:bar"
test dom-1.6 {createDocument with wrong # of args} {
list [catch {dom createDocument "root" "http:/foo:bar" doc} msg] $msg
} "1 {wrong \# args: should be \"createDocument docElemName ?newObjVar?\"}"
test dom-1.7 {createDocumentNS - check root name} {
set doc [dom createDocumentNS "http://foo.bar" "root"]
set root [$doc documentElement]
set result [$root nodeName]
$doc delete
set result
} "root"
test dom-1.8 {createDocumentNS - check the NS of the created root} {
dom createDocumentNS "http://foo.bar" "root" doc
set root [$doc documentElement]
set result [$root namespaceURI]
$doc delete
set result
} "http://foo.bar"
test dom-1.9 {createDocumentNS with root name not a NCName} {
list [catch {dom createDocumentNS "http://foo.bar" "foo bar" doc} msg] $msg
} "1 {Invalid root element name 'foo bar'}"
test dom-1.10 {createDocumentNS with root name not a NCName} {
list [catch {dom createDocumentNS "http://foo.bar" "a:b:c" doc} msg] $msg
} "1 {Invalid root element name 'a:b:c'}"
test dom-1.11 {createDocumentNS with root name not a NCName} {
list [catch {dom createDocumentNS "http://foo.bar" "a b:b" doc} msg] $msg
} "1 {Invalid root element name 'a b:b'}"
test dom-1.12 {createDocumentNS with root name not a NCName} {
list [catch {dom createDocumentNS "http://foo.bar" "a:a b" doc} msg] $msg
} "1 {Invalid root element name 'a:a b'}"
test dom-1.13 {createDocumentNS - check root name} {
set doc [dom createDocumentNS "http://foo.bar" foo:root]
set root [$doc documentElement]
set result [$root nodeName]
$doc delete
set result
} "foo:root"
test dom-1.14 {createDocument - rename the doc cmd} {
set doc [dom createDocument root]
if {[info commands fooCmd] == "fooCmd"} {
rename fooCmd {}
}
rename $doc fooCmd
set result [[fooCmd documentElement] nodeName]
fooCmd delete
set result
} {root}
test dom-1.15 {createDocument - rename the doc cmd} {
if {[info commands fooCmd] == "fooCmd"} {
rename fooCmd {}
}
set nrOfCommands [llength [info commands]]
set doc [dom createDocument root]
rename $doc fooCmd
fooCmd delete
expr {[llength [info commands]] == $nrOfCommands}
} {1}
test dom-1.16 {createDocumentNS - empty namespace, no prefix} {
dom createDocumentNS "" doc doc
set result [$doc asXML -indent none]
$doc delete
set result
} {<doc/>}
test dom-1.17 {createDocumentNS - namespace, no prefix} {
dom createDocumentNS "uri" doc doc
set result [$doc asXML -indent none]
$doc delete
set result
} {<doc xmlns="uri"/>}
test dom-1.18 {createDocumentNS - namespace, no prefix} {
dom createDocumentNS "uri" doc doc
set result [$doc selectNodes -namespaces {ns uri} count(/ns:doc)]
$doc delete
set result
} 1
test dom-1.19 {createDocumentNS - namespace, prefix} {
dom createDocumentNS "uri" n1:doc doc
set result [$doc selectNodes -namespaces {ns uri} count(/ns:doc)]
$doc delete
set result
} 1
test dom-1.20 {createDocumentNS - empty namespace, prefix} {
catch {dom createDocumentNS "" n1:doc doc} errMsg
set errMsg
} {Missing URI in Namespace declaration}
test dom-1.21 {Explicit delete of scoped doc with domDoc cmd} {} {
dom createDocument test doc
domDoc $doc delete
unset doc
} {}
proc dom-1.22 {doc} {
$doc delete
}
test dom-1.22 {Explicit delete of scoped doc in proc call from scope} {} {
dom createDocument test doc
dom-1.22 $doc
unset doc
} {}
test dom-1.23 {Explicit delete of scoped doc} {
dom createDocument test doc
$doc delete
unset doc
} {}
test dom-1.24 {Explicit delete of scoped doc} {
dom createDocument test doc
set result [catch {set doc foo} errMsg]
lappend result $errMsg
$doc delete
unset doc
set result
} {1 {can't set "doc": var is read-only}}
test dom-1.25 {Doc var} {
dom parse <test/> doc
dom parse <test/> doc
unset doc
} {}
test dom-1.26 {Doc var} {
dom parse <test/> doc
set result [catch {$doc documentElement doc}]
unset doc
set result
} {1}
test dom-2.1 {Don't quash white space at start or end of non white space content} {
set doc [dom parse {<root>
some content
</root>}]
set root [$doc documentElement]
$root text
} {
some content
}
test dom-2.2 {parse doc with various re-declaration of a prefix} {
set doc [dom parse {<p:a xmlns:p="uri1">
<p:b xmlns:p="uri2">
<p:c xmlns:p="uri1"/>
</p:b>
</p:a>}]
set root [$doc documentElement]
set result [$root asXML]
$doc delete
set result
} {<p:a xmlns:p="uri1">
<p:b xmlns:p="uri2">
<p:c xmlns:p="uri1"/>
</p:b>
</p:a>
}
test dom-2.3 {parse doc with default NS declaration} {
set doc [dom parse {<a xmlns:p="uri">
<p:b/>
<p:b/>
</a>}]
set root [$doc documentElement]
set result [$root asXML]
$doc delete
set result
} {<a xmlns:p="uri">
<p:b/>
<p:b/>
</a>
}
test dom-2.4 {parse method: syntax check} {
set doc [dom parse -keepEmpties {<root>
text
</root>}]
set result [$doc asXML -indent none]
$doc delete
set result
} {<root>
text
</root>}
test dom-2.5 {parse method: syntax check} {
set doc [dom parse -useForeignDTD 0 -keepEmpties {<root>
text
</root>}]
set result [$doc asXML -indent none]
$doc delete
set result
} {<root>
text
</root>}
test dom-2.6 {parse method: syntax check} -setup {
set xmlFile [makeFile {<root> </root>} dom.xml]
} -body {
set fd [open $xmlFile]
set doc [dom parse -channel $fd -keepEmpties]
close $fd
set root [$doc documentElement]
set result [$root asXML -indent none]
$doc delete
set result
} -cleanup {
removeFile dom.xml
} -result {<root> </root>}
test dom-2.7 {parse method: syntax check} -setup {
set xmlFile [makeFile {<root> </root>} dom.xml]
} -body {
catch {unset -keepEmpties}
set fd [open $xmlFile]
set doc [dom parse -channel $fd -keepEmpties]
close $fd
$doc delete
info exists -keepEmpties
} -cleanup {
removeFile dom.xml
} -result 0
test dom-2.8 {parse method: bogus option} -body {
set result [catch {set doc [dom parse -bogusOption foo <root/>]} errMsg]
lappend result $errMsg
} -match regexp -result {1 {bad option "-bogusOption": must be .*}}
test dom-2.9 {parse method: bogus option} -setup {
set xmlFile [makeFile {<root> </root>} dom.xml]
} -body {
catch {unset -keepEmpties}
set fd [open $xmlFile]
set result [catch {set doc [dom parse -channel $fd -bogusOption]} errMsg]
close $fd
lappend result $errMsg
} -cleanup {
removeFile dom.xml
} -match regexp -result {1 {bad option "-bogusOption": must be .*}}
set dom_dtd "
<!ELEMENT root EMPTY>
<!ATTLIST root lang CDATA #FIXED \"en\">"
proc extRefResolver {base systemId publicId} {
global dom_dtd
if {$publicId == "DOMCMDTEST"} {
return [list string $base $dom_dtd]
} else {
return [::tdom::extRefHandler $base $systemId $publicId]
}
}
test dom-2.10 {parse method: -paramentityparsing default is 'always'} {
set doc [dom parse -externalentitycommand extRefResolver {
<!DOCTYPE root PUBLIC "DOMCMDTEST" "dummysystemID">
<root/>
}]
set root [$doc documentElement]
set result [$root @lang]
$doc delete
set result
} {en}
test dom-2.11 {parse method: explicit -paramentityparsing always} {
set doc [dom parse -externalentitycommand extRefResolver \
-paramentityparsing always {
<!DOCTYPE root PUBLIC "DOMCMDTEST" "dummysystemID">
<root/>
}]
set root [$doc documentElement]
set result [$root @lang]
$doc delete
set result
} {en}
test dom-2.12 {parse method: -paramentityparsing never} {
set doc [dom parse -externalentitycommand extRefResolver \
-paramentityparsing never {
<!DOCTYPE root PUBLIC "DOMCMDTEST" "dummysystemID">
<root/>
}]
set root [$doc documentElement]
set result [catch {set result [$root @lang]} errMsg]
$doc delete
lappend result $errMsg
set result
} {1 {Attribute "lang" not found!}}
test dom-2.13 {parse method: -paramentityparsing notstandalone} {
set doc [dom parse -externalentitycommand extRefResolver \
-paramentityparsing notstandalone {
<!DOCTYPE root PUBLIC "DOMCMDTEST" "dummysystemID">
<root/>
}]
set root [$doc documentElement]
set result [$root @lang]
$doc delete
set result
} {en}
test dom-2.14 {parse method: -paramentityparsing notstandalone} {
set doc [dom parse -externalentitycommand extRefResolver \
-paramentityparsing notstandalone \
{<?xml version="1.0" standalone="yes"?>
<!DOCTYPE root PUBLIC "DOMCMDTEST" "dummysystemID">
<root/>
}]
set root [$doc documentElement]
set result [catch {set result [$root @lang]} errMsg]
$doc delete
lappend result $errMsg
set result
} {1 {Attribute "lang" not found!}}
test dom-2.15 {parse method: -paramentityparsing notstandalone} {
set doc [dom parse -externalentitycommand extRefResolver \
-paramentityparsing notstandalone \
{<?xml version="1.0" standalone="no"?>
<!DOCTYPE root PUBLIC "DOMCMDTEST" "dummysystemID">
<root/>
}]
set root [$doc documentElement]
set result [$root @lang]
$doc delete
set result
} {en}
test dom-2.16 {parse method: wrong value arg for -paramentityparsing} {
set result [catch {set doc [dom parse -paramentityparsing wrong {
<root/>}]} errMsg]
lappend result $errMsg
} {1 {bad value "wrong": must be always, never, or notstandalone}}
# The following is syntactically wrong. It's used, to test the
# error reporting in external DTDs
set dom_dtd "<!ATTLIST root lang #FIXED \"en\">"
test dom-2.17 {parse method: test reporting of error in external subset} {
set result [catch {set doc [dom parse \
-externalentitycommand extRefResolver {
<!DOCTYPE root PUBLIC "DOMCMDTEST" "dummysystemID">
<root/>
}]} errMsg]
lappend result $errMsg
} {1 {error "syntax error" in entity "dummysystemID" at line 1 character 20
"<!ATTLIST root lang # <--Error-- FIXED "en">", referenced at line 2 character 58}}
test dom-2.18 {parse document with nodes before and after the documentElement} {
set doc [dom parse {<!-- First comment -->
<doc>
<!-- Front comment -->
<inner/>
<!-- Back comment -->
</doc>
<!-- Last comment -->}]
set result [$doc asXML -indent none]
$doc delete
set result
} {<!-- First comment --><doc><!-- Front comment --><inner/><!-- Back comment --></doc><!-- Last comment -->}
test dom-2.19 {parse document - rename docCmd} {
set doc [dom parse {<root>foo<child/></root>}]
if {[info commands fooCmd] == "fooCmd"} {
rename fooCmd {}
}
rename $doc fooCmd
set result [fooCmd asXML -indent none]
fooCmd delete
set result
} {<root>foo<child/></root>}
test dom-2.20 {parse - doc with internal subset parsed with -keepEmpties} {
set doc [dom parse -keepEmpties {
<!DOCTYPE root [
<!ELEMENT root EMPTY>
<!-- Comment inside the DTD -->
<?aPI Inside the DTD?>
<!ATTLIST root lang CDATA #FIXED "en">
]>
<root/>}]
$doc documentElement root
set result ""
foreach node [$root selectNodes /node()] {
switch [$node nodeType] {
TEXT_NODE {
lappend result TEXT_NODE
lappend result [string length [$node value]]
}
COMMENT_NODE {
lappend result COMMENT_NODE
lappend result [string length [$node value]]
}
PROCESSING_INSTRUCTION_NODE {
lappend result PROCESSING_INSTRUCTION_NODE
lappend result [$node target]
lappend result [$node data]
}
ELEMENT_NODE {
lappend result ELEMENT_NODE
lappend result [$node nodeName]
}
default {
lappend result [$node nodeType]
}
}
}
$doc delete
set result
} {ELEMENT_NODE root}
test dom-2.21 {parse - empty CDATA section} {
set doc [dom parse {<doc><![CDATA[]]></doc>}]
set root [$doc documentElement]
set result [$root hasChildNodes]
$doc delete
set result
} {0}
test dom-2.22 {parse - empty comment section} {
set doc [dom parse {<doc><!----></doc>}]
set root [$doc documentElement]
set result [$root hasChildNodes]
lappend result [[$root firstChild] nodeValue]
$doc delete
set result
} {1 {}}
test dom-2.23 {parse - pi without pivalue} {
set doc [dom parse {<doc><?p?></doc>}]
set pi [[$doc documentElement] firstChild]
set result [list [$pi nodeName] [$pi nodeValue] [$pi target] [$pi data]]
$doc delete
set result
} {p {} p {}}
proc 2.24 {args} {
error "2.24 external entitiy resolver script error"
}
test dom-2.24 {parse - script error in -externalentitycommand} {
set result [catch {
dom parse -externalentitycommand 2.24 {
<!DOCTYPE root SYSTEM "data/domCmd2.dtd">
<root/>}} errMsg]
lappend result $errMsg
} {1 {2.24 external entitiy resolver script error}}
test dom-2.25 {White space outside the document element is markup and ignored, even with -keepEmpties} {
set doc [dom parse -keepEmpties {
<!-- First comment -->
<doc>
<!-- Front comment -->
<inner/>
<!-- Back comment -->
</doc>
<!-- Last comment -->}]
set result [$doc asXML -indent none]
$doc delete
set result
} {<!-- First comment --><doc>
<!-- Front comment -->
<inner/>
<!-- Back comment -->
</doc><!-- Last comment -->}
test dom-2.26 {Not well-formed input} {
catch {dom parse {<xsl:transform
xmlns:xsl="http://www.w3.org/1999/XSL/Transform
<http://www.w3.org/1999/XSL/Transform> "/>}}
} 1
test dom-2.27 {parse -ignorexmlns} {
set result [list]
set doc [dom parse {<doc xmlns="foo.bar"><child/></doc>}]
set root [$doc documentElement]
lappend result [$root localName]
lappend result [$root namespaceURI]
set child [$root firstChild]
lappend result [$child localName]
lappend result [$child namespaceURI]
lappend result [$doc selectNodes count(/doc/child)]
$doc delete
set doc [dom parse -ignorexmlns {<doc xmlns="foo.bar"><child/></doc>}]
set root [$doc documentElement]
lappend result [$root nodeName]
lappend result [$root namespaceURI]
set child [$root firstChild]
lappend result [$child nodeName]
lappend result [$child namespaceURI]
lappend result [$doc selectNodes count(/doc/child)]
$doc delete
set result
} {doc foo.bar child foo.bar 0 doc {} child {} 1}
test dom-2.28 {parse document with undeclared xml prefix} {
catch {dom parse {<doc><foo:e/></doc>}} errMsg
string range $errMsg 0 30
} {Namespace prefix is not defined}
test dom-2.29 {parse not well-formed document with undeclared xml prefix} {
catch {dom parse {<foo:e/>}} errMsg
string range $errMsg 0 30
} {Namespace prefix is not defined}
test dom-2.30 {parse document with undeclared xml prefix} {
catch {dom parse {<foo:e><a/></foo:e>}} errMsg
string range $errMsg 0 30
} {Namespace prefix is not defined}
proc dom-2.31 {base systemId publicId} {
switch $publicId {
"e1" {
# Not well-formed
set data "<foo:e/>"
}
default {
error "unknown public ID"
}
}
return [list "string" $base $data]
}
test dom-2.31 {parse document with undeclared xml prefix} {
catch {dom parse -externalentitycommand dom-2.31 \
{<!DOCTYPE doc [<!ENTITY e1 PUBLIC "e1" "e1.xml">]>
<doc>&e1;</doc>}
} errMsg
string range $errMsg 0 30
} {Namespace prefix is not defined}
test dom-2.32 {parse document with undeclared xml prefix and -ignorexmlns} {
set doc [dom parse -ignorexmlns {<foo:e><a/></foo:e>}]
set result [[$doc documentElement] nodeName]
$doc delete
set result
} {foo:e}
test dom-2.33 {end of options option} {
set doc [dom parse -json -- -0.123]
set result [$doc asXML -indent none]
$doc delete
set result
} -0.123
test dom-2.34 {XML prefix declaration with empty namespace} {
catch {dom parse {<foo:doc xmlns:foo=""><e1/></foo:doc>}} errMsg
set errMsg
} {Missing URI in Namespace declaration, referenced at line 1 character 22}
test dom-2.35 {-keepCDATA} {
set doc [dom parse -keepCDATA {<doc>foo <![CDATA[test of & <bad> format]]> bar </doc>}]
set result [$doc asXML -indent none]
$doc delete
set result
} {<doc>foo <![CDATA[test of & <bad> format]]> bar </doc>}
test dom-2.36 {-keepCDATA} {
set doc [dom parse -keepCDATA {<doc>foo <![CDATA[test of & <bad> format]]> bar </doc>}]
set root [$doc documentElement]
set result [list]
foreach child [$root childNodes] {
lappend result [$child nodeType]
}
$doc delete
set result
} {TEXT_NODE CDATA_SECTION_NODE TEXT_NODE}
test dom-2.37 {-keepCDATA} {
set doc [dom parse -keepCDATA {<doc><e><![CDATA[one]]></e></doc>}]
set result [list]
foreach child [$doc selectNodes doc/e/node()] {
lappend result [$child nodeType]
}
$doc delete
set result
} {CDATA_SECTION_NODE}
test dom-2.38 {-keepCDATA} {
set doc [dom parse -keepCDATA {<doc><e><![CDATA[one]]><![CDATA[two]]></e></doc>}]
set result [list]
foreach child [$doc selectNodes doc/e/node()] {
lappend result [$child nodeType]
}
$doc delete
set result
} {CDATA_SECTION_NODE CDATA_SECTION_NODE}
test dom-2.39 {-keepCDATA} {
set doc [dom parse -keepCDATA {<doc><e><![CDATA[]]></e></doc>}]
set result [$doc selectNodes count(doc/e/node())]
$doc delete
set result
} 0
test dom-2.40 {-keepCDATA white space only CDATA section} {
set doc [dom parse -keepCDATA {<doc><e><![CDATA[
]]></e></doc>}]
set result [$doc selectNodes count(doc/e/node())]
$doc delete
set result
} 0
test dom-2.41 {-keepCDATA and -keepEmpties} {
set doc [dom parse -keepCDATA -keepEmpties {<doc><e><![CDATA[]]></e></doc>}]
set result [$doc selectNodes count(doc/e/node())]
$doc delete
set result
} 1
test dom-2.42 {namespaces} {
set doc [dom parse {
<help><br xmlns:xsi="a"/><em xmlns:xsi="a">notes</em></help>
}]
$doc delete
} {}
test dom-3.1 {isName} {
dom isName ":foo"
} {1}
test dom-3.2 {isName} {
dom isName "_foo"
} {1}
test dom-3.3 {isName} {
dom isName "foo:bar:baz"
} {1}
test dom-3.4 {isName} {
dom isName "-foo"
} {0}
test dom-3.5 {isName} {
dom isName ".foo"
} {0}
test dom-3.6 {isName} {
catch {dom isName}
} {1}
test dom-3.7 {isName} {
catch {dom isName foo bar}
} {1}
# The following character classes are out of XML 1.0 Second Edition rec,
# Appendix B (which is following the Unicode standard).
set BaseChar {
{0x0041 0x005A} {0x0061 0x007A} {0x00C0 0x00D6}
{0x00D8 0x00F6} {0x00F8 0x00FF} {0x0100 0x0131} {0x0134 0x013E}
{0x0141 0x0148} {0x014A 0x017E} {0x0180 0x01C3}
{0x01CD 0x01F0} {0x01F4 0x01F5} {0x01FA 0x0217} {0x0250 0x02A8}
{0x02BB 0x02C1} 0x0386 {0x0388 0x038A} 0x038C
{0x038E 0x03A1} {0x03A3 0x03CE} {0x03D0 0x03D6} 0x03DA 0x03DC
0x03DE 0x03E0 {0x03E2 0x03F3} {0x0401 0x040C}
{0x040E 0x044F} {0x0451 0x045C} {0x045E 0x0481} {0x0490 0x04C4}
{0x04C7 0x04C8} {0x04CB 0x04CC} {0x04D0 0x04EB}
{0x04EE 0x04F5} {0x04F8 0x04F9} {0x0531 0x0556} 0x0559
{0x0561 0x0586} {0x05D0 0x05EA} {0x05F0 0x05F2} {0x0621 0x063A}
{0x0641 0x064A} {0x0671 0x06B7} {0x06BA 0x06BE}
{0x06C0 0x06CE} {0x06D0 0x06D3} 0x06D5 {0x06E5 0x06E6}
{0x0905 0x0939} 0x093D {0x0958 0x0961} {0x0985 0x098C}
{0x098F 0x0990} {0x0993 0x09A8} {0x09AA 0x09B0} 0x09B2
{0x09B6 0x09B9} {0x09DC 0x09DD} {0x09DF 0x09E1} {0x09F0 0x09F1}
{0x0A05 0x0A0A} {0x0A0F 0x0A10} {0x0A13 0x0A28}
{0x0A2A 0x0A30} {0x0A32 0x0A33} {0x0A35 0x0A36} {0x0A38 0x0A39}
{0x0A59 0x0A5C} 0x0A5E {0x0A72 0x0A74} {0x0A85 0x0A8B}
0x0A8D {0x0A8F 0x0A91} {0x0A93 0x0AA8} {0x0AAA 0x0AB0}
{0x0AB2 0x0AB3} {0x0AB5 0x0AB9} 0x0ABD 0x0AE0 {0x0B05 0x0B0C}
{0x0B0F 0x0B10} {0x0B13 0x0B28} {0x0B2A 0x0B30}
{0x0B32 0x0B33} {0x0B36 0x0B39} 0x0B3D {0x0B5C 0x0B5D}
{0x0B5F 0x0B61} {0x0B85 0x0B8A} {0x0B8E 0x0B90} {0x0B92 0x0B95}
{0x0B99 0x0B9A} 0x0B9C {0x0B9E 0x0B9F} {0x0BA3 0x0BA4}
{0x0BA8 0x0BAA} {0x0BAE 0x0BB5} {0x0BB7 0x0BB9} {0x0C05 0x0C0C}
{0x0C0E 0x0C10} {0x0C12 0x0C28} {0x0C2A 0x0C33}
{0x0C35 0x0C39} {0x0C60 0x0C61} {0x0C85 0x0C8C} {0x0C8E 0x0C90}
{0x0C92 0x0CA8} {0x0CAA 0x0CB3} {0x0CB5 0x0CB9} 0x0CDE
{0x0CE0 0x0CE1} {0x0D05 0x0D0C} {0x0D0E 0x0D10} {0x0D12 0x0D28}
{0x0D2A 0x0D39} {0x0D60 0x0D61} {0x0E01 0x0E2E} 0x0E30
{0x0E32 0x0E33} {0x0E40 0x0E45} {0x0E81 0x0E82} 0x0E84
{0x0E87 0x0E88} 0x0E8A 0x0E8D {0x0E94 0x0E97} {0x0E99 0x0E9F}
{0x0EA1 0x0EA3} 0x0EA5 0x0EA7 {0x0EAA 0x0EAB}
{0x0EAD 0x0EAE} 0x0EB0 {0x0EB2 0x0EB3} 0x0EBD {0x0EC0 0x0EC4}
{0x0F40 0x0F47} {0x0F49 0x0F69} {0x10A0 0x10C5}
{0x10D0 0x10F6} 0x1100 {0x1102 0x1103} {0x1105 0x1107} 0x1109
{0x110B 0x110C} {0x110E 0x1112} 0x113C 0x113E 0x1140
0x114C 0x114E 0x1150 {0x1154 0x1155} 0x1159 {0x115F 0x1161}
0x1163 0x1165 0x1167 0x1169 {0x116D 0x116E}
{0x1172 0x1173} 0x1175 0x119E 0x11A8 0x11AB {0x11AE 0x11AF}
{0x11B7 0x11B8} 0x11BA {0x11BC 0x11C2} 0x11EB 0x11F0
0x11F9 {0x1E00 0x1E9B} {0x1EA0 0x1EF9} {0x1F00 0x1F15}
{0x1F18 0x1F1D} {0x1F20 0x1F45} {0x1F48 0x1F4D} {0x1F50 0x1F57}
0x1F59 0x1F5B 0x1F5D {0x1F5F 0x1F7D} {0x1F80 0x1FB4}
{0x1FB6 0x1FBC} 0x1FBE {0x1FC2 0x1FC4} {0x1FC6 0x1FCC}
{0x1FD0 0x1FD3} {0x1FD6 0x1FDB} {0x1FE0 0x1FEC} {0x1FF2 0x1FF4}
{0x1FF6 0x1FFC} 0x2126 {0x212A 0x212B} 0x212E
{0x2180 0x2182} {0x3041 0x3094} {0x30A1 0x30FA} {0x3105 0x312C}
{0xAC00 0xD7A3}
}
set Ideographic {
{0x4E00 0x9FA5} 0x3007 {0x3021 0x3029}
}
set CombiningChar {
{0x0300 0x0345} {0x0360 0x0361} {0x0483 0x0486} {0x0591 0x05A1}
{0x05A3 0x05B9} {0x05BB 0x05BD} 0x05BF {0x05C1 0x05C2}
0x05C4 {0x064B 0x0652} 0x0670 {0x06D6 0x06DC} {0x06DD 0x06DF}
{0x06E0 0x06E4} {0x06E7 0x06E8} {0x06EA 0x06ED}
{0x0901 0x0903} 0x093C {0x093E 0x094C} 0x094D {0x0951 0x0954}
{0x0962 0x0963} {0x0981 0x0983} 0x09BC 0x09BE 0x09BF
{0x09C0 0x09C4} {0x09C7 0x09C8} {0x09CB 0x09CD} 0x09D7
{0x09E2 0x09E3} 0x0A02 0x0A3C 0x0A3E 0x0A3F {0x0A40 0x0A42}
{0x0A47 0x0A48} {0x0A4B 0x0A4D} {0x0A70 0x0A71}
{0x0A81 0x0A83} 0x0ABC {0x0ABE 0x0AC5} {0x0AC7 0x0AC9}
{0x0ACB 0x0ACD} {0x0B01 0x0B03} 0x0B3C {0x0B3E 0x0B43}
{0x0B47 0x0B48} {0x0B4B 0x0B4D} {0x0B56 0x0B57} {0x0B82 0x0B83}
{0x0BBE 0x0BC2} {0x0BC6 0x0BC8} {0x0BCA 0x0BCD} 0x0BD7
{0x0C01 0x0C03} {0x0C3E 0x0C44} {0x0C46 0x0C48} {0x0C4A 0x0C4D}
{0x0C55 0x0C56} {0x0C82 0x0C83} {0x0CBE 0x0CC4}
{0x0CC6 0x0CC8} {0x0CCA 0x0CCD} {0x0CD5 0x0CD6} {0x0D02 0x0D03}
{0x0D3E 0x0D43} {0x0D46 0x0D48} {0x0D4A 0x0D4D} 0x0D57
0x0E31 {0x0E34 0x0E3A} {0x0E47 0x0E4E} 0x0EB1 {0x0EB4 0x0EB9}
{0x0EBB 0x0EBC} {0x0EC8 0x0ECD} {0x0F18 0x0F19} 0x0F35
0x0F37 0x0F39 0x0F3E 0x0F3F {0x0F71 0x0F84} {0x0F86 0x0F8B}
{0x0F90 0x0F95} 0x0F97 {0x0F99 0x0FAD} {0x0FB1 0x0FB7}
0x0FB9 {0x20D0 0x20DC} 0x20E1 {0x302A 0x302F} 0x3099 0x309A
}
set Digit {
{0x0030 0x0039} {0x0660 0x0669} {0x06F0 0x06F9} {0x0966 0x096F}
{0x09E6 0x09EF} {0x0A66 0x0A6F} {0x0AE6 0x0AEF}
{0x0B66 0x0B6F} {0x0BE7 0x0BEF} {0x0C66 0x0C6F} {0x0CE6 0x0CEF}
{0x0D66 0x0D6F} {0x0E50 0x0E59} {0x0ED0 0x0ED9}
{0x0F20 0x0F29}
}
set Extender {
0x00B7 0x02D0 0x02D1 0x0387 0x0640 0x0E46 0x0EC6 0x3005
{0x3031 0x3035} {0x309D 0x309E} {0x30FC 0x30FE}
}
proc sortCmd {a b} {
if {[lindex $a 0] > [lindex $b 0]} {
return 1
} else {
return -1
}
}
# if {$tcl_version < 8.4} {
# set nameStartChars [lsort -command sortCmd \
# [concat $BaseChar $Ideographic 0x005F 0x003A]]
# } else {
# set nameStartChars [lsort -integer -index 0 \
# [concat $BaseChar $Ideographic 0x005F 0x003A]]
# }
set nameStartChars [lsort -command sortCmd \
[concat $BaseChar $Ideographic 0x005F 0x003A]]
# Append stop char needed by the test code to work properly.
lappend nameStartChars 0x10000
test dom-3.8 {isName} {longRunning} {
set ind 0
set nr 0
while {$nr < 65536} {
set range [lindex $nameStartChars $ind]
incr ind
if {[llength $range] == 2} {
foreach {min max} $range break
} else {
set min $range
set max $range
}
while {$nr < $min} {
if {[dom isName [subst \\u[format "%04x" $nr]]] != 0} {
error "wrong 'isName' result for name start char #x[format "%04x" $nr] - should be illegal"
}
incr nr
}
if {$nr == 0x10000} {break}
while {$nr <= $max} {
if {[dom isName [subst \\u[format "%04x" $nr]]] != 1} {
error "wrong 'isName' result for name start char #x[format "%04x" $nr] - should be legal"
}
incr nr
}
}
set nr
} {65536}
set nameChars [lsort -command sortCmd \
[concat $BaseChar $Ideographic $Digit 0x002E 0x002D 0x005F 0x003A \
$CombiningChar $Extender]]
# Append stop char needed by the test code to work properly.
lappend nameChars 0x10000
test dom-3.9 {isName} {
set ind 0
set nr 0
while {$nr < 65536} {
set range [lindex $nameChars $ind]
incr ind
if {[llength $range] == 2} {
foreach {min max} $range break
} else {
set min $range
set max $range
}
while {$nr < $min} {
if {[dom isName a[subst \\u[format "%04x" $nr]]] != 0} {
error "wrong 'isName' result for name char #x[format "%04x" $nr] - should be illegal"
}
incr nr
}
if {$nr == 0x10000} {break}
while {$nr <= $max} {
if {[dom isName a[subst \\u[format "%04x" $nr]]] != 1} {
error "wrong 'isName' result for name char #x[format "%04x" $nr] - should be legal"
}
incr nr
}
}
set nr
} {65536}
test dom-3.10 {isNCName} {
dom isNCName ":foo"
} {0}
test dom-3.11 {isNCName} {
dom isNCName "_foo"
} {1}
test dom-3.12 {isNCName} {
dom isNCName "foo:bar:baz"
} {0}
test dom-3.13 {isNCName} {
dom isNCName "-foo"
} {0}
test dom-3.14 {isNCName} {
dom isNCName ".foo"
} {0}
test dom-3.15 {isNCName} {
catch {dom isNCName}
} {1}
test dom-3.16 {isNCName} {
catch {dom isNCName foo bar}
} {1}
test dom-3.17 {isQName} {
dom isQName ":foo"
} {0}
test dom-3.18 {isQName} {
dom isQName "_foo"
} {1}
test dom-3.19 {isQName} {
dom isQName "foo:bar:baz"
} {0}
test dom-3.20 {isQName} {
dom isQName "-foo"
} {0}
test dom-3.21 {isQName} {
dom isQName ".foo"
} {0}
test dom-3.22 {isQName} {
dom isQName "foo:bar"
} {1}
test dom-3.23 {isQName} {
catch {dom isQName}
} {1}
test dom-3.24 {isQName} {
catch {dom isQName foo bar}
} {1}
test dom-3.25 {isQName} {
dom isQName "foo bar"
} {0}
test dom-3.26 {isQName} {
dom isQName "woozbiz:"
} {0}
test dom-3.26.1 {isQName} {
dom isQName foo:1
} {0}
test dom-3.26.2 {isQName} {
dom isQName 1:foo
} {0}
set XMLChars {
0x9 0xA 0xD {0x20 0xD7FF} {0xE000 0xFFFD} {0x10000 0x10FFFF}
}
test dom-3.27 {isCharData} {longRunning} {
set ind 0
set nr 1
while {$nr < 65536} {
set range [lindex $XMLChars $ind]
incr ind
if {[llength $range] == 2} {
foreach {min max} $range break
} else {
set min $range
set max $range
}
while {$nr < $min} {
if {[dom isCharData "a[subst \\u[format "%04x" $nr]]b"] != 0} {
error "wrong 'isCharData' result for char #x[format "%04x" $nr] - should be illegal"
}
incr nr
}
if {$nr == 0x10000} {break}
while {$nr <= $max} {
if {[dom isCharData "a[subst \\u[format "%04x" $nr]]b"] != 1} {
error "wrong 'isCharData' result for char #x[format "%04x" $nr] - should be legal"
}
incr nr
}
}
set nr
} {65536}
test dom-3.28 {isPIName} {
dom isPIName "target"
} {1}
test dom-3.29 {isPIName} {
dom isPIName "foo:target"
} {1}
test dom-3.30 {isPIName} {
dom isPIName "Xml"
} {0}
test dom-3.31 {isComment} {
dom isComment "some comment"
} {1}
test dom-3.32 {isComment} {
dom isComment "some invalid -- comment"
} {0}
test dom-3.33 {isComment} {
dom isComment "some invalid comment-"
} {0}
test dom-3.34 {isCDATA} {
dom isCDATA "<valid>some ]] CDATA </valid>"
} {1}
test dom-3.35 {isCDATA} {
dom isCDATA "<invalid>some ]]> CDATA </invalid>"
} {0}
test dom-3.36 {isCDATA} {
dom isCDATA "invalid: ]]>"
} {0}
test dom-3.37 {isCDATA} {
dom isCDATA "valid: ]]> "
} {0}
test dom-3.38 {isCDATA} {
dom isCDATA "\ud7fa\ud7fb\ud7fc\ud7fd\ud7fe\ud7ff]]>"
} {0}
test dom-3.39 {isPIValue} {
dom isPIValue "some processing instruction data"
} {1}
test dom-3.40 {isPIValue} {
dom isPIValue "some invalid ?> processing instruction data"
} {0}
test dom-3.41 {isPIValue} {
dom isPIValue "some invalid processing instruction data?>"
} {0}
test dom-4.1 {-useForeignDTD 0} {
set doc [dom parse -useForeignDTD 0 {<root/>}]
$doc delete
} {}
test dom-4.2 {-useForeignDTD 1 with document with internal subset} {need_uri} {
set baseURI [tdom::baseURL [file join [pwd] [file dir [info script]] dom.test]]
set ::tdom::useForeignDTD "data/domCmd1.dtd"
set doc [dom parse \
-useForeignDTD 1 \
-baseurl $baseURI \
-externalentitycommand ::tdom::extRefHandler {
<!DOCTYPE root [
<!ATTLIST root fixed CDATA #FIXED "toThat">
]>
<root/>}]
set root [$doc documentElement]
set result [$root @fixed]
$doc delete
set result
} {toThat}
test dom-4.3 {-useForeignDTD 1 with document with internal subset} {need_uri} {
set baseURI [tdom::baseURL [file join [pwd] [file dir [info script]] dom.test]]
set ::tdom::useForeignDTD "data/domCmd1.dtd"
set doc [dom parse \
-useForeignDTD 1 \
-baseurl $baseURI \
-externalentitycommand ::tdom::extRefHandler {
<!DOCTYPE root [
<!ATTLIST root fixed2 CDATA #FIXED "toThat">
]>
<root/>}]
set root [$doc documentElement]
set result [$root @fixed]
lappend result [$root @fixed2]
$doc delete
set result
} {toThis toThat}
test dom-4.4 {-useForeignDTD 1 with document without document declaration} {need_uri} {
set baseURI [tdom::baseURL [file join [pwd] [file dir [info script]] dom.test]]
set ::tdom::useForeignDTD "data/domCmd1.dtd"
set doc [dom parse \
-useForeignDTD 1 \
-baseurl $baseURI \
-externalentitycommand ::tdom::extRefHandler <root/>]
set root [$doc documentElement]
set result [$root @fixed]
$doc delete
set result
} {toThis}
test dom-4.5 {-useForeignDTD 1 does not overwrite a given external subset} {need_uri} {
set baseURI [tdom::baseURL [file join [pwd] [file dir [info script]] dom.test]]
set ::tdom::useForeignDTD "data/domCmd1.dtd"
set doc [dom parse \
-useForeignDTD 1 \
-baseurl $baseURI \
-externalentitycommand ::tdom::extRefHandler {
<!DOCTYPE root SYSTEM "data/domCmd2.dtd">
<root/>}]
set root [$doc documentElement]
set result [$root @fixed]
$doc delete
set result
} {toThat}
test dom-4.6 {-useForeignDTD with nonboolean arg} {need_uri} {
set result [catch {set doc [dom parse -useForeignDTD foo <root/>]} errMsg]
lappend result $errMsg
} {1 {expected boolean value but got "foo"}}
test dom-5.1 {document with external subset} {need_uri} {
set baseURI [tdom::baseURL [file join [pwd] [file dir [info script]] dom.test]]
set doc [dom parse \
-baseurl $baseURI \
-externalentitycommand ::tdom::extRefHandler {
<!DOCTYPE root SYSTEM "data/domCmd2.dtd">
<root/>}]
set root [$doc documentElement]
set result [$root @fixed]
$doc delete
set result
} {toThat}
proc dom-5.2 {myparm base systemId publicId} {
set ::dom-5_2 $myparm
return [list string dummy ""]
}
test dom-5.2 {-externalentitycommand} {
set ::dom-5_2 ""
set doc [dom parse \
-baseurl "dummy" \
-externalentitycommand [list dom-5.2 thisDoc] {
<!DOCTYPE root SYSTEM "">
<root/>}]
$doc delete
set ::dom-5_2
} {thisDoc}
proc dom-5.3 {base systemId publicId} {
switch $publicId {
"e1" {
# Not well-formed
set data "<e,1/>"
}
default {
error "unknown public ID"
}
}
return [list "string" $base $data]
}
test dom-5.3 {-externalentitycommand - nested external entities} -body {
set result [catch {
dom parse -externalentitycommand dom-5.3 \
{<!DOCTYPE doc [
<!ENTITY e1 PUBLIC "e1" "e1.xml">
]>
<doc>&e1;</doc>}
} msg]
list $result $msg
} -result [list 1 {error "not well-formed (invalid token)" in entity "e1.xml" at line 1 character 2
"<e, <--Error-- 1/>", referenced at line 4 character 21}]
proc dom-5.4 {base systemId publicId} {
switch $publicId {
"e1" {
set data "<e1>&e2;</e1>"
}
"e2" {
set data "<e,2/>"
}
default {
error "unknown public ID"
}
}
return [list "string" $base $data]
}
test dom-5.4 {-externalentitycommand - nested external entities} -body {
set result [catch {
dom parse -externalentitycommand dom-5.4 \
{<!DOCTYPE doc [
<!ENTITY e1 PUBLIC "e1" "e1.xml">
<!ENTITY e2 PUBLIC "e2" "e2.xml">
]>
<doc>&e1;</doc>}
} msg]
list $result $msg
} -result [list 1 {error "not well-formed (invalid token)" in entity "e2.xml" at line 1 character 2
"<e, <--Error-- 2/>", referenced in entity "e1.xml" at line 1 character 4, referenced at line 5 character 21}]
proc dom-5.5 {base systemId publicId} {
switch $publicId {
"e1" {
set data "<e1>&e2;</e1>"
}
"e2" {
set data "<e2>&e3;</e2>"
}
"e3" {
# Not well-formed
set data "<e,3/>"
}
default {
error "unknown public ID"
}
}
return [list "string" $base $data]
}
test dom-5.5 {-externalentitycommand - nested external entities} -body {
set result [catch {
dom parse -externalentitycommand dom-5.5 \
{<!DOCTYPE doc [
<!ENTITY e1 PUBLIC "e1" "e1.xml">
<!ENTITY e2 PUBLIC "e2" "e2.xml">
<!ENTITY e3 PUBLIC "e3" "e3.xml">
]>
<doc>&e1;</doc>}
} msg]
list $result $msg
} -result [list 1 {error "not well-formed (invalid token)" in entity "e3.xml" at line 1 character 2
"<e, <--Error-- 3/>", referenced in entity "e2.xml" at line 1 character 4, referenced in entity "e1.xml" at line 1 character 4, referenced at line 6 character 21}]
proc dom-5.6 {base systemId publicId} {
switch $publicId {
"e1" {
set data [open $::e1]
}
default {
error "unknown public ID"
}
}
lappend ::openChannels $data
return [list "channel" $base $data]
}
test dom-5.6 {-externalentitycommand - nested external entities} -setup {
set e1 [makeFile "<e,1/>" e1.xml]
set openChannels [list]
} -body {
set result [catch {
dom parse -externalentitycommand dom-5.6 \
{<!DOCTYPE doc [
<!ENTITY e1 PUBLIC "e1" "e1.xml">
]>
<doc>&e1;</doc>}
} msg]
list $result $msg
} -cleanup {
foreach channel $openChannels {close $channel}
removeFile e1.xml
} -result [list 1 {error "not well-formed (invalid token)" in entity "e1.xml" at line 1 character 2, referenced at line 4 character 21}]
proc dom-5.7 {base systemId publicId} {
switch $publicId {
"e1" {
set data [open $::e1]
}
"e2" {
set data [open $::e2]
}
default {
error "unknown public ID"
}
}
lappend ::openChannels $data
return [list "channel" $base $data]
}
test dom-5.7 {-externalentitycommand - nested external entities} -setup {
set e1 [makeFile "<e1>&e2;</e1>" e1.xml]
set e2 [makeFile "<e,2/>" e2.xml]
set openChannels [list]
} -body {
set result [catch {
dom parse -externalentitycommand dom-5.7 \
{<!DOCTYPE doc [
<!ENTITY e1 PUBLIC "e1" "e1.xml">
<!ENTITY e2 PUBLIC "e2" "e2.xml">
]>
<doc>&e1;</doc>}
} msg]
list $result $msg
} -cleanup {
foreach channel $openChannels {close $channel}
removeFile e1.xml
removeFile e2.xml
} -result [list 1 {error "not well-formed (invalid token)" in entity "e2.xml" at line 1 character 2, referenced in entity "e1.xml" at line 1 character 4, referenced at line 5 character 21}]
proc dom-5.8 {base systemId publicId} {
switch $publicId {
"e1" {
set data [open $::e1]
}
"e2" {
set data [open $::e2]
}
"e3" {
set data [open $::e3]
}
default {
error "unknown public ID"
}
}
lappend ::openChannels $data
return [list "channel" $base $data]
}
test dom-5.8 {-externalentitycommand - nested external entities} -setup {
set e1 [makeFile "<e1>&e2;</e1>" e1.xml]
set e2 [makeFile "<e2>&e3;</e2>" e2.xml]
set e3 [makeFile "<e,3/>" e3.xml]
set openChannels [list]
} -body {
set result [catch {
dom parse -externalentitycommand dom-5.8 \
{<!DOCTYPE doc [
<!ENTITY e1 PUBLIC "e1" "e1.xml">
<!ENTITY e2 PUBLIC "e2" "e2.xml">
<!ENTITY e3 PUBLIC "e3" "e3.xml">
]>
<doc>&e1;</doc>}
} msg]
list $result $msg
} -cleanup {
foreach channel $openChannels {close $channel}
removeFile e1.xml
removeFile e2.xml
removeFile e3.xml
} -result [list 1 {error "not well-formed (invalid token)" in entity "e3.xml" at line 1 character 2, referenced in entity "e2.xml" at line 1 character 4, referenced in entity "e1.xml" at line 1 character 4, referenced at line 6 character 21}]
test dom-5.9 {Wrong option after -externalentitycommand} -body {
set result [catch {dom parse -externalentitycommand ::tdom::extRefHandler \
-useForeignDTD foo}]
} -result 1
test dom-6.1 {use in slave interpreter} {
set slave [interp create]
load {} tdom $slave
interp eval $slave {
dom parse <root>foo</root> doc
$doc documentElement root
}
interp delete $slave
} {}
test dom-6.2 {use in slave interpreter} {
set slave [interp create]
load {} tdom $slave
interp eval $slave {
set doc [dom parse <root>foo</root>]
set root [$doc documentElement]
}
interp delete $slave
} {}
test dom-7.1 {setNameCheck} {
set result [dom setNameCheck]
lappend result [dom setNameCheck 0]
lappend result [dom setNameCheck]
# set back to default
lappend result [dom setNameCheck 1]
set result
} {1 0 0 1}
set doc [dom createDocument root]
# ensure, we've the default
dom setNameCheck 1
test dom-7.2 {setNameCheck} {
set result [catch {$doc createElement "invalid name"} errMsg]
lappend result $errMsg
} {1 {Invalid tag name 'invalid name'}}
test dom-7.3 {setNameCheck} {
catch {$doc createElement "valid:name"}
} {0}
test dom-7.4 {setNameCheck} {
catch {$doc createElement "valid::name"}
} {0}
test dom-7.5 {setNameCheck} {
dom setNameCheck 0
set result [catch {$doc createElement "invalid name"} errMsg]
# set back to default
dom setNameCheck 1
set result
} {0}
test dom-7.6 {setNameCheck} {
set result [catch {$doc createElementNS "dummyns" "invalid name"} errMsg]
lappend result $errMsg
} {1 {Invalid full qualified tag name 'invalid name'}}
test dom-7.7 {setNameCheck} {
catch {$doc createElementNS "dummyns" "valid:name"}
} {0}
test dom-7.8 {setNameCheck} {
set result [catch {$doc createElementNS "dummyns" "invalid::name"} errMsg]
lappend result $errMsg
} {1 {Invalid full qualified tag name 'invalid::name'}}
test dom-7.9 {setNameCheck} {
dom setNameCheck 0
set result [catch {$doc createElementNS "dummyns" "invalid name"} errMsg]
# set back to default
dom setNameCheck 1
set result
} {0}
test dom-7.10 {setTextCheck} {
set result [catch {$doc createComment "valid comment"}]
lappend result [catch {$doc createComment "invalid -- comment"}]
dom setTextCheck 0
lappend result [catch {$doc createComment "invalid -- comment"}]
dom setTextCheck 1
set result
} {0 1 0}
test dom-7.11 {setTextCheck} {
set result [catch {$doc createCDATASection "<valid/>"}]
lappend result [catch {$doc createCDATASection "<invalid>]]></invalid"}]
dom setTextCheck 0
lappend result [catch {$doc createCDATASection "<invalid>]]></invalid"}]
dom setTextCheck 1
set result
} {0 1 0}
test dom-7.12 {setTextCheck} {
set result [catch {$doc createTextNode "data"}]
lappend result [catch {$doc createTextNode "not XML \u0002 Char data"}]
dom setTextCheck 0
lappend result [catch {$doc createTextNode "not XML \u0002 Char data"}]
dom setTextCheck 1
set result
} {0 1 0}
test dom-7.13 {setNameCheck} {
set result [catch {$doc createProcessingInstruction "target" "data"}]
lappend result [catch {$doc createProcessingInstruction "tar get" "data"}]
lappend result [catch {$doc createProcessingInstruction "xMl" "data"}]
dom setNameCheck 0
lappend result [catch {$doc createProcessingInstruction "tar get" "data"}]
lappend result [catch {$doc createProcessingInstruction "xMl" "data"}]
dom setNameCheck 1
set result
} {0 1 1 0 0}
set root [$doc documentElement]
test dom-7.14 {setNameCheck} {
set result [catch {$root appendFromList {"a b" {} {}}} errMsg]
lappend result $errMsg
dom setNameCheck 0
lappend result [catch {$root appendFromList {"a b" {} {}}}]
dom setNameCheck 1
set result
} {1 {Invalid tag name 'a b'} 0}
test dom-7.15 {setNameCheck} {
set result [catch {$root appendFromList {a {att1 "att1 value" "att 2" "att2 value"} {}}} errMsg]
lappend result $errMsg
dom setNameCheck 0
lappend result [catch {$root appendFromList {a {att1 "att1 value" "att 2" "att2 value"} {}}}]
dom setNameCheck 1
set result
} {1 {Invalid attribute name 'att 2'} 0}
test dom-7.16 {setTextCheck} {
set result [catch {$root appendFromList {a {att1 "att1 value" "att2" "att2 value \u0002"} {}}} errMsg]
lappend result $errMsg
dom setTextCheck 0
lappend result [catch {$root appendFromList {a {att1 "att1 value" "att2" "att2 value \u0002"} {}}}]
dom setTextCheck 1
set result
} [list 1 "Invalid attribute value 'att2 value \u0002'" 0]
test dom-7.17 {setTextCheck} {
set result [catch {$root appendFromList {\#text "foo \u0002"}} errMsg]
lappend result $errMsg
dom setTextCheck 0
lappend result [catch {$root appendFromList {\#text "foo \u0002"}}]
dom setTextCheck 1
set result
} [list 1 "Invalid text value 'foo \u0002'" 0]
$doc delete
test dom-7.18 {setTextCheck and appendFromScript} {
set doc [dom createDocumentNode]
dom setTextCheck 0
namespace eval nodeCmds {
dom createNodeCmd elementNode doc
dom createNodeCmd textNode t
}
$doc appendFromScript {
nodeCmds::doc {
nodeCmds::t "foo\u0003bar"
}
}
dom setTextCheck 1
set result [$doc asXML -indent none]
$doc delete
set result
} "<doc>foo\u0003bar</doc>"
test dom-7.19 {setTextCheck and appendFromScript - setTextCheck state at create time is crucial} {
set doc [dom createDocumentNode]
namespace eval nodeCmds {
dom createNodeCmd elementNode doc
dom createNodeCmd textNode t
}
dom setTextCheck 0
set result [catch {$doc appendFromScript {
nodeCmds::doc {
nodeCmds::t "foo\u0003bar"
}
}} errMsg]
dom setTextCheck 1
$doc delete
lappend result $errMsg
} [list 1 "Invalid text value 'foo\u0003bar'"]
test dom-7.19 {setNameCheck / createDocument} {
dom setNameCheck 0
dom createDocument "foo bar" doc
set result [$doc asXML -indent none]
$doc delete
dom setNameCheck 1
set result
} {<foo bar/>}
test dom-8.1 {createDocumentNode} {
set result [catch {dom createDocumentNode foo bar}]
} {1}
test dom-8.2 {createDocumentNode} {
set docNode [dom createDocumentNode]
set result [$docNode asXML -indent none]
$docNode delete
set result
} {}
test dom-8.3 {createDocumentNode} {
dom createDocumentNode docNode
set result [$docNode asXML -indent none]
$docNode delete
set result
} {}
test dom-8.4 {createDocumentNode} {
set docNode [dom createDocumentNode]
set result [$docNode nodeType]
lappend result [$docNode documentElement]
$docNode delete
set result
} {DOCUMENT_NODE {}}
test dom-8.5 {createDocumentNode} {
set docNode [dom createDocumentNode]
set newNode [$docNode createComment "Comment before the document node"]
$docNode appendChild $newNode
set result [[$docNode documentElement] nodeType]
set newNode [$docNode createElement firstChild]
$docNode appendChild $newNode
lappend result [[$docNode documentElement] nodeName]
set newNode [$docNode createElement secondChild]
$docNode appendChild $newNode
lappend result [[$docNode documentElement] nodeName]
$docNode delete
set result
} {COMMENT_NODE firstChild firstChild}
test dom-8.6 {createDocumentNode} {
set docNode [dom createDocumentNode]
set doc [dom parse {<root><child1/><child2/>some text<child3/></root>}]
set root [$doc documentElement]
set listRep [$root asList]
$doc delete
$docNode appendFromList $listRep
set result [$docNode asXML -indent none]
$docNode delete
set result
} {<root><child1/><child2/>some text<child3/></root>}
test dom-8.7 {createDocumentNode} {
dom createDocumentNode docNode
dom createDocumentNode docNode
$docNode delete
set result ""
} ""
test dom-8.8 {createDocumentNode} {
dom createDocumentNode -jsonType ARRAY docNode
set result [$docNode jsonType]
$docNode delete
set result
} ARRAY
test dom-8.9 {createDocumentNode} {
set docNode [dom createDocumentNode -jsonType NUMBER]
set result [$docNode jsonType]
$docNode delete
set result
} NUMBER
test dom-8.10 {createDocumentNode} {
catch {dom createDocumentNode -foo NULL docNode} errMsg
set errMsg
} {bad option "-foo": must be -jsonType}
test dom-8.10 {createDocumentNode} {
catch {dom createDocumentNode -foo NULL docNode} errMsg
set errMsg
} {bad option "-foo": must be -jsonType}
test dom-8.11 {createDocumentNode} {
catch {dom createDocumentNode -jsonType FOO docNode} errMsg
set errMsg
} {bad jsonType "FOO": must be NONE, ARRAY, OBJECT, NULL, TRUE, FALSE, STRING, or NUMBER}
test dom-9.1 {setObjectCommands} {
dom setObjectCommands
} {automatic}
test dom-9.2 {setObjectCommands} {
dom setObjectCommands automatic
} {automatic}
test dom-9.3 {setObjectCommands} {
set result [catch {dom setObjectCommands foobar} errMsg]
lappend result $errMsg
} {1 {bad mode value "foobar": must be automatic, command, or token}}
test dom-9.4 {setObjectCommands} {
set nrOfCmds [llength [info commands]]
dom setObjectCommands automatic
set docNode [dom createDocumentNode]
set result [expr {$nrOfCmds + 1 == [llength [info commands]]}]
$docNode delete
lappend result [expr {$nrOfCmds == [llength [info commands]]}]
dom setObjectCommands token
set docNode [dom createDocumentNode]
lappend result [expr {$nrOfCmds == [llength [info commands]]}]
lappend result [domDoc $docNode hasChildNodes]
domDoc $docNode delete
lappend result [expr {$nrOfCmds == [llength [info commands]]}]
# switch back to default
dom setObjectCommands automatic
set result
} {1 1 1 0 1}
test dom-9.5 {setObjectCommands} {
dom setObjectCommands token
set nrOfCmds [llength [info commands]]
set doc [dom parse <root><child1/><child2/></root>]
set root [domDoc $doc documentElement]
set result [expr {$nrOfCmds == [llength [info commands]]}]
dom setObjectCommands command
set docCmd [domNode $root ownerDocument]
lappend result [expr {$nrOfCmds + 1 == [llength [info commands]]}]
$docCmd delete
dom setObjectCommands automatic
set result
} {1 1}
test dom-9.6 {node token with result var argument} {
dom setObjectCommands token
set doc [dom parse <root><child1/><child2/></root>]
domDoc $doc documentElement var
domNode $var firstChild var
domNode $var nextSibling var
domDoc $doc delete
dom setObjectCommands automatic
} {automatic}
test dom-9.7 {Attempt to use the token to an already freed node} {
dom setObjectCommands token
set doc [dom createDocument one]
set top [domDoc $doc documentElement]
set elem [domDoc $doc createElement one]
domNode $elem delete
set result [catch {domNode $elem asList} errMsg]
lappend result $errMsg
domDoc $doc delete
dom setObjectCommands automatic
set result
} {1 {Parameter "" is not a domNode.}}
catch {namespace delete nodeCmds}
namespace eval nodeCmds {
dom createNodeCmd elementNode e1
dom createNodeCmd elementNode e2
dom createNodeCmd commentNode c
dom createNodeCmd textNode t
dom createNodeCmd cdataNode cdata
dom createNodeCmd piNode pi
dom createNodeCmd parserNode parser
dom createNodeCmd -tagName foo elementNode bar
}
test dom-10.1 {createNodeCmd} {
llength [info commands nodeCmds::*]
} {8}
namespace eval nodeCmds {
rename e1 {}
rename e2 {}
rename c {}
rename t {}
rename cdata {}
rename pi {}
rename parser {}
rename bar {}
}
test dom-10.2 {createNodeCmd} {
llength [info commands nodeCmds::*]
} {0}
namespace eval nodeCmds {
dom createNodeCmd elementNode e1
dom createNodeCmd textNode t
}
test dom-10.3 {node creating command called outside domNode context} {
set result [catch {nodeCmds::t "some text"} errMsg]
lappend result $errMsg
} {1 {called outside domNode context}}
test dom-10.4 {node creating command called outside domNode context} {
dom createDocument docRoot doc
$doc documentElement root
$root appendFromScript {
nodeCmds::t "Some text"
}
set result [list [$doc asXML -indent none]]
$doc delete
lappend result [catch {nodeCmds::t "Some text"} errMsg]
lappend result $errMsg
} {{<docRoot>Some text</docRoot>} 1 {called outside domNode context}}
test dom-10.5 {node creating command called outside domNode context} {
dom createDocument docRoot doc
$doc documentElement root
$root appendFromScript {
nodeCmds::e1 {
nodeCmds::t "Some text"
}
}
set result [list [$doc asXML -indent none]]
$doc delete
lappend result [catch {
nodeCmds::e1 {
nodeCmds::t "Some text"
}} errMsg]
lappend result $errMsg
} {{<docRoot><e1>Some text</e1></docRoot>} 1 {called outside domNode context}}
namespace eval nodeCmds {
dom createNodeCmd -tagName foo elementNode bar
}
test dom-10.6 {createNodeCmd - option -tagName} {
set doc [dom createDocumentNode]
$doc appendFromScript {
nodeCmds::bar {}
}
set result [$doc asXML -indent none]
$doc delete
set result
} {<foo/>}
namespace delete nodeCmds
test dom-11.1 {featureinfo - expatversion} -body {
dom featureinfo expatversion
} -match regexp -result {expat_.*}
test dom-11.2 {featureinfo - invalid arg} -body {
catch {dom featureinfo foo} errMsg
} -result 1
test dom-11.3 {featureinfo - expatmajorversion} -body {
dom featureinfo expatmajorversion
} -match regexp -result {(1|2)}
test dom-11.4 {featureinfo - dtd} -body {
dom featureinfo dtd
} -match regexp -result {(0|1)}
test dom-11.5 {featureinfo - jsonmaxnesting} {
dom featureinfo jsonmaxnesting
} 2000
test dom-11.6 {featureinfo - versionhash} {
regexp {^[0-9a-fA-F]+$} [dom featureinfo versionhash]
} 1
proc ::dom::domParseFeedback {} {
return -code break
}
test dom-12.1 {-feedbackAfter -- cmd returns TCL_BREAK} -body {
dom parse -feedbackAfter 1 {<doc><e1/><e1/><e1/></doc>}
} -result ""
proc ::dom::domParseFeedback {} {
error "Error in feedback cmd."
}
test dom-12.2 {-feedbackAfter -- cmd returns TCL_ERROR} -body {
set result [catch {
dom parse -feedbackAfter 1 {<doc><e1/><e1/><e1/></doc>}
} msg]
list $result $msg
} -result [list 1 "Error in feedback cmd."]
proc ::dom::domParseFeedback {} {
# Update progess dialog, check for cancel etc.
return
}
test dom-12.3 {-feedbackAfter} -body {
set doc [dom parse -feedbackAfter 1 {<doc><e1/><e1/><e1/></doc>}]
$doc selectNodes count(//*)
} -result 4
test dom-12.4 {-feedbackAfter and -channel} -setup {
set xmlFile [makeFile {<doc><e1/><e1/><e1/></doc>} dom.xml]
} -body {
set fd [open $xmlFile]
set doc [dom parse -channel $fd -feedbackAfter 1]
close $fd
$doc selectNodes count(//*)
} -cleanup {
removeFile dom.xml
} -result 4
proc extRefResolver-12.5 {base systemId publicId} {
switch $publicId {
"a" {
set data "<e1/>"
}
"b" {
set data "<e1/><e1/>"
}
default {
error "unknown public ID"
}
}
return [list "string" $base $data]
}
test dom-12.5 {-feedbackAfter and external entities} -body {
set doc [dom parse -externalentitycommand extRefResolver-12.5 \
-feedbackAfter 1 {
<!DOCTYPE doc [
<!ENTITY a PUBLIC "a" "a.xml">
<!ENTITY b PUBLIC "b" "b.xml">
]>
<doc>&a;&b;</doc>}]
$doc selectNodes count(//*)
} -result 4
set cancel 0
proc extRefResolver-12.6 {base systemId publicId} {
global cancel
switch $publicId {
"a" {
set cancel 1
set data "<e1/><e1/>"
}
"b" {
set data "<e1/>"
}
default {
error "unknown public ID"
}
}
return [list "string" $base $data]
}
proc ::dom::domParseFeedback {} {
global cancel
if {$cancel} {
return -code break
}
}
test dom-12.6 {-feedbackAfter and external entities, with cancel} -body {
dom parse -externalentitycommand extRefResolver-12.6 \
-feedbackAfter 1 {
<!DOCTYPE doc [
<!ENTITY a PUBLIC "a" "a.xml">
<!ENTITY b PUBLIC "b" "b.xml">
]>
<doc>&a;&b;</doc>}
} -result ""
proc ::dom::domParseFeedback {} {
global cancel
if {$cancel} {
error "Error in feedback cmd."
}
}
test dom-12.7 {-feedbackAfter and external entities, with error} -body {
set result [catch {dom parse -externalentitycommand extRefResolver-12.6 \
-feedbackAfter 1 {
<!DOCTYPE doc [
<!ENTITY a PUBLIC "a" "a.xml">
<!ENTITY b PUBLIC "b" "b.xml">
]>
<doc>&a;&b;</doc>}} msg]
list $result $msg
} -result [list 1 "Error in feedback cmd."]
test dom-12.8 {-feedbackAfter without -feedbackcmd} -setup {
catch {rename ::dom::domParseFeedback ""}
} -body {
set result [catch {dom parse -feedbackAfter 100 <doc/>} msg]
list $result $msg
} -result {1 {If -feedbackAfter is used, -feedbackcmd must also be used.}}
proc feedbackcmd-12.9 {} {
return -code break
}
test dom-12.9 {-feedbackAfter with -feedbackcmd -- cmd returns TCL_BREAK} -body {
dom parse -feedbackAfter 1 -feedbackcmd feedbackcmd-12.9 \
{<doc><e1/><e1/><e1/></doc>}
} -result ""
proc feedbackcmd-12.10 {} {
error "Error in feedback cmd."
}
test dom-12.10 {-feedbackAfter with -feedbackcmd -- cmd returns TCL_ERROR} -body {
set result [catch {
dom parse -feedbackAfter 1 -feedbackcmd feedbackcmd-12.10 \
{<doc><e1/><e1/><e1/></doc>}
} msg]
list $result $msg
} -result [list 1 "Error in feedback cmd."]
proc feedbackcmd-12.11 {} {
# Update progess dialog, check for cancel etc.
return
}
test dom-12.11 {-feedbackAfter with -feedbackcmd} -body {
set doc [dom parse -feedbackAfter 1 -feedbackcmd feedbackcmd-12.11 \
{<doc><e1/><e1/><e1/></doc>}]
$doc selectNodes count(//*)
} -result 4
test dom-12.12 {-feedbackAfter with -feedbackcmd and -channel} -setup {
set xmlFile [makeFile {<doc><e1/><e1/><e1/></doc>} dom.xml]
} -body {
set fd [open $xmlFile]
set doc [dom parse -channel $fd -feedbackAfter 1 \
-feedbackcmd feedbackcmd-12.11]
close $fd
$doc selectNodes count(//*)
} -cleanup {
removeFile dom.xml
} -result 4
test dom-12.13 {-feedbackAfter with -feedbackcmd and external entities} -body {
set doc [dom parse -externalentitycommand extRefResolver-12.5 \
-feedbackcmd feedbackcmd-12.11 \
-feedbackAfter 1 {
<!DOCTYPE doc [
<!ENTITY a PUBLIC "a" "a.xml">
<!ENTITY b PUBLIC "b" "b.xml">
]>
<doc>&a;&b;</doc>}]
$doc selectNodes count(//*)
} -result 4
set cancel 0
proc feedbackcmd-12.14 {} {
global cancel
if {$cancel} {
return -code break
}
}
test dom-12.14 {-feedbackAfter with -feedbackcmd and external entities, with cancel} -body {
dom parse -externalentitycommand extRefResolver-12.6 \
-feedbackcmd feedbackcmd-12.14 \
-feedbackAfter 1 {
<!DOCTYPE doc [
<!ENTITY a PUBLIC "a" "a.xml">
<!ENTITY b PUBLIC "b" "b.xml">
]>
<doc>&a;&b;</doc>}
} -result ""
set cancel 0
proc feedbackcmd-12.15 {} {
global cancel
if {$cancel} {
error "Error in feedback cmd."
}
}
test dom-12.15 {-feedbackAfter with -feedbackcmd and external entities, with error} -body {
set result [catch {dom parse -externalentitycommand extRefResolver-12.6 \
-feedbackcmd feedbackcmd-12.15 \
-feedbackAfter 1 {
<!DOCTYPE doc [
<!ENTITY a PUBLIC "a" "a.xml">
<!ENTITY b PUBLIC "b" "b.xml">
]>
<doc>&a;&b;</doc>}} msg]
list $result $msg
} -result [list 1 "Error in feedback cmd."]
proc feedbackcmd-12.16 {} {
incr ::feedbackcmd-12.16
}
test dom-12.16 {-feedbackcmd setting interp result w/ invalid XML} -body {
set ::feedbackcmd-12.16 0
set result [catch {dom parse -feedbackcmd feedbackcmd-12.16 \
-feedbackAfter 1 {<doc><e1/><e1/><e1></doc}} msg]
list $result $msg
} -result [list 1 {error "unclosed token" at line 1 character 19
"<doc><e1/><e1/><e1>< <--Error-- /doc"}]
# cleanup
::tcltest::cleanupTests
return