/[suikacvs]/messaging/manakai/t/DOM-NodeList.t
Suika

Contents of /messaging/manakai/t/DOM-NodeList.t

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.4 - (hide annotations) (download) (as text)
Sun Jul 8 05:42:37 2007 UTC (17 years, 9 months ago) by wakaba
Branch: MAIN
CVS Tags: manakai-release-0-4-0, HEAD
Changes since 1.3: +2 -1 lines
File MIME type: application/x-troff 
++ manakai/t/ChangeLog	8 Jul 2007 05:42:31 -0000
2007-07-08  Wakaba  <wakaba@suika.fam.cx>

	* DOM-Document.t, DOM-Node.t, DOM-NodeList.t: Some tests are modified so
	that no |WRONG_DOCUMENT_ERR| is raised.

	* DOM-Node.t: Tests for |remove_child| are added.

++ manakai/lib/Message/DOM/ChangeLog	8 Jul 2007 05:41:27 -0000
2007-07-08  Wakaba  <wakaba@suika.fam.cx>

	* Attr.pm, AttributeDefinition.pm, DOMCharacterData.pm,
	DOMDocument.pm, DocumentType.pm, ElementTypeDefinition.pm,
	Node.pm, Notation.pm, ProcessingInstruction.pm (append_child,
	insert_before, replace_child): Implemented.

	* DOMException.pm (HIERARCHY_REQUEST_ERR, NOT_FOUND_ERR): Implemented.

	* Node.pm (remove_child): Implemented.
1 wakaba 1.1 #!/usr/bin/perl
2     use strict;
3     use Test;
4 wakaba 1.3 BEGIN { plan tests => 706 }
5 wakaba 1.1
6     require Message::DOM::DOMImplementation;
7 wakaba 1.2 use Message::Util::Error;
8 wakaba 1.1
9     my $dom = Message::DOM::DOMImplementation->____new;
10     my $doc = $dom->create_document;
11    
12 wakaba 1.3 sub create_leaf_nodes () {
13     (
14     $doc->create_cdata_section ('cdata1'),
15     $doc->create_comment ('comment1'),
16     $doc->create_notation ('notation1'),
17     $doc->create_processing_instruction ('pi1', 'pi1data'),
18     $doc->create_text_node ('text1'),
19     );
20     } # create_leaf_nodes
21    
22     sub create_parent_nodes () {
23     (
24     $doc->create_attribute ('attr1'),
25     $doc->create_attribute_definition ('at1'),
26     $doc->create_element ('element1'),
27     $doc->create_general_entity ('entity1'),
28     $doc->create_entity_reference ('entity-reference1'),
29     $doc->implementation->create_document,
30     $doc->create_document_fragment,
31     $doc->create_document_type_definition ('dt1'),
32     );
33     } # create_parent_nodes
34    
35 wakaba 1.1 for my $parent (create_parent_nodes ()) {
36 wakaba 1.4 my $doc = $parent->owner_document || $parent;
37 wakaba 1.1 my $node1;
38     my $node2;
39     my $node1a;
40     my $node2a;
41     if ($parent->node_type == $parent->DOCUMENT_TYPE_NODE) {
42     $node1 = $doc->create_processing_instruction ('pi1', 'data1');
43     $node2 = $doc->create_processing_instruction ('pi2', 'data2');
44     $node1a = $doc->create_processing_instruction ('pi1', 'data1');
45     $node2a = $doc->create_processing_instruction ('pi2', 'data2');
46     } elsif ($parent->node_type == $parent->DOCUMENT_NODE) {
47     $node1 = $doc->create_comment ('comment1');
48     $node2 = $doc->create_comment ('comment2');
49     $node1a = $doc->create_comment ('comment1');
50     $node2a = $doc->create_comment ('comment2');
51     } else {
52     $node1 = $doc->create_text_node ('text1');
53     $node2 = $doc->create_text_node ('text2');
54     $node1a = $doc->create_text_node ('text1');
55     $node2a = $doc->create_text_node ('text2');
56     }
57    
58     my $cn = $parent->child_nodes;
59     ok UNIVERSAL::isa ($cn, 'Message::IF::NodeList') ? 1 : 0, 1,
60     'childNodes.interface';
61     ok $cn ? 1 : 0, 1, 'bool';
62    
63     ok $cn->can ('manakai_read_only') ? 1 : 0, 1, 'can childNodes.manakaiReadOnly';
64     $parent->manakai_set_read_only (1);
65     ok $cn->manakai_read_only ? 1 : 0, 1, 'childNodes.manakaiReadOnly (1)';
66     $parent->manakai_set_read_only (0);
67     ok $cn->manakai_read_only ? 1 : 0, 0, 'childNodes.manakaiReadOnly (0)';
68    
69     ok $cn->can ('length') ? 1 : 0, 1, 'can childNodes.length [0]';
70     ok $cn->length, 0, 'childNodes.length [0]';
71 wakaba 1.2 ok 0+@$cn, 0, '@{child_nodes} [0]';
72 wakaba 1.1
73     ok $cn->can ('item') ? 1 : 0, 1, 'can childNodes.item';
74     ok $cn->item (0), undef, 'childNodes.item (0) [0]';
75     ok $cn->item (1), undef, 'childNodes.item (1) [0]';
76     ok $cn->item (-1), undef, 'childNodes.item (-1) [0]';
77 wakaba 1.3 {
78     local $^W = 0;
79     ok $cn->item (undef), undef, 'childNodes.item (undef) [0]';
80     }
81 wakaba 1.2 ok $cn->[0], undef, 'child_nodes->[0] [0]';
82     ok $cn->[1], undef, 'child_nodes->[1] [0]';
83 wakaba 1.1
84     $parent->append_child ($node1);
85    
86     ok $cn->length, 1, 'childNodes.length [1]';
87    
88     ok $cn->item (0), $node1, 'childNodes.item (0) [1]';
89     ok $cn->item (1), undef, 'childNodes.item (1) [1]';
90     ok $cn->item (-1), undef, 'childNodes.item (-1) [1]';
91 wakaba 1.3 {
92     local $^W = 0;
93     ok $cn->item (undef), $node1, 'childNodes.item (undef) [1]';
94     }
95 wakaba 1.2 ok $cn->[0], $node1, 'child_nodes->[0] [1]';
96     ok $cn->[1], undef, 'child_nodes->[1] [1]';
97     ok exists $cn->[0] ? 1 : 0, 1, 'exists child_nodes->[0] [1]';
98     ok exists $cn->[1] ? 1 : 0, 0, 'exists child_nodes->[1] [1]';
99 wakaba 1.1
100     $parent->append_child ($node2);
101    
102     ok $cn->length, 2, 'childNodes.length [2]';
103    
104     ok $cn->item (0), $node1, 'childNodes.item (0) [2]';
105     ok $cn->item (1), $node2, 'childNodes.item (1) [2]';
106     ok $cn->item (-1), undef, 'childNodes.item (-1) [2]';
107 wakaba 1.3 {
108     local $^W = 0;
109     ok $cn->item (undef), $node1, 'childNodes.item (undef) [2]';
110     }
111 wakaba 1.2 ok $cn->[0], $node1, 'child_nodes->[0] [2]';
112     ok $cn->[1], $node2, 'child_nodes->[1] [2]';
113 wakaba 1.1
114     ok $cn eq $cn ? 1 : 0, 1, 'A eq A';
115     ok $cn ne $cn ? 1 : 0, 0, 'A ne A';
116     ok $cn == $cn ? 1 : 0, 1, 'A == A';
117     ok $cn != $cn ? 1 : 0, 0, 'A != A';
118    
119     my $cn2 = $parent->child_nodes;
120     ok $cn eq $cn2 ? 1 : 0, 1, "A eq A'";
121     ok $cn ne $cn2 ? 1 : 0, 0, "A ne A'";
122     ok $cn == $cn2 ? 1 : 0, 1, "A == A'";
123     ok $cn != $cn2 ? 1 : 0, 0, "A != A'";
124    
125     my $parenta = $doc->create_element ('element');
126     my $cn3 = $parenta->child_nodes;
127     ok $cn eq $cn3 ? 1 : 0, 0, 'A eq B (A != B)';
128     ok $cn ne $cn3 ? 1 : 0, 1, 'A ne B (A != B)';
129     ok $cn == $cn3 ? 1 : 0, 0, 'A == B (A != B)';
130     ok $cn != $cn3 ? 1 : 0, 1, 'A != B (A != B)';
131    
132     $parenta->append_child ($node1a);
133     $parenta->append_child ($node2a);
134     ok $cn eq $cn3 ? 1 : 0, 0, 'A eq B (A == B)';
135     ok $cn ne $cn3 ? 1 : 0, 1, 'A ne B (A == B)';
136     ok $cn == $cn3 ? 1 : 0, 1, 'A == B (A == B)';
137     ok $cn != $cn3 ? 1 : 0, 0, 'A != B (A == B)';
138 wakaba 1.2
139     $cn->[2] = $node1a;
140     ok $cn->[2], $node1a, 'child_nodes->[2] setter (item)';
141     ok 0+@$cn, 3, 'child_nodes->[2] setter (length)';
142    
143     $cn->[4] = $node2a;
144     ok $cn->[3], $node2a, 'child_nodes->[3] setter (item)';
145     ok $cn->[4], undef, 'child_nodes->[4] setter (item)';
146     ok 0+@$cn, 4, 'child_nodes->[4] setter (length)';
147     ## TODO: Add replaceChild test
148    
149     my $deleted = delete $cn->[4];
150     ok $deleted, undef, 'delete child_nodes->[4]';
151     ok $cn->[3], $node2a, 'delete child_nodes->[4] item(3)';
152     ok $cn->[4], undef, 'delete child_nodes->[4] item(4)';
153    
154     $deleted = delete $cn->[0];
155     ok $deleted, $node1, 'delete child_nodes->[0]';
156     ok $cn->[0], $node2, 'delete child_nodes->[0] item(0)';
157     ok $cn->[1], $node1a, 'delete child_nodes->[0] item(1)';
158     ok $cn->[2], $node2a, 'delete child_nodes->[0] item(2)';
159     ok $cn->[3], undef, 'delete child_nodes->[0] item(3)';
160     ok $cn->[4], undef, 'delete child_nodes->[0] item(4)';
161    
162     my @a = @$cn;
163     ok 0+@a, 3;
164     ok $a[0], $node2, '@ = @{child_nodes} item(0)';
165     ok $a[1], $node1a, '@ = @{child_nodes} item(1)';
166     ok $a[2], $node2a, '@ = @{child_nodes} item(2)';
167     ok $a[3], undef, '@ = @{child_nodes} item(3)';
168    
169     @$cn = ();
170     ok 0+@$cn, 0, 'child_nodes->clear';
171 wakaba 1.1 }
172    
173 wakaba 1.2 for my $parent (create_leaf_nodes ()) {
174     my $node1;
175     my $node2;
176     my $node1a;
177     my $node2a;
178     $node1 = $doc->create_text_node ('text1');
179     $node2 = $doc->create_text_node ('text2');
180     $node1a = $doc->create_text_node ('text1');
181     $node2a = $doc->create_text_node ('text2');
182    
183     my $cn = $parent->child_nodes;
184     ok UNIVERSAL::isa ($cn, 'Message::IF::NodeList') ? 1 : 0, 1,
185     'childNodes.interface';
186     ok $cn ? 1 : 0, 1, 'bool';
187    
188     ok $cn->can ('manakai_read_only') ? 1 : 0, 1, 'can childNodes.manakaiReadOnly';
189     $parent->manakai_set_read_only (1);
190     ok $cn->manakai_read_only ? 1 : 0, 1, 'childNodes.manakaiReadOnly (1)';
191     $parent->manakai_set_read_only (0);
192     ok $cn->manakai_read_only ? 1 : 0, 1, 'childNodes.manakaiReadOnly (0)';
193    
194     ok $cn->can ('length') ? 1 : 0, 1, 'can childNodes.length [0]';
195     ok $cn->length, 0, 'childNodes.length [0]';
196     ok 0+@$cn, 0, '@{child_nodes} [0]';
197    
198     ok $cn->can ('item') ? 1 : 0, 1, 'can childNodes.item';
199     ok $cn->item (0), undef, 'childNodes.item (0) [0]';
200     ok $cn->item (1), undef, 'childNodes.item (1) [0]';
201     ok $cn->item (-1), undef, 'childNodes.item (-1) [0]';
202 wakaba 1.3 {
203     local $^W = 0;
204     ok $cn->item (undef), undef, 'childNodes.item (undef) [0]';
205     }
206 wakaba 1.2 ok $cn->[0], undef, 'child_nodes->[0] [0]';
207     ok $cn->[1], undef, 'child_nodes->[1] [0]';
208     ok exists $cn->[0] ? 1 : 0, 0, 'exists child_nodes->[0] [1]';
209     ok exists $cn->[1] ? 1 : 0, 0, 'exists child_nodes->[1] [1]';
210    
211     ok $cn eq $cn ? 1 : 0, 1, 'A eq A';
212     ok $cn ne $cn ? 1 : 0, 0, 'A ne A';
213     ok $cn == $cn ? 1 : 0, 1, 'A == A';
214     ok $cn != $cn ? 1 : 0, 0, 'A != A';
215    
216     my $cn2 = $parent->child_nodes;
217     ok $cn eq $cn2 ? 1 : 0, 1, "A eq A'";
218     ok $cn ne $cn2 ? 1 : 0, 0, "A ne A'";
219     ok $cn == $cn2 ? 1 : 0, 1, "A == A'";
220     ok $cn != $cn2 ? 1 : 0, 0, "A != A'";
221    
222     my $parenta = $doc->create_element ('element');
223     my $cn3 = $parenta->child_nodes;
224     ok $cn eq $cn3 ? 1 : 0, 0, 'A eq B (A != B)';
225     ok $cn ne $cn3 ? 1 : 0, 1, 'A ne B (A != B)';
226     ok $cn == $cn3 ? 1 : 0, 1, 'A == B (A != B)';
227     ok $cn != $cn3 ? 1 : 0, 0, 'A != B (A != B)';
228    
229     try {
230     $cn->[2] = $node1a;
231     ok 0, 1, $parent->node_name . '->child_nodes->[2] = $node';
232     } catch Message::IF::DOMException with {
233     my $err = shift;
234     ok $err->type, 'NO_MODIFICATION_ALLOWED_ERR',
235     $parent->node_name . '->child_nodes->[2] = $node';
236     };
237     ok 0+@$cn, 0, $parent->node_name . '->child_nodes->[2] (length)';
238    
239     try {
240     delete $cn->[4];
241     ok 0, 1, $parent->node_name . '->child_nodes->[2] delete';
242     } catch Message::IF::DOMException with {
243     my $err = shift;
244     ok $err->type, 'NO_MODIFICATION_ALLOWED_ERR',
245     $parent->node_name . '->child_nodes->[2] delete';
246     };
247    
248     my @a = @$cn;
249     ok 0+@a, 0, $parent->node_type . '->child_nodes @{} = 0+';
250    
251     try {
252     @$cn = ();
253     ok 0, 1, $parent->node_name . '->child_nodes->[2] delete';
254     } catch Message::IF::DOMException with {
255     my $err = shift;
256     ok $err->type, 'NO_MODIFICATION_ALLOWED_ERR',
257     $parent->node_name . '->child_nodes @{} CLEAR';
258     };
259     }
260 wakaba 1.1
261 wakaba 1.2 =head1 LICENSE
262    
263     Copyright 2007 Wakaba <w@suika.fam.cx>
264    
265     This program is free software; you can redistribute it and/or
266     modify it under the same terms as Perl itself.
267    
268     =cut
269    
270 wakaba 1.4 ## $Date: 2007/06/17 13:37:42 $
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24