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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.2 - (hide annotations) (download) (as text)
Sat Jul 7 11:11:34 2007 UTC (17 years, 4 months ago) by wakaba
Branch: MAIN
Changes since 1.1: +67 -3 lines
File MIME type: application/x-troff 
++ manakai/t/ChangeLog	7 Jul 2007 11:11:27 -0000
	* DOM-Element.t: New tests for |create_element|
	and |create_element_ns| are added.

	* DOM-EntityReference.t: New tests for |create_entity_reference|
	are added.

	* DOM-Node.t: Test data for |is_element_content_whitespace|
	are added.

2007-07-07  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/Message/DOM/ChangeLog	7 Jul 2007 11:10:33 -0000
	* CDATASection.pm (is_element_content_whitespace): New.

	* DOMElement.pm (has_attribute): Alpha version.
	(create_element, create_element_ns): Implemented.

	* DocumentType.pm (get_general_entity_node): Alpha version.

	* EntityReference.pm (create_entity_reference): Implemented.

	* ProcessingInstruction.pm (create_processing_instruction): Implemented.

2007-07-07  Wakaba  <wakaba@suika.fam.cx>
1 wakaba 1.1 #!/usr/bin/perl
2     use strict;
3     use Test;
4 wakaba 1.2 BEGIN { plan tests => 52 }
5 wakaba 1.1
6     require Message::DOM::DOMImplementation;
7     use Message::Util::Error;
8    
9     my $dom = Message::DOM::DOMImplementation->____new;
10 wakaba 1.2
11     {
12     my $doc = $dom->create_document;
13     my $el = $doc->create_element ('et1');
14    
15     ok 0+@{$el->attributes}, 0, 'create_element->attributes @{} 0+ [0]';
16    
17     my $dt = $doc->create_document_type_definition ('dt');
18     my $et = $doc->create_element_type_definition ('et1');
19     my $at = $doc->create_attribute_definition ('dattr1');
20     $at->default_type ($at->EXPLICIT_DEFAULT);
21     $at->text_content ('dattr1 default ');
22     $et->set_attribute_definition_node ($at);
23     $dt->set_element_type_definition_node ($et);
24     $doc->append_child ($dt);
25     my $el2 = $doc->create_element ('et1');
26    
27     ok 0+@{$el2->attributes}, 1, 'create_element->attributes @{} 0+ [1]';
28    
29     ok $el2->has_attribute ('dattr1') ? 1 : 0, 1, 'create_element->has_attr [1]';
30    
31     my $an = $el2->get_attribute_node ('dattr1');
32     ok UNIVERSAL::isa ($an, 'Message::IF::Attr') ? 1 : 0, 1, 'ce->def if [1]';
33     ok $an->text_content, 'dattr1 default ', 'ce->def tx [1]';
34     ok $an->specified ? 1 : 0, 0, 'ce->def specified [1]';
35    
36     $doc->dom_config->set_parameter
37     (q<http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute> => 0);
38    
39     my $el3 = $doc->create_element ('et1');
40     ok 0+@{$el3->attributes}, 0, 'create_element->attributes @{} 0+ [2]';
41     }
42    
43     {
44     my $doc = $dom->create_document;
45     my $el = $doc->create_element_ns (undef, 'et1');
46    
47     ok 0+@{$el->attributes}, 0, 'create_element->attributes @{} 0+ [0]';
48    
49     my $dt = $doc->create_document_type_definition ('dt');
50     my $et = $doc->create_element_type_definition ('et1');
51     my $at = $doc->create_attribute_definition ('dattr1');
52     $at->default_type ($at->EXPLICIT_DEFAULT);
53     $at->text_content ('dattr1 default ');
54     $et->set_attribute_definition_node ($at);
55     $dt->set_element_type_definition_node ($et);
56     $doc->append_child ($dt);
57     my $el2 = $doc->create_element ('et1');
58    
59     ok 0+@{$el2->attributes}, 1, 'create_element->attributes @{} 0+ [1]';
60    
61     ok $el2->has_attribute ('dattr1') ? 1 : 0, 1, 'create_element->has_attr [1]';
62    
63     my $an = $el2->get_attribute_node ('dattr1');
64     ok UNIVERSAL::isa ($an, 'Message::IF::Attr') ? 1 : 0, 1, 'ce->def if [1]';
65     ok $an->text_content, 'dattr1 default ', 'ce->def tx [1]';
66     ok $an->specified ? 1 : 0, 0, 'ce->def specified [1]';
67    
68     $doc->dom_config->set_parameter
69     (q<http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute> => 0);
70    
71     my $el3 = $doc->create_element ('et1');
72     ok 0+@{$el3->attributes}, 0, 'create_element->attributes @{} 0+ [2]';
73     }
74    
75 wakaba 1.1 my $doc = $dom->create_document;
76     my $el = $doc->create_element ('element');
77    
78     for my $prop (qw/manakai_base_uri/) {
79     ok $el->can ($prop) ? 1 : 0, 1, 'can ' . $prop;
80    
81     for ('http://absuri.test/', 'reluri', 0, '') {
82     $el->$prop ($_);
83     ok $el->$prop, $_, $prop . $_;
84     }
85    
86     $el->$prop (undef);
87     ok $el->$prop, undef, $prop . ' undef';
88     }
89    
90     for my $method (qw/set_attribute_node set_attribute_node_ns/) {
91     my $el = $doc->create_element ('element');
92     ok $el->can ($method) ? 1 : 0, 1, "can $method";
93    
94     my $a1 = $doc->create_attribute ('attr1');
95     $a1->value ('value1');
96     $a1->specified (0);
97    
98     my $r1 = $el->$method ($a1);
99     ok $r1, undef, "$method return [1]";
100     ok $el->get_attribute ('attr1'), 'value1', "$method get_attribute [1]";
101     ok $el->get_attribute_ns (undef, 'attr1'), 'value1',
102     "$method get_attribute_ns [1]";
103     ok $el->get_attribute_node ('attr1'), $a1, "$method get_attribute_node [1]";
104     ok $el->get_attribute_node_ns (undef, 'attr1'), $a1,
105     "$method get_attribute_node_ns [1]";
106     ok $a1->owner_element, $el, "$method owner_element [1]";
107     ok $a1->specified ? 1 : 0, 1, "$method specified [1]";
108     $a1->specified (0);
109    
110     my $a2 = $doc->create_attribute ('attr1');
111     my $r3 = $el->$method ($a2);
112     ok $r3, $a1, "$method return [2]";
113     ok $a1->owner_element, undef, "$method owner_element [2]";
114     ok $a1->specified ? 1 : 0, 1, "$method specified [2]";
115    
116     $el->set_attribute_ns (undef, attr => 'value');
117     my $attr = $el->get_attribute_node_ns (undef, 'attr');
118     $attr->specified (0);
119     my $r4 = $el->$method ($attr);
120     ok $r4, undef, "$method return [3]";
121     ok $attr->owner_element, $el, "$method owner_element [3]";
122     ok $attr->specified ? 1 : 0, 0, "$method specified [3]";
123     ok $el->get_attribute_node_ns (undef, 'attr'), $attr,
124     "$method get_attribute_node_ns [3]";
125     ok $el->get_attribute_ns (undef, 'attr'), 'value',
126     "$method get_attribute_ns [3]";
127     }
128    
129     =head1 LICENSE
130    
131     Copyright 2007 Wakaba <w@suika.fam.cx>
132    
133     This program is free software; you can redistribute it and/or
134     modify it under the same terms as Perl itself.
135    
136     =cut
137    
138 wakaba 1.2 ## $Date: 2007/06/17 13:37:42 $
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24