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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (hide annotations) (download) (as text)
Sun Nov 18 11:08:43 2007 UTC (17 years ago) by wakaba
Branch: MAIN
CVS Tags: HEAD
Changes since 1.6: +5 -5 lines
File MIME type: application/x-troff
++ manakai/lib/Message/ChangeLog	18 Nov 2007 05:58:46 -0000
2007-11-18  Wakaba  <wakaba@suika.fam.cx>

	* Charset/: New directory.

++ manakai/lib/Message/DOM/ChangeLog	18 Nov 2007 08:56:34 -0000
2007-11-18  Wakaba  <wakaba@suika.fam.cx>

	* Document.pm, Entity.pm (manakai_has_bom,
	manakai_charset): New attributes.

++ manakai/lib/Message/Charset/ChangeLog	18 Nov 2007 11:08:08 -0000
2007-11-18  Wakaba  <wakaba@suika.fam.cx>

	* Info.pm: New Perl module.

2007-11-18  Wakaba  <wakaba@suika.fam.cx>

	* ChangeLog: New file.


++ manakai/t/ChangeLog	18 Nov 2007 08:41:50 -0000
2007-11-18  Wakaba  <wakaba@suika.fam.cx>

	* DOM-Document.t, DOM-Entity.t: New tests for |manakai_has_bom|
	attribute.

1 wakaba 1.1 #!/usr/bin/perl
2     use strict;
3     use Test;
4 wakaba 1.7 BEGIN { plan tests => 139 }
5 wakaba 1.1
6     require Message::DOM::DOMImplementation;
7 wakaba 1.2 use Message::Util::Error;
8 wakaba 1.1
9     ## TODO: |create_document| tests
10    
11 wakaba 1.7 my $dom = Message::DOM::DOMImplementation->new;
12 wakaba 1.1 my $doc = $dom->create_document;
13    
14     ## AUTOLOAD test
15 wakaba 1.2 ok $doc->can ('create_element_ns') ? 1 : 0, 1, "can create_element_ns";
16 wakaba 1.1 my $el = $doc->create_element_ns (undef, 'test');
17     ok UNIVERSAL::isa ($el, 'Message::IF::Element');
18    
19     ok $doc->can ('no_such_method') ? 1 : 0, 0;
20     my $something_called = 0;
21     eval {
22     $doc->no_such_method;
23     $something_called = 1;
24     };
25     ok $something_called, 0;
26    
27 wakaba 1.2 ## NOTE: Tests for |create_*| methods found in |DOM-Node.t|.
28 wakaba 1.1
29     my $impl = $doc->implementation;
30     ok UNIVERSAL::isa ($impl, 'Message::IF::DOMImplementation') ? 1 : 0, 1;
31    
32 wakaba 1.2 ## |xmlVersion|
33     ok $doc->can ('xml_version') ? 1 : 0, 1, 'can xml_version';
34    
35     ok $doc->xml_version, '1.0', 'xml_version initial';
36    
37     $doc->xml_version ('1.1');
38     ok $doc->xml_version, '1.1', 'xml_version 1.1';
39    
40     $doc->xml_version ('1.0');
41     ok $doc->xml_version, '1.0', 'xml_version 1.0';
42    
43     try {
44     $doc->xml_version ('1.2');
45     ok undef, 'NOT_SUPPORTED_ERR', 'xml_version 1.2 exception';
46     } catch Message::IF::DOMException with {
47     my $err = shift;
48     ok $err->type, 'NOT_SUPPORTED_ERR', 'xml_version 1.2 exception';
49     };
50     ok $doc->xml_version, '1.0', 'xml_version 1.2';
51    
52     ## |xmlVersion| and |manakaiIsHTML|
53     my $html_doc = $doc->implementation->create_document;
54     {
55     $html_doc->manakai_is_html (1);
56     ok $html_doc->manakai_is_html ? 1 : 0, 1, 'HTMLDocument->manakai_is_html 1';
57     ok $html_doc->xml_version, undef, 'HTMLDocument->xml_version';
58    
59     try {
60     $html_doc->xml_version ('1.0');
61     ok undef, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_version 1.0 exception';
62     } catch Message::IF::DOMException with {
63     my $err = shift;
64     ok $err->type, 'NOT_SUPPORTED_ERR',
65     'HTMLDocument->xml_version 1.0 exception';
66     };
67     ok $html_doc->xml_version, undef, 'HTMLDocument->xml_version 1.0';
68    
69     $html_doc->manakai_is_html (0);
70     ok $html_doc->manakai_is_html ? 1 : 0, 0, 'HTMLDocument->manakai_is_html 0';
71     ok $html_doc->xml_version, '1.0', '(was HTML) Document->xml_version 1.0';
72    
73     $html_doc->manakai_is_html (1);
74     }
75    
76     ## |xmlEncoding|
77     {
78     ok $doc->can ('xml_encoding') ? 1 : 0, 1, 'can xml_encoding';
79    
80     $doc->xml_encoding ('utf-8');
81     ok $doc->xml_encoding, 'utf-8', 'xml_encoding legal';
82    
83     $doc->xml_encoding ('\abcd');
84     ok $doc->xml_encoding, '\abcd', 'xml_encoding illegal';
85    
86     $doc->xml_encoding (undef);
87     ok $doc->xml_encoding, undef, 'xml_encoding null';
88    
89     ok $html_doc->xml_encoding, undef, 'HTMLDocument->xml_encoding';
90    
91     try {
92     $html_doc->xml_encoding ('utf-8');
93     ok undef, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_encoding exception';
94     } catch Message::IF::DOMException with {
95     my $err = shift;
96     ok $err->type, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_encoding exception';
97     };
98     ok $html_doc->xml_encoding, undef, 'HTMLDocument->xml_encoding';
99    
100     try {
101     $html_doc->xml_encoding (undef);
102     ok undef, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_encoding exception 2';
103     } catch Message::IF::DOMException with {
104     my $err = shift;
105     ok $err->type, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_encoding exception 2';
106     };
107     ok $html_doc->xml_encoding, undef, 'HTMLDocument->xml_encoding 2';
108     }
109    
110     ## |xmlStandalone|
111     {
112     ok $doc->can ('xml_standalone') ? 1 : 0, 1, 'can xml_standalone';
113    
114     $doc->xml_standalone (1);
115     ok $doc->xml_standalone ? 1 : 0, 1, 'xml_standalone 1';
116    
117     $doc->xml_standalone (0);
118     ok $doc->xml_standalone ? 1 : 0, 0, 'xml_standalone 0';
119    
120     ok $html_doc->xml_standalone ? 1 : 0, 0, 'HTMLDocument->xml_standalone';
121    
122     try {
123     $html_doc->xml_standalone (1);
124     ok undef, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_standalone 1 exception';
125     } catch Message::IF::DOMException with {
126     my $err = shift;
127     ok $err->type, 'NOT_SUPPORTED_ERR',
128     'HTMLDocument->xml_standalone 1 exception';
129     };
130     ok $html_doc->xml_standalone ? 1 : 0, 0, 'HTMLDocument->xml_standalone 1';
131    
132     try {
133     $html_doc->xml_standalone (0);
134     ok undef, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_standalone 0 exception';
135     } catch Message::IF::DOMException with {
136     my $err = shift;
137     ok $err->type, 'NOT_SUPPORTED_ERR',
138     'HTMLDocument->xml_standalone 0 exception';
139     };
140     ok $html_doc->xml_standalone ? 1 : 0, 0, 'HTMLDocument->xml_standalone 0';
141     }
142    
143     ## |strictErrorChecking|
144     {
145     ok $doc->can ('strict_error_checking') ? 1 : 0, 1, 'can strict_error_checking';
146    
147     $doc->strict_error_checking (0);
148     ok $doc->strict_error_checking ? 1 : 0, 0, 'strict_error_checking 0';
149    
150     $doc->strict_error_checking (1);
151     ok $doc->strict_error_checking ? 1 : 0, 1, 'strict_error_checking 1';
152    
153     $doc->strict_error_checking (undef);
154     ok $doc->strict_error_checking ? 1 : 0, 0, 'strict_error_checking undef';
155    
156     $doc->strict_error_checking (1);
157     }
158    
159 wakaba 1.7 for my $prop (qw/document_uri input_encoding manakai_charset/) {
160 wakaba 1.2 ok $doc->can ($prop) ? 1 : 0, 1, 'can ' . $prop;
161    
162     for ('http://absuri.test/', 'reluri', 0, '') {
163     $doc->$prop ($_);
164     ok $doc->$prop, $_, $prop . $_;
165     }
166    
167     $doc->$prop (undef);
168     ok $doc->$prop, undef, $prop . ' undef';
169     }
170    
171 wakaba 1.7 for my $prop (qw/all_declarations_processed manakai_has_bom/) {
172 wakaba 1.2 ok $doc->can ($prop) ? 1 : 0, 1, 'can ' . $prop;
173    
174     for (1, 0, '') {
175     $doc->$prop ($_);
176     ok $doc->$prop ? 1 : 0, $_ ? 1 : 0, $prop . $_;
177     }
178    
179     $doc->$prop (undef);
180     ok $doc->$prop ? 1 : 0, 0, $prop . ' undef';
181     }
182    
183 wakaba 1.3 ## |manakaiIsHTML|, |compatMode|, and |manakaiCompatMode|
184     {
185     my $doc2 = $doc->implementation->create_document;
186     ok $doc2->can ('manakai_is_html') ? 1 : 0, 1, "can manakai_is_html";
187     ok $doc2->can ('compat_mode') ? 1 : 0, 1, "can compat_mode";
188     ok $doc2->can ('manakai_compat_mode') ? 1 : 0, 1, "can manakai_compat_mode";
189     ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [0]";
190     ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [0]';
191     ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [0]';
192    
193     $doc2->manakai_compat_mode ('quirks');
194     ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [1]";
195     ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [1]';
196     ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [1]';
197    
198     $doc2->manakai_compat_mode ('limited quirks');
199     ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [2]";
200     ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [2]';
201     ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [2]';
202    
203     $doc2->manakai_compat_mode ('no quirks');
204     ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [3]";
205     ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [3]';
206     ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [3]';
207    
208     $doc2->manakai_compat_mode ('bogus');
209     ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [4]";
210     ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [4]';
211     ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [4]';
212    
213     $doc2->manakai_is_html (1);
214     ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [5]";
215     ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [5]';
216     ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [5]';
217    
218     $doc2->manakai_compat_mode ('quirks');
219     ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [6]";
220     ok $doc2->compat_mode, 'BackCompat', 'compat_mode [6]';
221     ok $doc2->manakai_compat_mode, 'quirks', 'manakai_compat_mode [6]';
222    
223     $doc2->manakai_compat_mode ('limited quirks');
224     ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [7]";
225     ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [7]';
226     ok $doc2->manakai_compat_mode, 'limited quirks', 'manakai_compat_mode [7]';
227    
228     $doc2->manakai_compat_mode ('no quirks');
229     ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [8]";
230     ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [8]';
231     ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [8]';
232    
233     $doc2->manakai_compat_mode ('bogus');
234     ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [9]";
235     ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [9]';
236     ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [9]';
237    
238     $doc2->manakai_compat_mode ('quirks');
239     $doc2->manakai_is_html (0);
240     ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [10]";
241     ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [10]';
242     ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [10]';
243    
244     $doc2->manakai_is_html (1);
245     ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [11]";
246     ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [11]';
247     ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [11]';
248     }
249    
250 wakaba 1.4 {
251     ok $doc->can ('implementation') ? 1 : 0, 1, 'Document->implementation can';
252     my $impl = $doc->implementation;
253     ok UNIVERSAL::isa ($impl, 'Message::DOM::DOMImplementation') ? 1 : 0,
254     1, 'Document->implementation class';
255     my $impl2 = $doc->implementation;
256     ok $impl eq $impl2 ? 1 : 0, 1, 'Document->implementation eq D->i';
257     ok $impl ne $impl2 ? 1 : 0, 0, 'Document->implementation ne D->i';
258     ok $impl == $impl2 ? 1 : 0, 1, 'Document->implementation == D->i';
259     ok $impl != $impl2 ? 1 : 0, 0, 'Document->implementation != D->i';
260     }
261    
262     {
263     my $doc2 = $doc->implementation->create_document;
264     ok $doc2->doctype, undef, 'Document->implementation [0]';
265    
266     my $doctype = $doc2->implementation->create_document_type ('dt');
267     my $el = $doc2->create_element_ns (undef, 'e');
268     $doc2->append_child ($doctype);
269     $doc2->append_child ($el);
270    
271     ok $doc2->doctype, $doctype, 'Document->implementation [1]';
272     }
273    
274     {
275     my $doc2 = $doc->implementation->create_document;
276     my $doctype = $doc2->implementation->create_document_type ('dt');
277     my $el = $doc2->create_element_ns (undef, 'e');
278 wakaba 1.6 my $comment = $doc2->create_comment ('');
279 wakaba 1.4 $doc2->append_child ($comment);
280     $doc2->append_child ($doctype);
281     $doc2->append_child ($el);
282    
283     ok $doc2->doctype, $doctype, 'Document->implementation [2]';
284     }
285    
286     {
287     my $doc2 = $doc->implementation->create_document;
288     ok $doc2->can ('document_element') ? 1 : 0, 1, 'Document->document_el can';
289     ok $doc2->document_element, undef, 'Document->document_element [0]';
290    
291     my $el = $doc2->create_element_ns (undef, 'e');
292     $doc2->append_child ($el);
293    
294     ok $doc2->document_element, $el, 'Document->document_element [1]';
295     }
296    
297     {
298     my $doc2 = $doc->implementation->create_document;
299     my $doctype = $doc2->implementation->create_document_type ('dt');
300     $doc2->append_child ($doctype);
301     my $el = $doc2->create_element_ns (undef, 'e');
302     $doc2->append_child ($el);
303    
304     ok $doc2->document_element, $el, 'Document->document_element [1]';
305     }
306    
307     {
308     ok $doc->can ('dom_config') ? 1 : 0, 1, 'Document->dom_config can';
309     my $cfg = $doc->dom_config;
310     ok UNIVERSAL::isa ($cfg, 'Message::IF::DOMConfiguration') ? 1 : 0,
311     1, 'Document->dom_config interface';
312     }
313    
314     {
315     my $impl = $doc->implementation;
316     my $doc1 = $impl->create_document;
317     my $doc2 = $impl->create_document;
318    
319     ok $doc2->can ('adopt_node') ? 1 : 0, 1, 'Document->adopt_node can';
320    
321     my $el1 = $doc1->create_element_ns (undef, 'e');
322     my $el2 = $doc2->adopt_node ($el1);
323    
324     ok $el1 eq $el2 ? 1 : 0, 1, 'Document->adopt_node return == source';
325     ok $el2->owner_document, $doc2, 'Document->adopt_node owner_document';
326    
327     my $node = $doc1->create_element ('e');
328     my $udh_called = 0;
329     $node->set_user_data (key => {}, sub {
330     my ($op, $key, $data, $src, $dest) = @_;
331     $udh_called = 1;
332    
333     ok $op, 5, 'adopt_node user data handler operation';
334     ok $key, 'key', 'adopt_node user data handler key';
335     ok ref $data, 'HASH', 'adopt_node user data handler data';
336     ok $src, $node, 'adopt_node user data handler src';
337     ok $dest, undef, 'adopt_node user data handler dest';
338     });
339    
340     $doc2->adopt_node ($node);
341    
342     ok $udh_called, 1, 'Document->adopt_node udh called';
343    
344     $node->set_user_data (key => undef, undef);
345    
346     my $el3 = $doc1->create_element_ns (undef, 'e');
347     my $el4 = $doc1->adopt_node ($el3);
348    
349     ok $el4, $el3, 'Document->adopt_node samedoc return';
350     ok $el4->owner_document, $doc1, 'Document->adopt_node samedoc od';
351    
352     my $parent = $doc1->create_element ('pa');
353     my $child = $doc1->create_element ('ch');
354     $parent->append_child ($child);
355    
356     my $child2 = $doc2->adopt_node ($child);
357    
358     ok $child2, $child, 'Document->adopt_node return [2]';
359     ok $child2->owner_document, $doc2, 'Document->adopt_node->od [2]';
360     ok $child2->parent_node, undef, 'Document->adopt_node->parent_node [2]';
361     ok 0+@{$parent->child_nodes}, 0, 'Document->adopt_node parent->cn @{} 0+ [2]';
362    
363     my $attr = $doc1->create_attribute ('e');
364     $parent->set_attribute_node ($attr);
365    
366     my $attr2 = $doc2->adopt_node ($attr);
367     ok $attr2, $attr, 'Document->adopt_node return [3]';
368     ok $attr2->owner_document, $doc2, 'Document->adopt_node->od [3]';
369     ok $attr2->owner_element, undef, 'Document->adopt_node->oe [3]';
370     ok 0+@{$parent->attributes}, 0, 'Document->adopt_node parent->a @{} 0+ [3]';
371     }
372    
373 wakaba 1.2 ## TODO: manakai_entity_base_uri
374    
375     =head1 LICENSE
376    
377     Copyright 2007 Wakaba <w@suika.fam.cx>
378    
379     This program is free software; you can redistribute it and/or
380     modify it under the same terms as Perl itself.
381    
382     =cut
383    
384 wakaba 1.7 ## $Date: 2007/07/08 05:42:37 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24