# Features covered: domNode command and nodeObj commands # # This file contains a collection of tests for the two interfaces to # DOM nodes, the token interface (the domNode command) and the tcl # command interface ([$nodeObj method ...]). # # domNode-1.*: domNode command syntax # domNode-3.*: documentElement # domNode-4.*: setAttributeNS # domNode-5.*: removeChild # domNode-6.*: appendChild # domNode-7.*: getElementsByTagName # domNode-8.*: getElementsByTagNameNS # domNode-9.*: nodeValue # domNode-10.*: setAttribute, again setAttributeNS # domNode-11.*: disableOutputEscaping # domNode-12.*: cloneNode # domNode-13.*: appendFromScript # domNode-14.*: appendFromList # domNode-15.*: delete # domNode-16.*: getAttribute # domNode-17.*: nodeType # domNode-18.*: attributes # domNode-19.*: removeAttribute, removeAttributeNS # domNode-20.*: parentNode # domNode-21.*: hasChildNodes # domNode-22.*: localName, prefix # domNode-23.*: replaceChild # domNode-24.*: getLine, getColumn # domNode-25.*: hasAttribute, hasAttributeNS # domNode-26.*: appendXML # domNode-27.*: target, data # domNode-28.*: getAttributeNS # domNode-29.*: ownerDocument # domNode-30.*: precedes # domNode-31.*: insertBefore # domNode-32.*: asText # domNode-33.*: insertBeforeFromScript # domNode-34.*: getBaseURI # domNode-35.*: objCmd traces # domNode-36.*: nodeName # domNode-37.*: baseURI # domNode-999.* Misc Tests # # Copyright (c) 2002, 2003, 2004 Rolf Ade. # # RCS: @(#) $Id: domNode.test,v 1.2 2004/07/28 03:41:12 rolf Exp $ source [file join [file dir [info script]] loadtdom.tcl] test domNode-1.1 {to less arguments to domNode command} { set doc [dom createDocument "root"] set root [$doc documentElement] set result [catch {$root}] $doc delete set result } {1} test domNode-1.2 {to less arguments to domNode command} { set doc [dom createDocument "root"] set root [$doc documentElement] set result [catch {domNode $root}] $doc delete set result } {1} test domNode-1.3 {to less arguments to domNode command} { catch {domNode} } {1} test domNode-1.4 {rename of domNodeObj cmd} {knownBug} { set doc [dom createDocument "root"] set root [$doc documentElement] rename $root my_domNode set result [llength [info commands my_domNode]] $doc delete lappend result [llength [info commands my_domNode]] catch {my_domNode nodeName} errMsg lappend result $errMsg } {1 0} test domNode-3.1 {repetitived documentElement with objVar, then delete} { dom createDocument "root" doc $doc documentElement root $doc delete dom createDocument "\u00c4\u00d4\u00dc" doc $doc documentElement root set result [$root nodeName] $doc delete set result } "\u00c4\u00d4\u00dc" test domNode-3.2 {repetitived documentElement, then delete} { set doc [dom createDocument "root"] $doc documentElement root $doc delete set doc [dom createDocument "\u00c4\u00d4\u00dc"] $doc documentElement root set result [$root nodeName] $doc delete set result } "\u00c4\u00d4\u00dc" test domNode-3.3 {repetitived documentElement, then delete} { set doc [dom createDocument "root"] set root [$doc documentElement] $doc delete set doc [dom createDocument "\u00c4\u00d4\u00dc"] set root [$doc documentElement] set result [$root nodeName] $doc delete set result } "\u00c4\u00d4\u00dc" test domNode-4.1 {create nodes with same prefix, different uri's} { dom createDocumentNS "uri1" "p:a" doc set root [$doc documentElement] set node1 [$doc createElementNS "uri2" "p:b"] $root appendChild $node1 set node2 [$doc createElementNS "uri1" "p:c"] $node1 appendChild $node2 set result [$root asXML] $doc delete set result } { } test domNode-4.3 {setAttribute} { dom createDocumentNS "uri1" "p:root" doc set root [$doc documentElement] $root setAttribute attr1 attr1Value set result [$root asXML] $doc delete set result } { } test domNode-4.5 {setAttributeNS} { dom createDocument "root" doc set root [$doc documentElement] $root setAttributeNS "" xmlns:p uri $root setAttributeNS uri p:attr attrValue set result [$root asXML] $doc delete set result } { } test domNode-4.6 {setAttributeNS} { dom createDocument "root" doc set root [$doc documentElement] $root setAttributeNS uri p:attr attrValue $root setAttributeNS "" xmlns:p uri set result [$root asXML] $doc delete set result } { } test domNode-4.7 {setAttributeNS} { dom createDocument "root" doc set root [$doc documentElement] $root setAttributeNS uri p:attr1 attrValue set result [$root getAttributeNS uri attr1] $doc delete set result } {attrValue} test domNode-4.8 {setAttributeNS} { dom createDocument "root" doc set root [$doc documentElement] $root setAttributeNS "" xmlns:p uri $root setAttributeNS uri p:attr1 attrValue set result [$root getAttributeNS uri attr1] $doc delete set result } {attrValue} test domNode-4.9 {setAttributeNS} { dom createDocument "root" doc set root [$doc documentElement] $root setAttributeNS uri p:attr1 attrValue set result [$root attributes *] $doc delete set result } {{attr1 p uri}} test domNode-4.10 {setAttributeNS} { dom createDocument "root" doc set root [$doc documentElement] set result [catch {$root setAttributeNS {} p:attr1 attrValue}] $doc delete set result } {1} test domNode-4.11 {setAttributeNS} { dom createDocument "root" doc set root [$doc documentElement] set result [catch {$root setAttributeNS uri attr1 attrValue}] $doc delete set result } {1} test domNode-4.12 {setAttributeNS - special prefix "xml"} { dom createDocument "root" doc set root [$doc documentElement] $root setAttributeNS "" xml:attr1 attrValue set result [$root attributes *] $doc delete set result } {{attr1 xml http://www.w3.org/XML/1998/namespace}} test domNode-4.13 {setAttributeNS} { dom createDocument "root" doc set root [$doc documentElement] $root setAttributeNS uri p:attr1 attrValue $root setAttributeNS uri o:attr1 newValue set result [$root attributes *] $doc delete set result } {{attr1 p uri}} test domNode-4.14 {setAttributeNS} { dom createDocument "root" doc set root [$doc documentElement] $root setAttributeNS uri p:attr1 attrValue $root setAttributeNS uri o:attr1 newValue set result [$root getAttributeNS uri attr1] $doc delete set result } {newValue} test domNode-4.15 {setAttributeNS - use as setAttribute} { dom createDocument "root" doc set root [$doc documentElement] $root setAttributeNS "" attr1 attrValue set result [$root attributes *] $doc delete set result } {attr1} test domNode-4.16 {setAttributeNS - set multiple Attributes at once} { set doc [dom createDocumentNS uri1 "p1:root"] set root [$doc documentElement] $root setAttributeNS "" xmlns:p2 uri2 $root setAttributeNS uri1 p1:a1 1 uri1 p1:a2 2 uri2 p2:a3 3 "" a4 4 set result [$root asXML] $doc delete set result } { } test domNode-5.1 {removeChild} { dom parse {} doc $doc documentElement root $root removeChild [$root firstChild] set result [$doc asXML -indent none] $doc delete set result } {} test domNode-5.2 {removeChild - child to remove is not a child of node} { dom parse {} doc $doc documentElement root set one [$root firstChild] set two [$root lastChild] set result [catch {$one removeChild $two} errMsg] lappend result $errMsg $doc delete set result } {1 NOT_FOUND_ERR} test domNode-5.3 {removeChild - child to remove is not a child of node} { dom parse {} doc $doc documentElement root set newNode [$doc createElement new] set result [catch {$root removeChild $newNode} errMsg] lappend result $errMsg $doc delete set result } {1 NOT_FOUND_ERR} test domNode-6.1 {appendChild insert FQ Element} { set doc [dom parse {}] set root [$doc documentElement] set newNode [$doc createElementNS uri2 p:foo] $root appendChild $newNode set result [$root asXML] $doc delete set result } { } test domNode-6.2 {appendChild} { set doc [dom createDocument XMI] set root [$doc documentElement] set A1tag [$doc createElement "A1"] set A2subtag [$doc createElement "A2sub"] set A2tag [$doc createElement "A2"] $A2tag appendChild $A2subtag set Atag [$doc createElement "A"] $Atag appendChild $A1tag $Atag appendChild $A2tag set Btag [$doc createElement "B"] $Btag appendChild $Atag set Ctag [$doc createElement "C"] set result 0 if {$root == "[$doc documentElement]"} {set result 1} $doc delete set result } {1} test domNode-6.3 {appendChild} { dom parse {} doc $doc documentElement root $root appendChild [$root firstChild] set result [$doc asXML -indent none] $doc delete set result } {} test domNode-6.4 {appendChild} { dom parse {} doc $doc documentElement root $root appendChild [$root lastChild] set result [$doc asXML -indent none] $doc delete set result } {} test domNode-6.5 {appendChild} { dom parse {} doc $doc documentElement root $root appendChild [lindex [$root childNodes] 1] set result [$doc asXML -indent none] $doc delete set result } {} test domNode-6.6 {appendChild} { dom parse {} doc $doc documentElement root set node [$root appendChild [$root firstChild]] catch {unset result} lappend result [[$node parentNode] nodeName] while {$node != ""} { lappend result [$node nodeName] set node [$node previousSibling] } $doc delete set result } {root one three two} test domNode-6.7 {appendChild} { dom parse {} doc $doc documentElement root set node [$root appendChild [$root lastChild]] catch {unset result} lappend result [[$node parentNode] nodeName] while {$node != ""} { lappend result [$node nodeName] set node [$node previousSibling] } $doc delete set result } {root three two one} test domNode-6.8 {appendChild} { dom parse {} doc $doc documentElement root set node [$root appendChild [lindex [$root childNodes] 1]] catch {unset result} lappend result [[$node parentNode] nodeName] while {$node != ""} { lappend result [$node nodeName] set node [$node previousSibling] } $doc delete set result } {root two three one} test domNode-6.9 {appendChild} { dom parse {} doc $doc documentElement root $root appendChild [$root firstChild] catch {unset result} set node [$root firstChild] while {$node != ""} { lappend result [$node nodeName] set node [$node nextSibling] } $doc delete set result } {two three one} test domNode-6.10 {appendChild} { dom parse {} doc $doc documentElement root $root appendChild [$root lastChild] catch {unset result} set node [$root firstChild] while {$node != ""} { lappend result [$node nodeName] set node [$node nextSibling] } $doc delete set result } {one two three} test domNode-6.11 {appendChild} { dom parse {} doc $doc documentElement root $root appendChild [lindex [$root childNodes] 1] catch {unset result} set node [$root firstChild] while {$node != ""} { lappend result [$node nodeName] set node [$node nextSibling] } $doc delete set result } {one three two} test domNode-6.12 {appendChild} { dom parse {} doc $doc documentElement root set one [$root firstChild] $one appendChild [$root lastChild] set result [$doc asXML -indent none] $doc delete set result } {} test domNode-6.13 {appendChild} { dom parse {} doc $doc documentElement root set one [$root firstChild] set result [catch {$one appendChild $root} errMsg] lappend result $errMsg $doc delete set result } {1 HIERARCHY_REQUEST_ERR} test domNode-6.14 {appendChild} { dom parse {} doc $doc documentElement root set one [$root firstChild] set result [catch {$one appendChild $one} errMsg] lappend result $errMsg $doc delete set result } {1 HIERARCHY_REQUEST_ERR} test domNode-6.15 {appendChild} -setup { set fileList {} foreach {name content} { a "..." b "..." } { lappend fileList [makeFile $content $name] } } -body { set docs {} foreach rf $fileList { set doc [dom parse -baseurl [tDOM::baseURL $rf] \ -externalentitycommand ::tDOM::extRefHandler \ -keepEmpties \ [tDOM::xmlReadFile $rf] ] lappend docs $doc } set resultDoc [dom createDocument new_report] set root [$resultDoc documentElement] foreach doc $docs { $root appendChild [$doc documentElement] } set result [$resultDoc asXML -indent none] foreach doc $docs { $doc delete } $resultDoc delete set result } -cleanup { removeFile a removeFile b } -result {......} set doc [dom parse {}] set root [$doc documentElement] test domNode-7.1 {getElementsByTagName - doc method} { llength [$doc getElementsByTagName a] } {2} test domNode-7.2 {getElementsByTagName - doc method} { llength [$doc getElementsByTagName c] } {1} test domNode-7.3 {getElementsByTagName - doc method} { llength [$doc getElementsByTagName foo] } {0} test domNode-7.4 {getElementsByTagName - node method} { llength [$root getElementsByTagName a] } {2} test domNode-7.5 {getElementsByTagName - node method} { llength [$root getElementsByTagName c] } {1} test domNode-7.6 {getElementsByTagName - node method} { llength [$root getElementsByTagName foo] } {0} test domNode-7.7 {getElementsByTagName - node method '*' wildcard} { llength [$root getElementsByTagName *] } {7} test domNode-7.8 {getElementsByTagName - doc method '*' wildcard} { llength [$doc getElementsByTagName *] } {8} test domNode-7.9 {getElementsByTagName - node method tcl glob style} { llength [$root getElementsByTagName foo*] } {2} test domNode-7.9 {getElementsByTagName - node method tcl glob style} { llength [$root getElementsByTagName *oo*] } {3} test domNode-7.10 {getElementsByTagName - doc method tcl glob style} { llength [$doc getElementsByTagName foo*] } {2} test domNode-7.11 {getElementsByTagName - doc method tcl glob style} { llength [$doc getElementsByTagName *oo*] } {4} test domNode-7.12 {getElementsByTagName - doc method empty result} { $doc getElementsByTagName noSuchANodeName } {} test domNode-7.13 {getElementsByTagName - node method empty result} { $root getElementsByTagName noSuchANodeName } {} test domNode-7.14 {getElementsByTagName - doc method: doc order of result} { set nodes [$doc getElementsByTagName *] set result "" foreach node $nodes { append result "[$node nodeName] " } set result } {root foobar barfoo foobaz a b a c } test domNode-7.15 {getElementsByTagName - node method: doc order of result} { set nodes [$root getElementsByTagName *] set result "" foreach node $nodes { append result "[$node nodeName] " } set result } {foobar barfoo foobaz a b a c } $doc delete set doc [dom parse { mixed content important more content again important }] set root [$doc documentElement] test domNode-7.16 {getElementsByTagName - node method mixed content} { llength [$doc getElementsByTagName elem] } {1} test domNode-7.17 {getElementsByTagName - node method mixed content} { llength [$root getElementsByTagName elem] } {1} test domNode-7.18 {getElementsByTagName - doc method mixed content} { llength [$doc getElementsByTagName b] } {3} test domNode-7.19 {getElementsByTagName - node method mixed content} { llength [$root getElementsByTagName b] } {3} test domNode-7.20 {getElementsByTagName - not a element node} { set textnode [$root selectNodes {descendant::text()[1]}] catch {$textnode getElementsByTagName b} errMsg set errMsg } {Node must be an element node.} $doc delete set doc [dom parse { IBM }] set root [$doc documentElement] test domNode-8.1 {getElementsByTagNameNS - root method} { [$root getElementsByTagNameNS "http://www.stock.org/stock" GetStockPrice] nodeName } {m:GetStockPrice} test domNode-8.2 {getElementsByTagNameNS - root method} { [$root getElementsByTagNameNS "*" GetStockPrice] nodeName } {m:GetStockPrice} test domNode-8.3 {getElementsByTagNameNS - root method} { llength [$root getElementsByTagNameNS "http://www.stock.org/stock" *] } {2} test domNode-8.4 {getElementsByTagNameNS - doc method} { [$doc getElementsByTagNameNS "http://www.stock.org/stock" GetStockPrice] nodeName } {m:GetStockPrice} test domNode-8.5 {getElementsByTagNameNS - doc method} { [$doc getElementsByTagNameNS "*" GetStockPrice] nodeName } {m:GetStockPrice} test domNode-8.6 {getElementsByTagNameNS - doc method} { llength [$doc getElementsByTagNameNS "http://www.stock.org/stock" *] } {2} $doc delete set doc [dom parse { mixed content important more content again important }] set root [$doc documentElement] test domNode-8.7 {getElementsByTagNameNS - doc method pathologic XML} { llength [$doc getElementsByTagNameNS "firstp" pathologic] } {2} test domNode-8.8 {getElementsByTagNameNS - doc method pathologic XML} { llength [$doc getElementsByTagNameNS "secondp" pathologic] } {1} test domNode-8.9 {getElementsByTagNameNS - doc method pathologic XML} { llength [$doc getElementsByTagNameNS "*" pathologic] } {3} test domNode-8.10 {getElementsByTagNameNS - node method pathologic XML} { llength [$root getElementsByTagNameNS "firstp" pathologic] } {2} test domNode-8.11 {getElementsByTagNameNS - node method pathologic XML} { llength [$root getElementsByTagNameNS "secondp" pathologic] } {1} test domNode-8.12 {getElementsByTagNameNS - node method pathologic XML} { llength [$root getElementsByTagNameNS "*" pathologic] } {3} test domNode-8.13 {getElementsByTagNameNS - doc method} { llength [$doc getElementsByTagNameNS "NS1" elem] } {1} test domNode-8.14 {getElementsByTagNameNS - doc method} { llength [$doc getElementsByTagNameNS "NS2" elem] } {1} test domNode-8.15 {getElementsByTagNameNS - doc method} { llength [$doc getElementsByTagNameNS "*" elem] } {3} test domNode-8.16 {getElementsByTagNameNS - node method} { llength [$root getElementsByTagNameNS "NS1" elem] } {1} test domNode-8.17 {getElementsByTagNameNS - node method} { llength [$root getElementsByTagNameNS "NS2" elem] } {1} test domNode-8.18 {getElementsByTagNameNS - node method} { llength [$root getElementsByTagNameNS "*" elem] } {3} test domNode-8.19 {getElementsByTagNameNS - doc method empty namespace} { set nodes [$doc getElementsByTagNameNS "" *] set result "" foreach node $nodes { append result "[$node nodeName] " } set result } {root elem b b } test domNode-8.19 {getElementsByTagNameNS - node method empty namespace} { set nodes [$root getElementsByTagNameNS "" *] set result "" foreach node $nodes { append result "[$node nodeName] " } set result } {elem b b } test domNode-8.20 {getElementsByTagNameNS - not a element node} { set textnode [$root selectNodes {descendant::text()[1]}] catch {$textnode getElementsByTagName b} errMsg set errMsg } {Node must be an element node.} $doc delete set doc [dom parse { }] set root [$doc documentElement] test domNode-8.21 {getElementsByTagNameNS - unset default NS} { set nodes [$root getElementsByTagNameNS "" *] set result "" foreach node $nodes { append result "[$node nodeName] " } set result } {elem1 elem3 } test domNode-8.22 {getElementsByTagName - unset default NS} { set nodes [$root getElementsByTagName *] set result "" foreach node $nodes { append result "[$node nodeName] " } set result } {elem1 elem2 elem3 } test domNode-8.23 {getElementsByTagNameNS - unset default NS} { set nodes [$root getElementsByTagNameNS * *] set result "" foreach node $nodes { append result "[$node nodeName] " } set result } {elem1 elem2 elem3 } test domNode-8.24 {getElementsByTagNameNS - unset default NS} { set nodes [$doc getElementsByTagNameNS * *] set result "" foreach node $nodes { append result "[$node nodeName] " } set result } {root elem1 elem2 elem3 } test domNode-8.25 {getElementsByTagNameNS - unset default NS} { set nodes [$root getElementsByTagNameNS "" *] set result "" foreach node $nodes { append result "[$node nodeName] " } set result } {elem1 elem3 } test domNode-8.26 {getElementsByTagNameNS - unset default NS} { set nodes [$doc getElementsByTagNameNS "" *] set result "" foreach node $nodes { append result "[$node nodeName] " } set result } {elem1 elem3 } $doc delete set doc [dom parse { text node}] set root [$doc documentElement] test domNode-9.1 {nodeValue - TEXT_NODE} { [$root firstChild] nodeValue } {text node} test domNode-9.2 {nodeValue - COMMENT_NODE} { set firstChild [$root firstChild] set commentNode [$firstChild nextSibling] $commentNode nodeValue } {comment node} test domNode-9.3 {nodeValue - PROCESSING_INSTRUCTION_NODE} { [$root lastChild] nodeValue } {PI node} test domNode-9.4 {nodeValue - CDATA_SECTION_NODE} { set cdNode [$doc createCDATASection "cdata section node"] $root appendChild $cdNode [$root lastChild] nodeValue } {cdata section node} test domNode-9.5 {nodeValue with set - TEXT_NODE} { set result [[$root firstChild] nodeValue "new text value"] append result "/" [[$root firstChild] nodeValue] } {text node/new text value} test domNode-9.6 {nodeValue with set - COMMENT_NODE} { set textNode [$root firstChild] set node [$textNode nextSibling] set result [$node nodeValue "new comment text"] append result "/" [$commentNode nodeValue] } {comment node/new comment text} test domNode-9.7 {nodeValue - PROCESSING_INSTRUCTION_NODE does not allow setting} { set piNode [$root selectNodes processing-instruction('mytarget')] catch {$piNode nodeValue "new pi value"} } {1} test domNode-9.8 {nodeValue - CDATA_SECTION_NODE} { set result [[$root lastChild] nodeValue "new text"] append result "/" [[$root lastChild] nodeValue] } {cdata section node/new text} $doc delete set doc [dom parse ] set root [$doc documentElement] test domNode-10.1 {setAttribute - set multiple attributes at once} { $root setAttribute a1 1 a2 2 a3 3 a4 4 a5 5 a6 6 a7 7 a8 8 $root asXML -indent none } {} $doc delete set doc [dom parse {&}] set root [$doc documentElement] set textnode [$root firstChild] test domNode-11.1 {disableOutputEscaping} { $textnode disableOutputEscaping } {0} test domNode-11.2 {disableOutputEscaping} { $textnode disableOutputEscaping 1 } {0} test domNode-11.3 {disableOutputEscaping} { $textnode disableOutputEscaping } {1} test domNode-11.4 {disableOutputEscaping} { $root asXML -indent none } {&} $doc delete test domNode-11.5 {disableOutputEscaping} { set doc [dom createDocument root] set textnode [$doc createTextNode "

some important text

"] $textnode disableOutputEscaping 1 set root [$doc documentElement] $root appendChild $textnode set result [$root asXML -indent none] $doc delete set result } {

some important text

} test domNode-11.6 {disableOutputEscaping} { set doc [dom createDocument root] set textnode [$doc createTextNode "

some important text

"] $textnode disableOutputEscaping 1 set root [$doc documentElement] $root appendChild $textnode set textnode [$doc createTextNode "&"] $root appendChild $textnode set result [$root asXML -indent none] $doc delete set result } {

some important text

&
} test domNode-11.7 {disableOutputEscaping} { set doc [dom createDocument root] set root [$doc documentElement] set textnode [$doc createTextNode "&"] $root appendChild $textnode set textnode [$doc createTextNode "

some important text

"] $textnode disableOutputEscaping 1 $root appendChild $textnode set result [$root asXML -indent none] $doc delete set result } {&

some important text

} test domNode-12.1 {cloneNode} { set doc [dom parse {}] set root [$doc documentElement] set newNode [$root cloneNode] $root appendChild $newNode set result [$root asXML -indent none] $doc delete set result } {} test domNode-12.2 {cloneNode} { set doc [dom parse {text}] set root [$doc documentElement] set newNode [$root cloneNode] $root appendChild $newNode set result [$root asXML -indent none] $doc delete set result } {text} test domNode-12.3 {cloneNode} { set doc [dom parse {text}] set root [$doc documentElement] set newNode [[$root firstChild] cloneNode] $root appendChild $newNode set result [$root asXML -indent none] $doc delete set result } {text} test domNode-12.4 {cloneNode} { set doc [dom parse {text}] set root [$doc documentElement] set newNode [[$root selectNodes {node()[2]}] cloneNode] $root appendChild $newNode set result [$root asXML -indent none] $doc delete set result } {texttext} test domNode-12.5 {cloneNode} { set doc [dom parse {text}] set root [$doc documentElement] set newNode [[$root selectNodes {node()[3]}] cloneNode] $root appendChild $newNode set result [$root asXML -indent none] $doc delete set result } {text} test domNode-12.5 {cloneNode} { set doc [dom parse {text}] set root [$doc documentElement] set newNode [[$root lastChild] cloneNode] $root appendChild $newNode set result [$root asXML -indent none] $doc delete set result } {text} test domNode-12.6 {cloneNode -deep} { set doc [dom parse {
text}] set root [$doc documentElement] set result [[[$root firstChild] cloneNode -deep] asXML -indent none] $doc delete set result } {text} test domNode-12.7 {cloneNode -deep} { set doc [dom parse {text}] set root [$doc documentElement] $root appendChild [[$root firstChild] cloneNode -deep] set result [$root asXML -indent none] $doc delete set result } {texttext} test domNode-12.8 {cloneNode -deep} { set doc [dom parse {text}] set root [$doc documentElement] set removedNode [$root removeChild [$root firstChild]] $root appendChild [[$root firstChild] cloneNode -deep] set result [$root asXML -indent none] $doc delete set result } {texttext} test domNode-12.9 {cloneNode -deep} { set doc [dom parse {text}] set root [$doc documentElement] set removedNode [$root removeChild [$root firstChild]] $root appendChild [[$root firstChild] cloneNode -deep] unset result lappend result [$removedNode nextSibling] lappend result [$removedNode previousSibling] $doc delete set result } {{} {}} test domNode-12.10 {cloneNode -deep} { set doc [dom parse {text}] set root [$doc documentElement] $root removeChild [$root firstChild] set removedNode [$root removeChild [$root firstChild]] $root appendChild [[$root firstChild] cloneNode -deep] unset result lappend result [[$removedNode nextSibling] nodeName] lappend result [$removedNode previousSibling] $doc delete set result } {y {}} 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 } test domNode-13.1 {appendFromScript - elementNode} { set doc [dom createDocument root] set root [$doc documentElement] $root appendFromScript nodeCmds::e1 set result [$root asXML -indent none] $doc delete set result } {} test domNode-13.2 {appendFromScript - elementNode} { set doc [dom createDocument root] set root [$doc documentElement] namespace eval nodeCmds { $root appendFromScript { e1 e2 } } set result [$root asXML -indent none] $doc delete set result } {} test domNode-13.3 {appendFromScript - elementNode} { set doc [dom createDocument root] set root [$doc documentElement] namespace eval nodeCmds { $root appendFromScript { e1 { e2 { e1 } } e2 } } set result [$root asXML -indent none] $doc delete set result } {} test domNode-13.4 {appendFromScript - elementNode with attributes as options} { set doc [dom createDocument root] set root [$doc documentElement] namespace eval nodeCmds { $root appendFromScript { e1 -attr1 attr1Value -attr2 "attr 2 Value" } } set result [$root asXML -indent none] $doc delete set result } {} test domNode-13.5 {appendFromScript - elementNode with attributes as list} { set doc [dom createDocument root] set root [$doc documentElement] set attlist [list -a1 "some & value" -a2 "another attvalue"] namespace eval nodeCmds { $root appendFromScript { e1 $attlist {} } } set result [$root asXML -indent none] $doc delete set result } {} test domNode-13.6 {appendFromScript - textnode, commentnode, cdatanode, pinode} { set doc [dom createDocument root] set root [$doc documentElement] namespace eval nodeCmds { $root appendFromScript { t foo c "my comment" cdata {&"<>;} ;# emacs: " pi mypi "some pi data" } } set result [$root asXML -indent none] $doc delete set result } {foo;]]>} # emacs: " test domNode-13.7 {appendFromScript - textnode} { set doc [dom createDocument root] set root [$doc documentElement] namespace eval nodeCmds { $root appendFromScript { t "

Some important stuff

" } } set result [$root asXML -indent none] $doc delete set result } {<p>Some <b>important</b> stuff</p>} test domNode-13.8 {appendFromScript - textnode with -disableOutputEscaping} { set doc [dom createDocument root] set root [$doc documentElement] namespace eval nodeCmds { $root appendFromScript { t -disableOutputEscaping "

Some important stuff

" } } set result [$root asXML -indent none] $doc delete set result } {

Some important stuff

} test domNode-13.9 {appendFromScript while fragment list isn't empty} { set doc [dom parse text] set root [$doc documentElement] $root removeChild [$root firstChild] $root appendFromScript { nodeCmds::t "another text" } set result [llength [$root childNodes]] $doc delete set result } {1} test domNode-13.10 {appendFromScript - tcl error inside the script} { set doc [dom createDocument root] set root [$doc documentElement] set result [catch {$root appendFromScript { nodeCmds::e1 nodeCmds::e1 { # This is intentionally wrong set foo 1 + 1 } }}] lappend result [$doc asXML -indent none] $doc delete set result } {1 } test domNode-13.11 {appendFromScript - tcl error inside the script} { set doc [dom parse ] set root [$doc documentElement] set result [catch {$root appendFromScript { nodeCmds::e1 { nodeCmds::e2 { t foo } nodeCmds::e2 -attr attrvalue { nodeCmds::e2 -attr1 attrvalue attr2 attrvalue { t bar } } } nodeCmds::e1 { # This is intentionally wrong set foo 1 + 1 } }}] lappend result [$doc asXML -indent none] $doc delete set result } {1 } test domNode-13.12 {appendFromScript - node isn't ELEMENT_NODE} { dom parse text doc $doc documentElement root $root firstChild textNode set result [catch {$textNode appendFromScript { nodeCmds::e1 }} errMsg] lappend result $errMsg lappend result [$doc asXML -indent none] $doc delete set result } {1 {NOT_AN_ELEMENT : can't append nodes} text} test domNode-13.13 {createNodeCmd elementNode with invalide tag name} { set result [catch {dom createNodeCmd elementNode \ [list invalid name]} errMsg] lappend result $errMsg } {1 {Invalid tag name 'invalid name'}} namespace eval nodeCmds::thisCmds { } test domNode-13.14 {qualified nodeCmd name} { namespace eval nodeCmds { dom createNodeCmd elementNode thisCmds::thisE } set result [llength [info commands nodeCmds::thisE]] lappend result [llength [info commands nodeCmds::thisCmds::thisE]] set doc [dom createDocument root] set root [$doc documentElement] namespace eval nodeCmds { $root appendFromScript { thisCmds::thisE } } lappend result [$doc asXML -indent none] $doc delete set result } {0 1 } set nsname "tricky nsname" namespace eval nodeCmds::$nsname { } test domNode-13.15 {qualified nodeCmds name} { namespace eval nodeCmds { dom createNodeCmd elementNode ${nsname}::thisE } set result [llength [info commands nodeCmds::thisE]] lappend result [llength [info commands nodeCmds::${nsname}::thisE]] set doc [dom createDocument root] set root [$doc documentElement] namespace eval nodeCmds { $root appendFromScript { ${nsname}::thisE } } lappend result [$doc asXML -indent none] $doc delete set result } {0 1 } test domNode-13.16 {Invalid attribute name} { set doc [dom createDocument root] set root [$doc documentElement] set result [catch { namespace eval nodeCmds { $root appendFromScript { e1 att1 att1Value "invalid attname" value {} } } } errMsg] lappend result $errMsg $doc delete set result } {1 {Invalid attribute name 'invalid attname'}} test domNode-13.17 {Invalid attribute value} { set doc [dom createDocument root] set root [$doc documentElement] set result [catch { namespace eval nodeCmds { $root appendFromScript { e1 att1 att1Value att2 "invalid \u0003 value" {} } } } errMsg] lappend result $errMsg $doc delete set result } [list 1 "Invalid attribute value 'invalid \u0003 value'"] dom setNameCheck 0 namespace eval nodeCmds { dom createNodeCmd elementNode e1 } dom setNameCheck 1 test domNode-13.18 {Invalid attribute name - check disabled} { set doc [dom createDocument root] set root [$doc documentElement] set result [catch { namespace eval nodeCmds { $root appendFromScript { e1 att1 att1Value "invalid attname" value {} } } }] $doc delete set result } {0} dom setTextCheck 0 namespace eval nodeCmds { dom createNodeCmd elementNode e1 } dom setTextCheck 1 test domNode-13.19 {Invalid attribute value - check disabled} { set doc [dom createDocument root] set root [$doc documentElement] set result [catch { namespace eval nodeCmds { $root appendFromScript { e1 att1 att1Value att2 "invalid \u0003 value" {} } } }] $doc delete set result } 0 dom setTextCheck 0 dom setNameCheck 0 namespace eval nodeCmds { dom createNodeCmd elementNode e1 } dom setTextCheck 1 dom setNameCheck 1 test domNode-13.20 {Invalid att name, invalid att value, checks disabled} { set doc [dom createDocument root] set root [$doc documentElement] set result [catch { namespace eval nodeCmds { $root appendFromScript { e1 att1 att1Value "invalid attName" "invalid \u0003 value" {} } } }] $doc delete set result } 0 namespace eval nodeCmds { dom createNodeCmd elementNode e1 } test domNode-13.21 {Invalid comment value} { set doc [dom createDocument root] set root [$doc documentElement] set result [catch { namespace eval nodeCmds { $root appendFromScript { c "invalid -- comment" } } } errMsg] lappend result $errMsg $doc delete set result } {1 {Invalid comment value 'invalid -- comment'}} test domNode-13.22 {Invalid CDATA section value} { set doc [dom createDocument root] set root [$doc documentElement] set result [catch { namespace eval nodeCmds { $root appendFromScript { cdata "invalid comment ]]>" } } } errMsg] lappend result $errMsg $doc delete set result } {1 {Invalid CDATA section value 'invalid comment ]]>'}} test domNode-13.23 {Invalid text node} { set doc [dom createDocument root] set root [$doc documentElement] set result [catch { namespace eval nodeCmds { $root appendFromScript { t "invalid text \u0004" } } } errMsg] lappend result $errMsg $doc delete set result } [list 1 "Invalid text value 'invalid text \u0004'"] test domNode-13.24 {Invalid processing instruction} { set doc [dom createDocument root] set root [$doc documentElement] set result [catch { namespace eval nodeCmds { $root appendFromScript { pi Xml "data" } } } errMsg] lappend result $errMsg $doc delete set result } [list 1 "Invalid processing instruction name 'Xml'"] test domNode-13.25 {Invalid processing instruction} { set doc [dom createDocument root] set root [$doc documentElement] set result [catch { namespace eval nodeCmds { $root appendFromScript { pi Xmll "data ?>" } } } errMsg] lappend result $errMsg $doc delete set result } [list 1 "Invalid processing instruction value 'data ?>'"] test domNode-14.1 {appendFromList} { set doc [dom createDocument root] set root [$doc documentElement] set errMsg "" set result [catch {$root appendFromList {a b}} errMsg] lappend result $errMsg $doc delete set result } {1 {invalid element node list format!}} test domNode-14.2 {appendFromList} { set doc [dom createDocument root] set root [$doc documentElement] set errMsg "" set result [catch {$root appendFromList {a b c}} errMsg] lappend result $errMsg $doc delete set result } {1 {invalid attributes list format!}} test domNode-14.3 {appendFromList} { set doc [dom createDocument root] set root [$doc documentElement] $root appendFromList {a {} {}} set result [$root asXML -indent none] $doc delete set result } {
} test domNode-14.4 {appendFromList} { set doc [dom createDocument root] set root [$doc documentElement] $root appendFromList {#text "foo bar"} set result [$root asXML -indent none] $doc delete set result } {foo bar} test domNode-14.5 {appendFromList} { set doc [dom parse {texttext}] set elm [$doc documentElement] set elmList [$elm asList] $doc delete set doc [dom createDocument root] set root [$doc documentElement] $root appendFromList $elmList set result [$root asXML -indent none] $doc delete set result } {texttext
} set doc [dom parse {text}] set docElem [$doc documentElement] test domNode-14.6 {asList of tree with comment nodes} { $docElem asList } [list elem {} [list [list \#comment " comment "] [list \#text text] [list child [list a v] [list [list \#comment comment]]]]] test domNode-14.7 {asList on a comment} { set commentNode [$docElem firstChild] $commentNode asList } [list \#comment " comment "] test domNode-14.8 {asList on a comment} { set commentNode [$docElem selectNodes {(//comment())[2]}] $commentNode asList } [list \#comment comment] test domNode-14.9 {appendFromList with comment nodes in the list} { set list [$docElem asList] set newDoc [dom createDocument newDoc] set newDocRoot [$newDoc documentElement] $newDocRoot appendFromList $list set result [$newDoc asXML -indent none] $newDoc delete set result } {text} $doc delete set doc [dom parse {text}] set docElem [$doc documentElement] test domNode->14.10 {asList of tree with PI nodes} { $docElem asList } [list elem {} [list [list \#pi myPI value] [list \#text text] [list child [list a v] [list [list \#pi myPI1 "the value"]]]]] test domNode->14.11 {asList on a PI} { set piNode [$docElem firstChild] $piNode asList } [list \#pi myPI value] test domNode->14.12 {asList on a PI} { set piNode [$docElem selectNodes {(//processing-instruction())[2]}] $piNode asList } [list \#pi myPI1 "the value"] test domNode-14.13 {appendFromList with comment node in the list} { set list [$docElem asList] set newDoc [dom createDocument newDoc] set newDocRoot [$newDoc documentElement] $newDocRoot appendFromList $list set result [$newDoc asXML -indent none] $newDoc delete set result } {text} $doc delete test domNode-14.14 {appendFromList - invalid tagname} { set doc [dom createDocument root] set root [$doc documentElement] set errMsg "" set result [catch {$root appendFromList {{invalid tagname} {} {}}} errMsg] lappend result $errMsg $doc delete set result } {1 {Invalid tag name 'invalid tagname'}} test domNode-14.15 {appendFromList - invalid processing instruction name} { set doc [dom createDocument root] set root [$doc documentElement] set errMsg "" set result [catch {$root appendFromList {\#pi "invalid pi name" piValue}} errMsg] lappend result $errMsg $doc delete set result } {1 {Invalid processing instruction name 'invalid pi name'}} set xml { text node text text text text } test domNode-15.1 {delete - text nodes} { set doc [dom parse $xml] set root [$doc documentElement] foreach node [$root selectNodes text()] { $node delete } set result [llength [$root childNodes]] $doc delete set result } {5} test domNode-15.2 {delete - comment nodes} { set doc [dom parse -keepEmpties $xml] set root [$doc documentElement] foreach node [$root selectNodes comment()] { $node delete } set result [llength [$root childNodes]] $doc delete set result } {6} test domNode-15.3 {delete - pi nodes} { set doc [dom parse -keepEmpties $xml] set root [$doc documentElement] foreach node [$root selectNodes processing-instruction()] { $node delete } set result [llength [$root childNodes]] $doc delete set result } {7} test domNode-15.4 {delete - pi nodes} { set doc [dom parse -keepEmpties $xml] set root [$doc documentElement] foreach node [$root selectNodes node()] { $node delete } set result [llength [$root childNodes]] $doc delete set result } {0} set doc [dom parse {}] set root [$doc documentElement] test domNode-16.1 {getAttribute} { $root getAttribute attr1 } {bingbaz} test domNode-16.2 {getAttribute} { $root getAttribute attr2 } {ab & zu} test domNode-16.3 {getAttribute} { $root getAttribute attr3 } {} test domNode-16.4 {getAttribute with default} { $root getAttribute attr1 "default not needed, because attr1 exists" } {bingbaz} test domNode-16.5 {getAttribute with default} { $root getAttribute notPresent "expect this given default value" } {expect this given default value} test domNode-16.6 {getAttribute - attr dosen't exists and no default} { catch {$root getAttribute notPresent} } {1} test domNode-16.7 {getAttribute shortcut} { $root @attr1 } {bingbaz} test domNode-16.8 {getAttribute shortcut} { $root @attr2 } {ab & zu} test domNode-16.9 {getAttribute shortcut} { $root @attr3 } {} test domNode-16.10 {getAttribute shortcut with default} { $root @attr1 "default not needed, because attr1 exists" } {bingbaz} test domNode-16.11 {getAttribute shortcut with default} { $root @notPresent "expect this given default value" } {expect this given default value} test domNode-16.12 {getAttribute shortcut - attr dosen't exists and no default} { catch {$root @notPresent} } {1} $doc delete # Yea, it's the same string as above. I just love to have the # data near by the tests, to reduce confusion and silly errors set xml { text node text text text text } set doc [dom parse -keepEmpties $xml] set root [$doc documentElement] test domNode-17.1 {nodeType} { unset result foreach node [$root childNodes] { lappend result [$node nodeType] } set result } {TEXT_NODE ELEMENT_NODE COMMENT_NODE TEXT_NODE ELEMENT_NODE COMMENT_NODE PROCESSING_INSTRUCTION_NODE TEXT_NODE} test domNode-17.2 {nodeType} { set CDATAnode [$doc createCDATASection "a CDATA section"] $root insertBefore $CDATAnode [$root firstChild] [$root firstChild] nodeType } {CDATA_SECTION_NODE} $doc delete set doc [dom parse { text child}] set root [$doc documentElement] test domNode-18.1 {attributes} { $root attributes } {{foo foo {}} attr1 attr2 attr3 {attr1 foo http://tdom.org/ns} worble2} test domNode-18.2 {attributes} { $root attributes * } {{foo foo {}} attr1 attr2 attr3 {attr1 foo http://tdom.org/ns} worble2} test domNode-18.3 {attributes} { $root attributes attr* } {attr1 attr2 attr3} test domNode-18.4 {attributes} { $root attributes *2* } {attr2 worble2} test domNode-18.5 {attributes} { $root attributes worble2 } {worble2} test domNode-18.6 {attributes} { $root attributes *brab* } {} test domNode-18.7 {attributes} { [$root firstChild] attributes } {} # Hmmm. This two following tests are mostly there to document the # behavior of the method, as it is. It may debatable if they should # behave this way. The optional attribute name pattern is a tDOM # DOM extension there is nothing in the rec, which could help to argue. # Therefore, it's the way, it is. test domNode-18.7 {attributes} { $root attributes *tdom* } {} test domNode-18.8 {attributes} { $root attributes foo* } {{attr1 foo http://tdom.org/ns}} # still the doc from befor 18.1 test domNode-19.1 {removeAttribute} { $root removeAttribute attr1 $root attributes attr1 } {} test domNode-19.2 {removeAttribute} { catch {$root removeAttribute attr1} errMsg set errMsg } {can't remove attribute 'attr1'} test domNode-19.3 {removeAttribute} { catch {$root removeAttribute} } {1} test domNode-19.4 {removeAttribute} { catch {$root removeAttribute attr2 attr3} } {1} test domNode-19.5 {removeAttributeNS} { $root removeAttributeNS http://tdom.org/ns attr1 $root hasAttributeNS http://tdom.org/ns attr1 } {0} test domNode-19.6 {removeAttributeNS} { catch {$root removeAttributeNS http://tdom.org attr1} } {1} $doc delete set doc [dom parse ] set root [$doc documentElement] test domNode-20.1 {parentNode} { $root parentNode } {} test domNode-20.2 {parentNode} { $root parentNode var set var } {} test domNode-20.3 {parentNode} { set child [$root firstChild] [$child parentNode] nodeName } {root} test domNode-20.4 {parentNode} { set child [$root firstChild] $root removeChild $child $child parentNode } {} $doc delete set doc [dom parse {text}] set root [$doc documentElement] test domNode-21.1 {hasChildNodes} { $root hasChildNodes } {1} test domNode-21.2 {hasChildNodes} { set node [$root firstChild] $node hasChildNodes } {0} test domNode-21.3 {hasChildNodes} { set node [$root lastChild] $node hasChildNodes } {1} $doc delete set doc [dom parse { text}] set root [$doc documentElement] test domNode-22.1 {localName} { $root localName } {} test domNode-22.2 {localName} { [$root firstChild] localName } {e1} test domNode-22.3 {localName} { set node [$root firstChild] [$node firstChild] localName } {e2} test domNode-22.4 {localName} { catch {[$root lastChild] localName} errMsg set errMsg } {} test domNode-22.5 {prefix} { [$root firstChild] prefix } {p1} test domNode-22.6 {prefix} { set node [$root firstChild] [$node firstChild] prefix } {} test domNode-22.7 {prefix} { $root prefix } {} $doc delete test domNode-23.1 {replaceChild} { set doc [dom parse {text}] set root [$doc documentElement] set removedNode [$root removeChild [$root firstChild]] $root replaceChild $removedNode [$root firstChild] set result [$root asXML -indent none] $doc delete set result } {} test domNode-23.2 {replaceChild} { set doc [dom parse {text}] set root [$doc documentElement] $root replaceChild [$root lastChild] [$root firstChild] set result [$root asXML -indent none] $doc delete set result } {text} test domNode-23.3 {replaceChild} { set doc [dom parse {text}] set root [$doc documentElement] set e1 [$root firstChild] set e2 [$root lastChild] $e2 replaceChild $e1 [$e2 firstChild] set result [$root asXML -indent none] $doc delete set result } {} test domNode-23.4 {replaceChild} { set doc [dom parse {}] set root [$doc documentElement] set childNodes [$root childNodes] for {set i 1} {$i < 4} {incr i} { $root removeChild [lindex $childNodes $i] } $root replaceChild [lindex $childNodes 1] [$root firstChild] set result [$root asXML -indent none] $doc delete set result } {} test domNode-23.5 {replaceChild} { set doc [dom parse {}] set root [$doc documentElement] set childNodes [$root childNodes] for {set i 1} {$i < 4} {incr i} { $root removeChild [lindex $childNodes $i] } $root replaceChild [lindex $childNodes 2] [$root firstChild] set result [$root asXML -indent none] $doc delete set result } {} test domNode-23.6 {replaceChild} { set doc [dom parse {}] set root [$doc documentElement] set childNodes [$root childNodes] for {set i 1} {$i < 4} {incr i} { $root removeChild [lindex $childNodes $i] } $root replaceChild [lindex $childNodes 3] [$root firstChild] set result [$root asXML -indent none] $doc delete set result } {} test domNode-23.7 {replaceChild} { set doc [dom parse {}] set root [$doc documentElement] set childNodes [$root childNodes] for {set i 1} {$i < 4} {incr i} { $root removeChild [lindex $childNodes $i] } foreach child $childNodes { $root replaceChild $child [$root firstChild] } set result [$root asXML -indent none] $doc delete set result } {} test domNode-24.1 {getLine} { set doc [dom parse ] set root [$doc documentElement] set result [catch {$root getLine}] $doc delete set result } {1} dom setStoreLineColumn 1 set doc [dom parse { }] set root [$doc documentElement] dom setStoreLineColumn 0 test domNode-24.2 {getLine} { $root getLine } {1} test domNode-24.3 {getColumn} { $root getColumn } {0} test domNode-24.4 {getLine} { [$root firstChild] getLine } {2} test domNode-24.5 {getLine getColumn} { set node [$root selectNodes //e2] set result [$node getLine].[$node getColumn] } {2.4} $doc delete set doc [dom parse { text child}] set root [$doc documentElement] test domNode-25.1 {hasAttribute} { $root hasAttribute attr3 } 1 test domNode-25.2 {hasAttribute} { $root hasAttribute attr4 } 0 test domNode-25.3 {hasAttributeNS} { $root hasAttributeNS http://tdom.org/ns attr1 } 1 test domNode-25.4 {hasAttributeNS} { $root hasAttributeNS http://tdom.org attr1 } 0 $doc delete test domNode-26.1 {appendXML} { set doc [dom createDocument root] set root [$doc documentElement] $root appendXML "text" set result [$root asXML -indent none] $doc delete set result } {text} test domNode-26.2 {appendXML} { set doc [dom parse ] set root [$doc documentElement] $root appendXML "text" set result [$root asXML -indent none] $doc delete set result } {text} set doc [dom parse { }] set root [$doc documentElement] test domNode-27.1 {target, data} { set piNode [$root selectNodes /processing-instruction()] set result [$piNode target].[$piNode data] } {piBeforeRoot.do this} test domNode-27.2 {target, data} { set piNodes [$root selectNodes processing-instruction()] set result "" foreach piNode $piNodes { set result "$result [$piNode target].[$piNode data]" } set result } { pi1.my & data pi2.data} $doc delete test domNode-28.1 {getAttributeNS} { set doc [dom parse { }] set root [$doc documentElement] set result [$root getAttributeNS "ns1" attr1] $doc delete set result } {p:attr1Value} proc domAppendChild {parent name} { $parent ownerDocument doc $doc createElement $name node $parent appendChild $node } test domNode-29.1 {ownerDocument} { dom createDocument document doc set root [$doc documentElement] domAppendChild $root foo1 domAppendChild $root foo2 set result [$doc asXML -indent none] $doc delete set result } {} set doc [dom parse {text}] set root [$doc documentElement] test domNode-30.1 {precedes} { catch {$root precedes} } {1} test domNode-30.2 {precedes} { set firstChild [$root firstChild] catch {$root start $firstChild foo} } {1} test domNode-30.3 {precedes} { set result [catch {$root precedes notaNode} errMsg] lappend result $errMsg } {1 {parameter not a domNode!}} test domNode-30.4 {precedes} { set firstChild [$root firstChild] $root precedes $firstChild } {1} test domNode-30.5 {precedes} { set firstChild [$root firstChild] $root precedes $firstChild } {1} test domNode-30.6 {precedes} { set firstChild [$root firstChild] $firstChild precedes $root } {0} test domNode-30.7 {precedes} { set firstChild [$root firstChild] $firstChild precedes $firstChild } {0} test domNode-30.8 {precedes} { set doc1 [dom parse ] set root1 [$doc1 documentElement] set result [catch {$root precedes $root1} errMsg] lappend result $errMsg $doc1 delete set result } {1 {Cannot compare the relative order of nodes out of different documents.}} test domNode-30.9 {precedes} { set firstChild [$root firstChild] set newNode [$doc createElement newNode] $root insertBefore $newNode $firstChild $newNode precedes $firstChild } {1} test domNode-30.10 {precedes} { set newNode [$doc createTextNode "new text node"] set result [catch {$root precedes $newNode} errMsg] lappend result $errMsg } {1 {Cannot compare the relative order of a node with a node out of the fragment list.}} $doc delete dom parse {} doc $doc documentElement root set e [$root selectNodes //e] set eee [$root selectNodes //eee] test domNode-30.11 {precedes} { $e precedes $eee } {1} test domNode-30.12 {precedes} { $eee precedes $e } {0} $doc delete test domNode-31.1 {insertBefore - syntax check} { set doc [dom parse ] set root [$doc documentElement] set result [catch {$root insertBefore}] $doc delete set result } {1} test domNode-31.2 {insertBefore - syntax check} { set doc [dom parse
] set root [$doc documentElement] set result [catch {$root insertBefore [$root firstChild]}] $doc delete set result } {1} test domNode-31.3 {insertBefore - tries to insert node as child of node} { set doc [dom parse
] set root [$doc documentElement] catch {$root insertBefore $root [$root lastChild]} errMsg $doc delete set errMsg } {HIERARCHY_REQUEST_ERR} test domNode-31.4 {insertBefore - refnode invalide} { set doc [dom parse ] set root [$doc documentElement] set newElement [$doc createElement new] catch {$root insertBefore $newElement $root} errMsg $doc delete set errMsg } {NOT_FOUND_ERR} # Prior to dom.c r1.63 insertBefore leaks the node to insert, if the refnode # isn't valid. test domNode-31.5 {insertBefore - refnode invalide} { set doc [dom parse ] set root [$doc documentElement] set oneChild [$root firstChild] set twoChild [$root lastChild] catch {$oneChild insertBefore [$oneChild firstChild] $root} errMsg set result [list $errMsg [llength [$oneChild childNodes]]] $doc delete set result } {NOT_FOUND_ERR 1} test domNode-31.6 {insertBefore - refnode and new node to insert are the same} { dom parse doc $doc documentElement root $root firstChild firstChild $root insertBefore $firstChild $firstChild set result [$doc asXML -indent none] $doc delete set result } {} test domNode-31.7 {insertBefore - insert a sibling of node} { dom parse {} doc set root [$doc documentElement] $root firstChild a $root lastChild b $a insertBefore $b [$a firstChild] set result [$doc asXML -indent none] $doc delete set result } {} test domNode-31.8 {insertBefore - new node is node} { dom parse doc $doc documentElement root $root firstChild firstChild catch {$root insertBefore $root $firstChild} errMsg $doc delete set errMsg } {HIERARCHY_REQUEST_ERR} test domNode-31.9 {insertBefore tries to insert a parent of node as child} { set doc [dom parse ] set root [$doc documentElement] $root firstChild a catch {$a insertBefore $root [$a firstChild]} errMsg $doc delete set errMsg } {HIERARCHY_REQUEST_ERR} test domNode-31.10 {insertBefore - node to insert is a sibling of ref node} { set doc [dom parse ] $doc documentElement root $root firstChild a $a insertBefore [$a lastChild] [$a firstChild] set result [$doc asXML -indent none] $doc delete set result } {} test domNode-31.11 {insertBefore - node to insert is a sibling of ref node} { set doc [dom parse ] $doc documentElement root $root firstChild a $a insertBefore [$a lastChild] [$a firstChild] catch {unset result} set node [$a firstChild] while {$node != ""} { lappend result [$node nodeName] set node [$node nextSibling] } $doc delete set result } {two one} test domNode-31.12 {insertBefore - node to insert is a sibling of ref node} { set doc [dom parse ] $doc documentElement root $root firstChild a $a insertBefore [$a lastChild] [$a firstChild] catch {unset result} set node [$a lastChild] while {$node != ""} { lappend result [$node nodeName] set node [$node previousSibling] } $doc delete set result } {one two} test domNode-31.13 {insertBefore - node to insert is a sibling of ref node} { set doc [dom parse ] $doc documentElement root $root firstChild a $a insertBefore [$a firstChild] [$a lastChild] set result [$doc asXML -indent none] $doc delete set result } {} test domNode-31.14 {insertBefore - node to insert is a sibling of ref node} { set doc [dom parse ] $doc documentElement root $root firstChild a $a insertBefore [$a firstChild] [$a lastChild] catch {unset result} set node [$a firstChild] while {$node != ""} { lappend result [$node nodeName] set node [$node nextSibling] } $doc delete set result } {one two} test domNode-31.15 {insertBefore - node to insert is a sibling of ref node} { set doc [dom parse ] $doc documentElement root $root firstChild a $a insertBefore [$a firstChild] [$a lastChild] catch {unset result} set node [$a lastChild] while {$node != ""} { lappend result [$node nodeName] set node [$node previousSibling] } $doc delete set result } {two one} test domNode-31.16 {insertBefore - empty ref node} { dom parse doc $doc documentElement root $doc createElement new newNode $root insertBefore $newNode "" set result [$doc asXML -indent none] $doc delete set result } {} test domNode-31.17 {insertBefore - empty ref node} { dom parse doc $doc documentElement root $doc createElement new newNode $root insertBefore $newNode "" set result [$doc asXML -indent none] $doc delete set result } {} test domNode-31.18 {insertBefore - try to insert the root node of the doc} { dom parse doc $doc documentElement root catch {$root insertBefore [$root selectNodes /] [$root firstChild]} errMsg $doc delete set errMsg } {HIERARCHY_REQUEST_ERR} test domNode-31.19 {insertBefore - empty ref node} { dom parse doc $doc documentElement root $root insertBefore [$root firstChild] "" set result [$doc asXML -indent none] $doc delete set result } {} test domNode-31.20 {insertBefore - empty ref node} { dom parse doc $doc documentElement root $root insertBefore [$root firstChild] "" catch {unset result} set node [$root firstChild] while {$node != ""} { lappend result [$node nodeName] set node [$node nextSibling] } $doc delete set result } {b c a} test domNode-31.21 {insertBefore - empty ref node} { dom parse doc $doc documentElement root $root insertBefore [$root firstChild] "" catch {unset result} set node [$root lastChild] while {$node != ""} { lappend result [$node nodeName] set node [$node previousSibling] } $doc delete set result } {a c b} test domNode-31.22 {insertBefore - empty ref node} { dom parse doc $doc documentElement root $root insertBefore [$root lastChild] "" set result [$doc asXML -indent none] $doc delete set result } {} test domNode-31.23 {insertBefore - empty ref node} { dom parse doc $doc documentElement root $root insertBefore [$root lastChild] "" catch {unset result} set node [$root firstChild] while {$node != ""} { lappend result [$node nodeName] set node [$node nextSibling] } $doc delete set result } {a b c} test domNode-31.24 {insertBefore - empty ref node} { dom parse doc $doc documentElement root $root insertBefore [$root lastChild] "" catch {unset result} set node [$root lastChild] while {$node != ""} { lappend result [$node nodeName] set node [$node previousSibling] } $doc delete set result } {c b a} test domNode-31.25 {insertBefore - empty ref node} { dom parse doc $doc documentElement root $root insertBefore [$root selectNodes {*[2]}] "" set result [$doc asXML -indent none] $doc delete set result } {} test domNode-31.26 {insertBefore - empty ref node} { dom parse doc $doc documentElement root $root insertBefore [$root selectNodes {*[2]}] "" catch {unset result} set node [$root firstChild] while {$node != ""} { lappend result [$node nodeName] set node [$node nextSibling] } $doc delete set result } {a c b} test domNode-31.27 {insertBefore - empty ref node} { dom parse doc $doc documentElement root $root insertBefore [$root selectNodes {*[2]}] "" catch {unset result} set node [$root lastChild] while {$node != ""} { lappend result [$node nodeName] set node [$node previousSibling] } $doc delete set result } {b c a} test domNode-31.28 {insertBefore - empty ref node} { dom parse doc $doc documentElement root $root firstChild a $root lastChild b $a insertBefore $b "" set result [$doc asXML -indent none] $doc delete set result } {} test domNode-31.29 {insertBefore - ref node is a node out of the fragment list} { dom parse {} doc $doc documentElement root set newNode [$doc createElement new] set result [catch {$root insertBefore [$root lastChild] $newNode} errMsg] lappend result $errMsg $doc delete set result } {1 NOT_FOUND_ERR} test domNode-31.30 {insertBefore - ref node not a node child, equal to new node} { dom parse {} doc $doc documentElement root set newNode [$doc createElement new] set result [catch {$root insertBefore $newNode $newNode} errMsg] lappend result $errMsg $doc delete set result } {1 NOT_FOUND_ERR} test domNode-32.1 {asText - syntax check} { dom parse doc $doc documentElement root set result [catch {$root asText foo}] $doc delete set result } {1} test domNode-32.2 {asText} { dom parse { pcdata foo bar grill } doc $doc documentElement root set result [$root asText] $doc delete set result } {pcdata foo bar grill} test domNode-32.3 {asText} { dom parse -keepEmpties \ {pcdata Hello, world!]]> more pcdata} doc $doc documentElement root set result [$root asText] $doc delete set result } {pcdata Hello, world! more pcdata} test domNode-32.4 {asText} { dom parse {pcdata} doc $doc documentElement root set newCDATAnode \ [$doc createCDATASection "Hello, world!"] $root appendChild $newCDATAnode set result [$root asText] $doc delete set result } {pcdata} set xml { some text } dom parse $xml doc $doc documentElement root test domNode-32.5 {asText} { $root asText } {some text} test domNode-32.6 {asText} { set result {} foreach child [$root childNodes] { lappend result [$child asText] } set result } {{some text} { A comment } {this is the testPI data }} $doc delete dom parse -keepEmpties $xml doc $doc documentElement root test domNode-32.7 {asText} { $root asText } { some text } $doc delete # The tests in domNode-33.* also uses the nodeCmds created for the # domNode-13.* tests. test domNode-33.1 {insertBeforeFromScript} { set doc [dom parse {}] $doc documentElement root $root insertBeforeFromScript { nodeCmds::e1 } [$root firstChild] set result [$doc asXML -indent none] $doc delete set result } {} test domNode-33.2 {insertBeforeFromScript} { set doc [dom parse {}] $doc documentElement root $root insertBeforeFromScript { nodeCmds::e1 } {} set result [$doc asXML -indent none] $doc delete set result } {} test domNode-33.3 {insertBeforeFromScript - error in the script} { set doc [dom parse {}] $doc documentElement root set result [catch {$root insertBeforeFromScript { nodeCmds::e1 nodeCmds::e1 { # This is intentionally wrong set foo 1 + 1 } } [$root firstChild]}] lappend result [$doc asXML -indent none] $doc delete set result } {1 } test domNode-33.4 {insertBeforeFromScript - insert more then one node} { set doc [dom parse {}] $doc documentElement root namespace eval nodeCmds { $root insertBeforeFromScript { e1 e2 { t new } e1 } [lindex [$root childNodes] 1] } set result [$doc asXML -indent none] $doc delete set result } {new} test domNode-33.5 {insertBeforeFromScript - insert more then one node} { set doc [dom parse {}] $doc documentElement root namespace eval nodeCmds { $root insertBeforeFromScript { e1 e2 { t new } e1 } [lindex [$root childNodes] 1] } set result "" foreach node [$root childNodes] { append result "[$node nodeName] " } $doc delete set result } {foo e1 e2 e1 bar grill } test domNode-33.6 {insertBeforeFromScript - insert more then one node} { set doc [dom parse {}] $doc documentElement root namespace eval nodeCmds { $root insertBeforeFromScript { e1 e2 { t new } e1 } [lindex [$root childNodes] 1] } set result "" set node [$root lastChild] while {$node != ""} { append result "[$node nodeName] " set node [$node previousSibling] } $doc delete set result } {grill bar e1 e2 e1 foo } test domNode-33.7 {insertBeforeFromScript - error in script} { set doc [dom parse {}] $doc documentElement root catch {namespace eval nodeCmds { $root insertBeforeFromScript { e1 e2 { t new } e1 this is wrong } [lindex [$root childNodes] 2] }} set result [$doc asXML -indent none] $doc delete set result } {} test domNode-33.8 {insertBeforeFromScript - wrong reference node} { set doc [dom parse {}] $doc documentElement root set result [catch {$root insertBeforeFromScript { nodeCmds::e1 } $root} errMsg] lappend result $errMsg $doc delete set result } {1 NOT_FOUND_ERR} test domNode-34.1 {getBaseURI} {need_uri} { makeFile domNode-34.1-e1.xml [file join [file dir [info script]] data] makeFile domNode-34.1-e2.xml [file join [file dir [info script]] data] set baseURI file://[file join [pwd] [file dir [info script]] dom.test] set doc [dom parse \ -baseurl $baseURI \ -externalentitycommand ::tDOM::extRefHandler { ]> &a; &b; }] $doc documentElement root set result 1 foreach child [$root childNodes] { lappend baseURIs [$child getBaseURI] } if {([lindex $baseURIs 0] == [lindex $baseURIs 1]) || ([lindex $baseURIs 0] == [lindex $baseURIs 2]) || ([lindex $baseURIs 1] == [lindex $baseURIs 2]) || ([lindex $baseURIs 2] != [$root getBaseURI])} { set result 0 } $doc delete set result } {1} test domNode-34.2 {getBaseURI} {need_uri} { makeFile domNode-34.1-e1.xml [file join [file dir [info script]] data] makeFile domNode-34.1-e2.xml [file join [file dir [info script]] data] set baseURI file://[file join [pwd] [file dir [info script]] dom.test] set doc [dom parse \ -baseurl $baseURI \ -externalentitycommand ::tDOM::extRefHandler { ]> &a; &b; }] $doc delete set doc [dom parse \ -baseurl $baseURI \ -externalentitycommand ::tDOM::extRefHandler { ]> &a; &b; }] $doc documentElement root set result 1 foreach child [$root childNodes] { lappend baseURIs [$child getBaseURI] } if {([lindex $baseURIs 0] == [lindex $baseURIs 1]) || ([lindex $baseURIs 0] == [lindex $baseURIs 2]) || ([lindex $baseURIs 1] == [lindex $baseURIs 2]) || ([lindex $baseURIs 2] != [$root getBaseURI])} { set result 0 } $doc delete set result } {1} proc 35.1 {doc} { $doc documentElement root } test domNode-35.1 {objCmd traces} { for {set x 0} {$x < 1} {incr x} { set doc [dom parse {}] $doc documentElement root 35.1 $doc $doc delete } } {} proc 35.2.2 {doc} { $doc documentElement root } proc 35.2.1 {doc} { $doc documentElement root 35.2.2 $doc return $root } # test domNode-35.2 {objCmd traces} { # set doc [dom parse {}] # set rootCmdName [35.2.1 $doc] # set result [info commands $rootCmdName] # $doc delete # set result # } {} proc 35.3.2 {doc} { $doc documentElement root $doc delete } proc 35.3.1 {doc} { $doc documentElement root 35.3.2 $doc return $root } test domNode-35.3 {objCmd traces} { set doc [dom parse {}] set rootCmdName [35.3.1 $doc] set result [info commands $rootCmdName] set result } {} test domNode-36.1 {nodeName} { set doc [dom parse ] set cdataNode [$doc createCDATASection foo] set result [$cdataNode nodeName] $doc delete set result } \#cdata-section test domNode-36.2 {nodeName} { set doc [dom parse ] set commentNode [$doc createComment foo] set result [$commentNode nodeName] $doc delete set result } \#comment test domNode-36.3 {nodeName} { set doc [dom parse ] set piNode [$doc createProcessingInstruction p "p value"] set result [$piNode nodeName] $doc delete set result } p proc 37.1 {base system public} { return [list string file://this/that \ "External general parsed entity. Text and elements at\ toplevel mixed and so on"] } test domNode-37.1 {baseURI} { set doc [dom parse \ -baseurl "file://foo" \ -externalentitycommand 37.1 -keepEmpties { ]> &a;}] set root [$doc documentElement] set result [$root baseURI] foreach node [$root childNodes] { lappend result [expr {"file://this/that" == [$node baseURI]}] } $doc delete set result } {file://foo 0 1 1 1 1 0} test domNode-37.2 {baseURI} { set doc [dom parse \ -baseurl "file://foo" \ -externalentitycommand 37.1 -keepEmpties { ]> &a;}] set root [$doc documentElement] $root insertBefore [$root lastChild] [$root firstChild] set result {} foreach node [$root childNodes] { lappend result [$node baseURI] } $doc delete set result } {file://foo file://this/that file://this/that file://this/that} test domNode-37.3 {baseURI} { set doc [dom parse \ -baseurl "file://foo" \ -externalentitycommand 37.1 -keepEmpties { ]> &a;}] set root [$doc documentElement] $root appendChild [$root firstChild] set result {} foreach node [$root childNodes] { lappend result [$node baseURI] } $doc delete set result } {file://this/that file://this/that file://this/that file://foo} proc 37.4 {base systemId publicId} { switch $systemId { "a.xml" { return [list string file://base/2 "&b;"] } "b.xml" { return [list string file://base/3 ""] } default { error "error in text script" } } } test domNode-37.4 {baseURI} { set doc [dom parse \ -baseurl "file://base/1" \ -externalentitycommand 37.4 { ]> &a;}] set root [$doc documentElement] set result [$root baseURI] set rootchild [$root firstChild] lappend result [$rootchild baseURI] set rootchildchild [$rootchild firstChild] lappend result [$rootchildchild baseURI] lappend result [[$rootchildchild firstChild] baseURI] lappend result [[$rootchildchild nextSibling] baseURI] lappend result [[$rootchild nextSibling] baseURI] $doc delete set result } {file://base/1 file://base/2 file://base/3 file://base/3 file://base/2 file://base/1} proc 37.5 {base systemId publicId} { switch $systemId { "a.xml" { return [list string file://base/2 "&b;"] } "b.xml" { return [list string file://base/3 ""] } default { error "error in text script" } } } test domNode-37.5 {baseURI} { set doc [dom parse \ -baseurl "file://base/1" \ -externalentitycommand 37.5 { ]> &a;}] set result {} set node [$doc documentElement] while {$node != ""} { lappend result [$node baseURI] set node [$node firstChild] } $doc delete set result } {file://base/1 file://base/1 file://base/1 file://base/2 file://base/2 file://base/3 file://base/3 file://base/3} proc 37.6 {base systemId publicId} { switch $systemId { "a.xml" { return [list string file://base/2 "text"] } default { error "error in text script" } } } test domNode-37.6 {baseURI} { set doc [dom parse \ -baseurl "file://base/1" \ -externalentitycommand 37.6 { ]> &a;}] set result {} set root [$doc documentElement] foreach child [$root childNodes] { lappend result [$child baseURI] } $doc delete set result } {file://base/2 file://base/2 file://base/2 file://base/1} proc 37.7 {base systemId publicId} { switch $systemId { "a.xml" { return [list string file://base/2 "text - base2"] } default { error "error in text script" } } } test domNode-37.7 {baseURI} { set doc [dom parse \ -baseurl "file://base/1" \ -externalentitycommand 37.7 { ]> &a;text - base 1}] set result {} set root [$doc documentElement] foreach child [$root childNodes] { lappend result [$child baseURI] } $doc delete set result } {file://base/2 file://base/2 file://base/2 file://base/1 file://base/1} test domNode-999.1 {move nodes from one doc to another} { set doc1 [dom parse {}] set doc2 [dom parse {text}] set root1 [$doc1 documentElement] set root2 [$doc2 documentElement] $root1 appendChild [$root2 firstChild] set textNode [[$root1 firstChild] firstChild] if {[$textNode ownerDocument] == $doc1} {set result 1} else {set result 0} $doc1 delete $doc2 delete set result } {1} test domNode-999.2 {node references should not change even after renumbering} { dom parse {} doc set root [$doc documentElement] set oldNode [lindex [$root childNodes] 1] dom parse {} tempDoc set tempNode [$tempDoc documentElement] $oldNode appendChild $tempNode set childList1 [$root childNodes] $root selectNodes {//child[@name='a']} set childList2 [$root childNodes] if {$childList1 == $childList2} { set result 1 } else { set result 0 } $doc delete $tempDoc delete set result } {1} # cleanup ::tcltest::cleanupTests return