1# Commands covered:  ::dom::document
2#
3# This file contains a collection of tests for one or more of the 
4# TclDOM commands.  Sourcing this file into Tcl runs the tests and
5# generates output for errors.  No output means no errors were found.
6#
7# Copyright (c) 1998-2002 Zveno Pty Ltd.
8#
9# $Id: document.test,v 1.8 2003/01/23 19:47:02 balls Exp $
10
11package require tcltest; namespace import -force ::tcltest::*
12source testutils.tcl
13testPackage dom
14
15set doc [::dom::DOMImplementation create]
16
17test document-1.1 {cget -doctype} -constraints {!dom_libxml2} -body {
18    ::dom::document cget $doc -doctype
19} -result {}
20test document-1.2 {cget -implementation} -constraints {dom_c} -body {
21    ::dom::document cget $doc -implementation
22} -result {::dom::DOMImplementation}
23test document-1.2 {cget -implementation} -constraints {dom_tcl} -body {
24    ::dom::document cget $doc -implementation
25} -result {::dom::tcl::DOMImplementation}
26test document-1.2 {cget -implementation} -constraints {dom_libxml2} -body {
27    ::dom::document cget $doc -implementation
28} -result {::dom::libxml2::DOMImplementation}
29test document-1.3 {cget -documentElement} -body {
30    ::dom::document cget $doc -documentElement
31} -result {}
32test document-1.4 {error: cget too few arguments} -body {
33    catch {::dom::document cget $doc}
34} -result 1
35test document-1.5 {error: cget too many arguments} -body {
36    catch {::dom::document cget $doc -foo bar}
37} -result 1
38test document-1.6 {error: cget unknown option} -body {
39    catch {::dom::document cget $doc -foo}
40} -result 1
41test document-1.7 {cget -version} -constraints {dom_tcl} -body {
42    ::dom::document cget $doc -version
43} -result 1.0
44
45test document-2.1 {configure} -body {
46    ::dom::document configure $doc -documentElement
47} -result {}
48test document-2.2 {error: configure read-only option} -body {
49    set result [catch {::dom::document configure $doc -documentElement $doc} msg]
50    list $result $msg
51} -result {1 {attribute "-documentElement" is read-only}}
52test document-2.3 {configure -version} -constraints {dom_tcl} -body {
53    ::dom::document configure $doc -version 1.0
54} -result {}
55test document-2.4 {error: configure -version} -constraints {dom_tcl} -body {
56    catch {::dom::document configure $doc -version 1.1}
57} -result 1
58test document-2.5 {configure -encoding} -constraints {dom_tcl} -body {
59    ::dom::document configure $doc -encoding ISO-8859-1
60    ::dom::document cget $doc -encoding
61} -result ISO-8859-1
62test document-2.6 {configure -standalone} -constraints {dom_tcl} -body {
63    ::dom::document configure $doc -standalone 1
64    ::dom::document cget $doc -standalone
65} -result yes
66
67test document-3.1 {create document element} -body {
68    set top [::dom::document createElement $doc Test]
69    ::dom::node appendChild $doc $top
70    ok
71} -result {}
72test document-3.2 {element node type} -body {
73    ::dom::node cget $top -nodeType
74} -result element
75test document-3.3 {element name} -body {
76    ::dom::node cget $top -nodeName
77} -result Test
78test document-3.4 {document element set} -body {
79    ::dom::document cget $doc -documentElement
80} -result $top
81test document-3.5 {error: no element name} -body {
82    catch {::dom::document createElement $doc}
83} -result 1
84test document-3.6 {error: invalid element name} -body {
85    expectError {
86    	::dom::document createElement $top {Has Space}
87    } {invalid * name *}
88} -result 1
89test document-3.7 {error: too many arguments} -body {
90    catch {::dom::document createElement $doc Foo Bar}
91} -result 1
92
93test document-4.1 {create documentFragment} -body {
94    set frag [::dom::document createDocumentFragment $top]
95    ok
96} -result {}
97test document-4.2 {documentFragment node type} -body {
98    ::dom::node cget $frag -nodeType
99} -result documentFragment
100test document-4.3 {error: documentFragment too many arguments} -body {
101    catch {::dom::document createDocumentFragment $top Foo}
102} -result 1
103
104test document-5.1 {create textNode} -body {
105    set text [::dom::document createTextNode $top {Sample Data}]
106    ok;
107} -result {}
108test document-5.2 {textNode node type} -body {
109    ::dom::node cget $text -nodeType
110} -result textNode
111test document-5.3 {textNode node name} -body {
112    ::dom::node cget $text -nodeName
113} -result {#text}
114test document-5.4 {textNode node value} -body {
115    ::dom::node cget $text -nodeValue
116} -result {Sample Data}
117test document-5.5 {error: textNode too few arguments} -body {
118    catch {::dom::document createTextNode $top}
119} -result 1
120test document-5.6 {error: textNode too many arguments} -body {
121    catch {::dom::document createTextNode $top {More Sample Data} Foo}
122} -result 1
123
124test document-6.1 {create comment} -body {
125    set comm [::dom::document createComment $top {Comment Data}]
126    ok;
127} -result {}
128test document-6.2 {comment node type} -body {
129    ::dom::node cget $comm -nodeType
130} -result comment
131test document-6.3 {comment node name} -body {
132    ::dom::node cget $comm -nodeName
133} -result {#comment}
134test document-6.4 {comment node value} -body {
135    ::dom::node cget $comm -nodeValue
136} -result {Comment Data}
137test document-6.5 {error: comment too few arguments} -body {
138    catch {::dom::document createComment $top}
139} -result 1
140test document-6.6 {error: comment too many arguments} -body {
141    catch {::dom::document createComment $top {More Comment Data} Foo}
142} -result 1
143
144# dom::tcl and dom::libxml2 treat CDATA Sections as plain text
145
146test document-7.1 {create CDATASection} -body {
147    set cdata [::dom::document createCDATASection $top {CDATASection <Data>}]
148    ok
149} -result {}
150test document-7.2 {CDATASection node type} -constraints {dom_c} -body {
151    ::dom::node cget $cdata -nodeType
152} -result CDATASection
153test document-7.2 {CDATASection node type} -constraints {dom_tcl || dom_libxml2} -body {
154    ::dom::node cget $cdata -nodeType
155} -result textNode
156test document-7.3 {CDATASection node name} -constraints {dom_c} -body {
157    ::dom::node cget $cdata -nodeName
158} -result {#cdata-section}
159test document-7.3 {CDATASection node name} -constraints {dom_tcl || dom_libxml2} -body {
160    ::dom::node cget $cdata -nodeName
161} -result {#text}
162test document-7.4 {CDATASection node value} -body {
163    ::dom::node cget $cdata -nodeValue
164} -result {CDATASection <Data>}
165test document-7.5 {error: CDATASection too few arguments} -body {
166    catch {::dom::document createCDATASection $top}
167} -result 1
168test document-7.6 {error: CDATASection too many arguments} -body {
169    catch {::dom::document createCDATASection $top {More CDATA} Foo}
170} -result 1
171
172test document-8.1 {create processingInstruction} -body {
173    set pi [::dom::document createProcessingInstruction $top target {PI Data}]
174    ok;
175} -result {}
176test document-8.2 {processingInstruction node type} -body {
177    ::dom::node cget $pi -nodeType
178} -result processingInstruction
179test document-8.3 {processingInstruction node name} -body {
180    ::dom::node cget $pi -nodeName
181} -result target
182test document-8.4 {processingInstruction node value} -body {
183    ::dom::node cget $pi -nodeValue
184} -result {PI Data}
185test document-8.5 {error: processingInstruction too few arguments} -body {
186    catch {::dom::document createProcessingInstruction $top}
187} -result 1
188test document-8.6 {error: processingInstruction too many arguments} -body {
189    catch {::dom::document createProcessingInstruction $top target data Extra}
190} -result 1
191
192# TBD: Attribute
193# TBD: EntityReference
194
195test document-10.1 {getElementsByTagName - document element} -constraints {!dom_libxml2} -body {
196    set docTestElements [::dom::document getElementsByTagName $doc Test]
197    list [llength [set $docTestElements]] [set $docTestElements]
198} -result [list 1 [list $top]]
199
200test document-10.2 {add some elements - set up for successive tests} -body {
201    set child1 [::dom::document createElement $top Child1]
202    ::dom::node appendChild $top $child1
203    set child2 [::dom::document createElement $top Child2]
204    ::dom::node appendChild $top $child2
205    set child3 [::dom::document createElement $top Test]
206    ::dom::node appendChild $top $child3
207    ok
208} -result {}
209test document-10.3 {getElementsByTagName - continued} -constraints {!dom_libxml2} -body {
210    set result [set $docTestElements]
211    list [llength $result] $result
212} -result [list 2 [list $top $child3]]
213
214test document-10.4 {getElementsByTagName - element} -constraints {!dom_libxml2} -body {
215    set result [::dom::document getElementsByTagName $top Child2]
216    list [llength [set $result]] [set $result]
217} -result [list 1 [list $child2]]
218
219test document-10.5 {getElementsByTagName - remove node} -constraints {!dom_libxml2} -body {
220    dom::node removeChild $top $child3
221    list [llength [set $docTestElements]] [set $docTestElements]
222} -result [list 1 [list $top]]
223
224test document-10.6 {getElementsByTagName - read-only variable} -constraints {!dom_libxml2} -body {
225    expectError {
226	lappend $docTestElements -foo-
227    } {*: Read-only variable}
228} -result 1
229
230test document-10.7 {getElementsByTagName - unset variable} -constraints {!dom_libxml2} -body {
231    unset $docTestElements
232    ok
233} -result {}
234
235set testXML "<?xml version=\"1.0\"?><Test><a>aaa<b>bbb</b>aaa</a></Test>"
236test document-11.1 {importNode} -constraints {dom_c} -body {
237	# bug 3620
238	global testXML
239	set doc [::dom::DOMImplementation parse $testXML]
240	set copy [::dom::DOMImplementation create]
241	set root [::dom::document cget $doc -documentElement]
242	set result [catch {::dom::document importNode $copy $root -deep 1} node]
243	::dom::node insert $copy $node
244	set xml [::dom::DOMImplementation serialize $copy]
245	list $result $xml
246} -result {0 {<?xml version='1.0'?>
247<!DOCTYPE Test>
248<Test><a>aaa<b>bbb</b>aaa</a></Test>}}
249
250
251# cleanup
252::tcltest::cleanupTests
253return
254