1 |
#!/usr/bin/perl |
2 |
use strict; |
3 |
use Test; |
4 |
BEGIN { plan tests => 55 } |
5 |
|
6 |
require Message::DOM::DOMImplementation; |
7 |
use Message::Util::Error; |
8 |
|
9 |
## TODO: |create_document| tests |
10 |
|
11 |
my $dom = Message::DOM::DOMImplementation->____new; |
12 |
my $doc = $dom->create_document; |
13 |
|
14 |
## AUTOLOAD test |
15 |
ok $doc->can ('create_element_ns') ? 1 : 0, 1, "can create_element_ns"; |
16 |
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 |
## NOTE: Tests for |create_*| methods found in |DOM-Node.t|. |
28 |
|
29 |
my $impl = $doc->implementation; |
30 |
ok UNIVERSAL::isa ($impl, 'Message::IF::DOMImplementation') ? 1 : 0, 1; |
31 |
|
32 |
## |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 |
for my $prop (qw/document_uri input_encoding/) { |
160 |
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 |
for my $prop (qw/all_declarations_processed/) { |
172 |
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 |
## |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 |
## TODO: manakai_entity_base_uri |
251 |
|
252 |
=head1 LICENSE |
253 |
|
254 |
Copyright 2007 Wakaba <w@suika.fam.cx> |
255 |
|
256 |
This program is free software; you can redistribute it and/or |
257 |
modify it under the same terms as Perl itself. |
258 |
|
259 |
=cut |
260 |
|
261 |
## $Date: 2007/06/17 13:37:42 $ |