/[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.3 - (hide annotations) (download) (as text)
Sun Jun 17 13:37:42 2007 UTC (17 years, 10 months ago) by wakaba
Branch: MAIN
Changes since 1.2: +41 -29 lines
File MIME type: application/x-troff 
++ manakai/t/ChangeLog	17 Jun 2007 13:37:22 -0000
2007-06-17  Wakaba  <wakaba@suika.fam.cx>

	* DOM-Attr.t, DOM-AttributeDefinition.t, DOM-DocumentType.t,
	DOM-Element.t, DOM-Entity.t, DOM-EntityReference.t,
	DOM-Notation.t, DOM-ProcessingInstruction.t: New.

	* DOM-Document.t, DOM-Node.t: Tests for newly-implemented attributes
	and methods are added.

	* Makefile (test-module-dom-old): Renamed from |test-module-dom|.
	(test-module-dom): New.

++ manakai/lib/Message/DOM/ChangeLog	17 Jun 2007 13:34:54 -0000
2007-06-17  Wakaba  <wakaba@suika.fam.cx>

	* Attr.pm (____new): Initialize |specified| as 1.
	(base_uri, manakai_attribute_type, specified): Implemented.
	(prefix): Don't check read-only flag unless |strict_error_checking|.
	(value): Call |text_content| for now.

	* AttributeDefinition.pm (DeclaredValueType, DefaultValueType): Added.
	(declared_type, default_type): Implemented.

	* CharacterData.pm (____new): Allow a scalar reference
	as an input for the |data| attribute.
	(base_uri, manakai_append_text): Implemented.

	* DOMConfiguration.pm (set_parameter): Resetting implemented.

	* DOMDocument.pm (____new): Set default values to
	configuration parameter whose default is true.
	(document_uri, input_encoding): Implemented.
	(all_declarations_processed, manakai_is_html): Implemented.
	(base_uri, manakai_append_text,
	manakai_entity_base_uri, strict_error_checking,
	xml_encoding, xml_version, xml_standalone): Implemented.

	* DOMElement.pm (manakai_base_uri, base_uri): Implemented.
	(get_attribute, get_attribute_node): Alpha version.
	(set_attribute_node, set_attribute_node_ns): Implemented.
	(set_attribute_ns): Accept non-ARRAY qualified name.

	* DOMException.pm (___error_def): |WRONG_DOCUMENT_ERR|,
	|NOT_SUPPORTED_ERR|, and |INUSE_ATTRIBUTE_ERR| are added.

	* DocumentType.pm (public_id, system_id): Implemented.
	(base_uri, declaration_base_uri, manakai_declaration_base_uri,
	manakai_append_text): Implemented.
	(element_types, general_entities, notations,
	set_element_type_definition_node, set_general_entity_node,
	set_notation_node): Alpha version.

	* ElementTypeDefinition.pm (manakai_append_text): Implemented.
	(attribute_definitions, set_attribute_definition_node): Alpha version.

	* Entity.pm (has_replacement_tree, public_id, system_id,
	manakai_declaration_base_uri, manakai_entity_base_uri,
	manakai_entity_uri): Implemented.

	* EntityReference.pm (manakai_expanded, manakai_external): Implemented.
	(base_uri, manakai_entity_base_uri): Implemented.

	* Node.pm (base_uri): Implemented.
	(text_content): Don't check read-only or not
	unless |strict_error_checking|.
	(manakai_append_text): Implemented.
	(get_feature): Alpha.
	(manakai_set_read_only): Implemented.

	* Notation.pm (public_id, system_id, manakai_append_text,
	manakai_declaration_base_uri): Implemented.

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