/[suikacvs]/messaging/manakai/t/markup-xml-node.t
Suika

Contents of /messaging/manakai/t/markup-xml-node.t

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.2 - (show annotations) (download) (as text)
Sun Nov 9 01:46:09 2003 UTC (21 years ago) by wakaba
Branch: MAIN
CVS Tags: before-dis2-200411, manakai-release-0-3-2, manakai-release-0-3-1, manakai-release-0-4-0, manakai-200612, HEAD
Branch point for: experimental-xml-parser-200401
Changes since 1.1: +90 -66 lines
File MIME type: application/x-troff 
New test for 'xml:' special prefix
1 #!/usr/bin/perl -w
2 use strict;
3 require Test::Simple;
4 use Message::Markup::XML::Node qw(SGML_NCR SGML_HEX_CHAR_REF
5 SGML_ATTLIST SGML_ELEMENT
6 SGML_GENERAL_ENTITY SGML_PARAM_ENTITY
7 SGML_NOTATION SGML_DOCTYPE
8 XML_ATTLIST);
9 use Message::Markup::XML::QName qw:DEFAULT_PFX NS_xml_URI NULL_URI:;
10 my $NODEMOD = 'Message::Markup::XML::Node';
11
12 sub OK ($$;$) {
13 my ($result, $expect, $testname) = @_;
14 my @expect = ref $expect ?@ $expect : ($expect);
15 for (@expect) {
16 if ($_ eq $result) {
17 ok (1);
18 return;
19 }
20 }
21 my $e = sub {
22 my $s = shift;
23 $s =~ s/\t/\\t/g;
24 $s;
25 };
26 ok (0, sprintf '%s: "%s" ("%s" expected)', ($testname || 'Node'),
27 $e->($result), join '" or "', map {$e->($_)} @expect);
28 }
29
30 my $tests = 0;
31
32 ## Simple serialization
33 my @s = (
34 {
35 main => sub {
36 my $n = $NODEMOD->new (type => '#element',
37 namespace_uri => NULL_URI,
38 local_name => 'foo');
39 OK $n->outer_xml, q<<foo xmlns=""></foo>>,
40 'Simple default-null-ns element';
41 },
42 },
43 {
44 main => sub {
45 my $n = $NODEMOD->new (type => '#element',
46 local_name => 'foo');
47 OK $n->outer_xml, q<<foo xmlns=""></foo>>,
48 'Simple default-null-ns element';
49 },
50 },
51 {
52 main => sub {
53 my $n = $NODEMOD->new (type => '#element',
54 namespace_uri => q<http://uri.example/>,
55 local_name => 'foo');
56 OK $n->outer_xml,
57 [q<<foo xmlns="http://uri.example/"></foo>>,
58 q<<uri.example:foo xmlns:uri.example="http://uri.example/"></uri.example:foo>>],
59 'Simple default-or-non-default-non-null-ns element';
60 },
61 },
62 {
63 main => sub {
64 my $n = $NODEMOD->new (type => '#element',
65 namespace_uri => q<http://uri.example/>,
66 local_name => 'foo');
67 $n->define_new_namespace ((DEFAULT_PFX) => q<http://uri.example/>);
68 OK $n->outer_xml,
69 q<<foo xmlns="http://uri.example/"></foo>>,
70 'Simple default-non-null-ns element';
71 },
72 },
73 {
74 main => sub {
75 my $n = $NODEMOD->new (type => '#element',
76 namespace_uri => q<http://uri.example/>,
77 local_name => 'foo');
78 $n->define_new_namespace (a => q<http://uri.example/>);
79 OK $n->outer_xml,
80 q<<a:foo xmlns:a="http://uri.example/"></a:foo>>,
81 'Simple non-default-non-null-ns element';
82 },
83 },
84 {
85 main => sub {
86 my $n = $NODEMOD->new (type => '#element',
87 namespace_uri => q<http://uri.example/>,
88 qname => 'bar:foo');
89 OK $n->outer_xml, q<<bar:foo xmlns:bar="http://uri.example/"></bar:foo>>,
90 'Simple non-null-ns element';
91 },
92 },
93 {
94 main => sub {
95 my $n = $NODEMOD->new (type => '#element',
96 namespace_uri => NULL_URI,
97 qname => 'bar:foo');
98 OK $n->outer_xml, q<<foo xmlns=""></foo>>,
99 'Simple null-ns element its QName is given as coloned name';
100 },
101 },
102
103 {
104 main => sub {
105 my $n = $NODEMOD->new (type => '#element',
106 namespace_uri => NULL_URI,
107 local_name => 'foo');
108 $n->append_new_node (type => '#element',
109 namespace_uri => NULL_URI,
110 local_name => 'bar');
111 OK $n->outer_xml, q<<foo xmlns=""><bar></bar></foo>>;
112 },
113 },
114 {
115 main => sub {
116 my $n = $NODEMOD->new (type => '#element',
117 namespace_uri => NULL_URI,
118 local_name => 'foo');
119 $n->append_new_node (type => '#element',
120 namespace_uri => q<http://nonnull.example/b>,
121 local_name => 'bar');
122 OK $n->outer_xml,
123 [q<<foo xmlns=""><b:bar xmlns:b="http://nonnull.example/b"></b:bar></foo>>,
124 q<<foo xmlns="" xmlns:b="http://nonnull.example/b"><b:bar></b:bar></foo>>];
125 },
126 },
127 {
128 main => sub {
129 my $n = $NODEMOD->new (type => '#element',
130 namespace_uri => NULL_URI,
131 local_name => 'foo');
132 $n->append_new_node (type => '#element',
133 namespace_uri => q<http://nonnull.example/b>,
134 local_name => 'bar')
135 ->define_new_namespace (c => q<http://nonnull.example/b>);
136 OK $n->outer_xml,
137 q<<foo xmlns=""><c:bar xmlns:c="http://nonnull.example/b"></c:bar></foo>>;
138 },
139 },
140 {
141 main => sub {
142 my $n = $NODEMOD->new (type => '#element',
143 namespace_uri => NULL_URI,
144 local_name => 'foo');
145 $n->append_new_node (type => '#element',
146 namespace_uri => q<http://nonnull.example/b>,
147 local_name => 'bar');
148 $n->define_new_namespace (c => q<http://nonnull.example/b>);
149 OK $n->outer_xml,
150 q<<foo xmlns="" xmlns:c="http://nonnull.example/b"><c:bar></c:bar></foo>>;
151 },
152 },
153 {
154 main => sub {
155 my $n = $NODEMOD->new (type => '#element',
156 namespace_uri => NULL_URI,
157 local_name => 'foo');
158 $n->append_new_node (type => '#element',
159 namespace_uri => q<http://nonnull.example/b>,
160 local_name => 'bar');
161 $n->define_new_namespace ((DEFAULT_PFX) => q<http://nonnull.example/b>);
162 OK $n->outer_xml,
163 [q<<foo xmlns=""><b:bar xmlns:b="http://nonnull.example/b"></b:bar></foo>>,
164 q<<foo xmlns="" xmlns:b="http://nonnull.example/b"><b:bar></b:bar></foo>>],
165 'Explicit attempt to associate to default prefix should be overwriten by NULL_URI';
166 },
167 },
168 {
169 main => sub {
170 my $n = $NODEMOD->new (type => '#element',
171 namespace_uri => q<http://nonnull.example/b>,
172 local_name => 'foo');
173 $n->append_new_node (type => '#element',
174 namespace_uri => NULL_URI,
175 local_name => 'bar');
176 OK $n->outer_xml,
177 [q<<b:foo xmlns:b="http://nonnull.example/b"><bar xmlns=""></bar></b:foo>>,
178 q<<b:foo xmlns="" xmlns:b="http://nonnull.example/b"><bar></bar></b:foo>>];
179 },
180 },
181 {
182 main => sub {
183 my $n = $NODEMOD->new (type => '#element',
184 namespace_uri => q<http://nonnull.example/b>,
185 local_name => 'foo');
186 $n->define_new_namespace ((DEFAULT_PFX) => q<http://nonnull.example/b>);
187 $n->append_new_node (type => '#element',
188 namespace_uri => NULL_URI,
189 local_name => 'bar');
190 OK $n->outer_xml,
191 q<<foo xmlns="http://nonnull.example/b"><bar xmlns=""></bar></foo>>;
192 },
193 },
194 {
195 main => sub {
196 my $n = $NODEMOD->new (type => '#element',
197 namespace_uri => q<http://nonnull.example/b>,
198 local_name => 'foo');
199 $n->append_new_node (type => '#element',
200 namespace_uri => q<http://nonnull.example/b>,
201 local_name => 'bar');
202 OK $n->outer_xml, q<<b:foo xmlns:b="http://nonnull.example/b"><b:bar></b:bar></b:foo>>;
203 },
204 },
205
206 {
207 main => sub {
208 my $n = $NODEMOD->new (type => '#element',
209 namespace_uri => NULL_URI,
210 local_name => 'foo');
211 $n->define_new_namespace ((DEFAULT_PFX) => q<http://s.example/>);
212 OK $n->outer_xml,
213 [
214 q<<foo xmlns=""></foo>>, # current implementation
215 q<<foo xmlns="" xmlns:s.example="http://s.example/"></foo>>,
216 ],
217 '';
218 },
219 },
220 {
221 main => sub {
222 my $n = $NODEMOD->new (type => '#element',
223 namespace_uri => q<http://nonnull.example/n>,
224 local_name => 'foo');
225 $n->define_new_namespace ((DEFAULT_PFX) => q<http://s.example/>);
226 OK $n->outer_xml,
227 [
228 q<<n:foo xmlns="http://s.example/" xmlns:n="http://nonnull.example/n"></n:foo>>,
229 ],
230 '';
231 },
232 },
233 {
234 main => sub {
235 my $n = $NODEMOD->new (type => '#element',
236 namespace_uri => NULL_URI,
237 local_name => 'foo');
238 $n->define_new_namespace (s => q<http://s.example/>);
239 OK $n->outer_xml,
240 [
241 q<<foo xmlns="" xmlns:s="http://s.example/"></foo>>,
242 ],
243 'Non-used namespace declaration should also be preserved';
244 },
245 },
246 {
247 main => sub {
248 my $n = $NODEMOD->new (type => '#element',
249 namespace_uri => q<http://nonnull.example/n>,
250 local_name => 'foo');
251 $n->define_new_namespace (s => q<http://s.example/>);
252 OK $n->outer_xml,
253 [
254 q<<n:foo xmlns:n="http://nonnull.example/n" xmlns:s="http://s.example/"></n:foo>>,
255 ],
256 'Non-used namespace declaration should also be preserved';
257 },
258 },
259
260 {
261 main => sub {
262 my $n = $NODEMOD->new (type => '#element',
263 namespace_uri => NULL_URI,
264 local_name => 'foo');
265 $n->set_attribute (foo => 'bar');
266 OK $n->outer_xml,
267 [q<<foo xmlns="" foo="bar"></foo>>,
268 q<<foo foo="bar" xmlns=""></foo>>];
269 },
270 },
271 {
272 main => sub {
273 my $n = $NODEMOD->new (type => '#element',
274 namespace_uri => q<http://nonnull.example/b>,
275 local_name => 'foo');
276 $n->set_attribute (foo => 'bar');
277 OK $n->outer_xml,
278 [q<<b:foo xmlns:b="http://nonnull.example/b" foo="bar"></b:foo>>,
279 q<<b:foo foo="bar" xmlns:b="http://nonnull.example/b"></b:foo>>];
280 },
281 },
282 {
283 main => sub {
284 my $n = $NODEMOD->new (type => '#element', local_name => 'foo',
285 namespace_uri => NULL_URI);
286 $n->set_attribute (foo => 'bar', namespace_uri => q<about:blank#n>);
287 OK $n->outer_xml,
288 [q<<foo xmlns="" xmlns:n="about:blank#n" n:foo="bar"></foo>>,
289 q<<foo n:foo="bar" xmlns="" xmlns:n="about:blank#n"></foo>>];
290 },
291 },
292 {
293 main => sub {
294 my $n = $NODEMOD->new (type => '#element', local_name => 'foo',
295 namespace_uri => q<about:blank#n>);
296 $n->set_attribute (foo => 'bar', namespace_uri => q<about:blank#n>);
297 OK $n->outer_xml,
298 [q<<n:foo xmlns:n="about:blank#n" n:foo="bar"></n:foo>>,
299 q<<n:foo n:foo="bar" xmlns:n="about:blank#n"></n:foo>>];
300 },
301 },
302 {
303 main => sub {
304 my $n = $NODEMOD->new (type => '#element', local_name => 'foo',
305 namespace_uri => q<about:blank#n>);
306 $n->set_attribute (foo => 'bar', namespace_uri => q<about:blank#n>);
307 $n->define_new_namespace ((DEFAULT_PFX) => q<about:blank#n>);
308 OK $n->outer_xml,
309 [q<<foo xmlns="about:blank#n" xmlns:n="about:blank#n" n:foo="bar"></foo>>,
310 q<<foo n:foo="bar" xmlns="about:blank#n" xmlns:n="about:blank#n"></foo>>,
311 q<<n:foo xmlns="about:blank#n" xmlns:n="about:blank#n" n:foo="bar"></n:foo>>,
312 q<<n:foo n:foo="bar" xmlns="about:blank#n" xmlns:n="about:blank#n"></n:foo>>];
313 },
314 },
315 {
316 main => sub {
317 my $n = $NODEMOD->new (type => '#element', local_name => 'foo',
318 namespace_uri => q<about:blank#n>);
319 $n->set_attribute (foo => 'bar', namespace_uri => q<about:blank#n>);
320 $n->define_new_namespace (p => q<about:blank#n>);
321 OK $n->outer_xml,
322 [q<<p:foo xmlns:p="about:blank#n" p:foo="bar"></p:foo>>,
323 q<<p:foo p:foo="bar" xmlns:p="about:blank#n"></p:foo>>];
324 },
325 },
326
327 {
328 main => sub {
329 my $n = $NODEMOD->new (type => '#element', local_name => 'foo',
330 namespace_uri => NULL_URI);
331 $n->set_attribute (foo => '<bar&foo>');
332 OK $n->outer_xml,
333 [q<<foo foo="&lt;bar&amp;foo&gt;" xmlns=""></foo>>],
334 'Attribute value should be escaped';
335 },
336 },
337 {
338 main => sub {
339 my $n = $NODEMOD->new (type => '#element', local_name => 'foo',
340 namespace_uri => NULL_URI);
341 $n->set_attribute (foo => 'foo"and"bar');
342 OK $n->outer_xml,
343 [q<<foo foo="foo&quot;and&quot;bar" xmlns=""></foo>>,
344 q<<foo foo='foo"and"bar' xmlns=""></foo>>,],
345 'Attribute value should be escaped';
346 },
347 },
348 {
349 main => sub {
350 my $n = $NODEMOD->new (type => '#element', local_name => 'foo',
351 namespace_uri => NULL_URI);
352 $n->set_attribute (foo => "foo'and'bar");
353 OK $n->outer_xml,
354 [q<<foo foo="foo'and'bar" xmlns=""></foo>>,
355 q<<foo foo='foo&apos;and&apos;bar' xmlns=""></foo>>,],
356 'Attribute value should be escaped';
357 },
358 },
359 {
360 main => sub {
361 my $n = $NODEMOD->new (type => '#element', local_name => 'foo',
362 namespace_uri => NULL_URI);
363 $n->set_attribute (foo => q(foo"and'bar));
364 OK $n->outer_xml,
365 [q<<foo foo="foo&quot;and'bar" xmlns=""></foo>>,
366 q<<foo foo='foo"and&apos;bar' xmlns=""></foo>>,],
367 'Attribute value should be escaped';
368 },
369 },
370
371 {
372 main => sub {
373 my $n = $NODEMOD->new (type => '#element', local_name => 'foo',
374 namespace_uri => NULL_URI);
375 $n->append_text ('text');
376 OK $n->outer_xml,
377 [q<<foo xmlns="">text</foo>>],
378 'text node';
379 },
380 },
381 {
382 main => sub {
383 my $n = $NODEMOD->new (type => '#element', local_name => 'foo',
384 namespace_uri => NULL_URI);
385 $n->append_text ('<te&xt>');
386 OK $n->outer_xml,
387 [q<<foo xmlns="">&lt;te&amp;xt&gt;</foo>>],
388 'text should be escaped';
389 },
390 },
391 {
392 main => sub {
393 my $n = $NODEMOD->new (type => '#element', local_name => 'foo',
394 namespace_uri => NULL_URI);
395 $n->append_text (q(ab"cd'ef));
396 OK $n->outer_xml,
397 [q<<foo xmlns="">ab"cd'ef</foo>>,
398 q<<foo xmlns="">ab&quot;cd'ef</foo>>,
399 q<<foo xmlns="">ab&quot;cd&apos;ef</foo>>],
400 'text can be escaped';
401 },
402 },
403
404 {
405 main => sub {
406 my $n = $NODEMOD->new (type => '#comment', value => 'Something');
407 OK $n->outer_xml,
408 [q<<!--Something-->>];
409 },
410 },
411 {
412 main => sub {
413 my $n = $NODEMOD->new (type => '#comment', value => 'Some--thing');
414 OK $n->outer_xml,
415 [q<<!--Some- -thing-->>,
416 q<<!--Some-&#x2D;thing-->>,
417 q<<!--Some-&#45;thing-->>];
418 },
419 },
420 {
421 main => sub {
422 my $n = $NODEMOD->new (type => '#comment', value => 'Some---thing');
423 OK $n->outer_xml,
424 [q<<!--Some- - -thing-->>,
425 q<<!--Some-&#x2D;-thing-->>,
426 q<<!--Some-&#45;-thing-->>];
427 },
428 },
429 {
430 main => sub {
431 my $n = $NODEMOD->new (type => '#comment', value => 'Some----thing');
432 OK $n->outer_xml,
433 [q<<!--Some- - - -thing-->>,
434 q<<!--Some-&#x2D;-&#x2D;thing-->>,
435 q<<!--Some-&#45;-&#45;thing-->>];
436 },
437 },
438 {
439 main => sub {
440 my $n = $NODEMOD->new (type => '#comment', value => 'Something-');
441 OK $n->outer_xml,
442 [q<<!--Something- -->>,
443 q<<!--Something&#x2D;-->>,
444 q<<!--Something&#45;-->>];
445 },
446 },
447 {
448 main => sub {
449 my $n = $NODEMOD->new (type => '#comment', value => 'Something--');
450 OK $n->outer_xml,
451 [q<<!--Something- - -->>,
452 q<<!--Something-&#x2D;-->>,
453 q<<!--Something-&#45;-->>];
454 },
455 },
456
457 {
458 main => sub {
459 my $n = $NODEMOD->new (type => '#pi', local_name => 'target');
460 OK $n->outer_xml,
461 [q<<?target?>>],
462 'Only target-name PI';
463 },
464 },
465 {
466 main => sub {
467 my $n = $NODEMOD->new (type => '#pi', local_name => 'target',
468 value => 'DO SOMETHING');
469 OK $n->outer_xml,
470 [q<<?target DO SOMETHING?>>],
471 'PI with target data';
472 },
473 },
474 {
475 main => sub {
476 my $n = $NODEMOD->new (type => '#pi', local_name => 'target',
477 value => 'DO?>SOMETHING');
478 OK $n->outer_xml,
479 [q{<?target DO? >SOMETHING?>},
480 q<<?target DO?&gt;SOMETHING?>>],
481 'PI with target data including pic';
482 },
483 },
484
485 {
486 main => sub {
487 my $n = $NODEMOD->new (type => '#pi', local_name => 'target');
488 $n->set_attribute (name => 'value');
489 OK $n->outer_xml,
490 [q<<?target name="value"?>>],
491 'PI with pseudo attribute';
492 },
493 },
494 {
495 main => sub {
496 my $n = $NODEMOD->new (type => '#pi', local_name => 'target');
497 $n->set_attribute (name => 'value');
498 $n->set_attribute (name2 => 'value');
499 OK $n->outer_xml,
500 [q<<?target name="value" name2="value"?>>],
501 'PI with pseudo attributes';
502 },
503 },
504 {
505 main => sub {
506 my $n = $NODEMOD->new (type => '#pi', local_name => 'target');
507 $n->set_attribute (name => 'val?>ue');
508 OK $n->outer_xml,
509 [q{<?target name="val? >ue"?>},
510 q<<?target name="val?&gt;ue"?>>],
511 'PI with pseudo attribute including pic';
512 },
513 },
514
515 {
516 main => sub {
517 my $n = $NODEMOD->new (type => '#section',
518 value => 'character data');
519 $n->set_attribute (status => 'CDATA');
520 OK $n->outer_xml,
521 [q<<![CDATA[character data]]>>],
522 'CDATA section';
523 },
524 },
525 {
526 main => sub {
527 my $n = $NODEMOD->new (type => '#section',
528 value => q("character"'s & <data>));
529 $n->set_attribute (status => 'CDATA');
530 OK $n->outer_xml,
531 [q<<![CDATA["character"'s & <data>]]>>],
532 'CDATA section with delimiters';
533 },
534 },
535 {
536 main => sub {
537 my $n = $NODEMOD->new (type => '#section',
538 value => q(<[[character ]]> data));
539 $n->set_attribute (status => 'CDATA');
540 OK $n->outer_xml,
541 [q<<![CDATA[<[[character ]]]]><![CDATA[> data]]>>,
542 q<<![CDATA[<[[character ]]>]]<![CDATA[> data]]>>],
543 'CDATA section with mse';
544 },
545 },
546
547 {
548 main => sub {
549 my $n = $NODEMOD->new (type => '#section');
550 $n->set_attribute (status => 'INCLUDE');
551 $n->append_new_node (type => '#comment');
552 OK $n->outer_xml,
553 [q<<![INCLUDE[<!---->]]>>],
554 'INCLUDE section';
555 },
556 },
557 {
558 main => sub {
559 my $n = $NODEMOD->new (type => '#section');
560 $n->set_attribute (status => 'INCLUDE');
561 $n->append_new_node (type => '#comment', value => ']]>');
562 OK $n->outer_xml,
563 [q{<![INCLUDE[<!--]]>-->]]>}],
564 'INCLUDE section';
565 },
566 },
567 {
568 main => sub {
569 my $n = $NODEMOD->new (type => '#section');
570 $n->set_attribute (status => 'INCLUDE');
571 $n->append_new_node (type => '#section')
572 ->set_attribute (status => 'INCLUDE');
573 OK $n->outer_xml,
574 [q<<![INCLUDE[<![INCLUDE[]]>]]>>],
575 'nested INCLUDE section';
576 },
577 },
578
579 {
580 main => sub {
581 my $n = $NODEMOD->new (type => '#section');
582 $n->set_attribute (status => 'IGNORE');
583 $n->append_new_node (type => '#comment');
584 OK $n->outer_xml,
585 [q<<![IGNORE[<!---->]]>>],
586 'IGNORE section';
587 },
588 },
589 {
590 main => sub {
591 my $n = $NODEMOD->new (type => '#section');
592 $n->set_attribute (status => 'IGNORE');
593 $n->append_new_node (type => '#comment', value => '<![[]]>');
594 OK $n->outer_xml,
595 [q<<![IGNORE[<!--<![[]]>-->]]>>],
596 'IGNORE section';
597 },
598 },
599 {
600 main => sub {
601 my $n = $NODEMOD->new (type => '#section');
602 $n->set_attribute (status => 'IGNORE');
603 $n->append_new_node (type => '#section')
604 ->set_attribute (status => 'IGNORE');
605 OK $n->outer_xml,
606 [q<<![IGNORE[<![IGNORE[]]>]]>>],
607 'nested IGNORE section';
608 },
609 },
610 {
611 main => sub {
612 my $n = $NODEMOD->new (type => '#section');
613 $n->set_attribute (status => 'IGNORE');
614 $n->append_new_node (type => '#section');
615 OK $n->outer_xml,
616 [q<<![IGNORE[<![[]]>]]>>],
617 'Anomymous section in IGNORE section';
618 },
619 },
620 {
621 main => sub {
622 my $n = $NODEMOD->new (type => '#section');
623 $n->set_attribute (status => 'IGNORE');
624 $n->append_new_node (type => '#xml', value => '<![freetext]]>');
625 OK $n->outer_xml,
626 [q<<![IGNORE[<![freetext]]>]]>>],
627 'Freetext in IGNORE section';
628 },
629 },
630
631 {
632 main => sub {
633 my $n = $NODEMOD->new (type => '#reference',
634 namespace_uri => SGML_GENERAL_ENTITY,
635 local_name => 'ent');
636 OK $n->outer_xml,
637 [q<&ent;>],
638 'A general entity reference';
639 },
640 },
641 {
642 main => sub {
643 my $n = $NODEMOD->new (type => '#reference',
644 namespace_uri => SGML_PARAM_ENTITY,
645 local_name => 'ent');
646 OK $n->outer_xml,
647 [q<%ent;>],
648 'A parameter entity reference';
649 },
650 },
651 {
652 main => sub {
653 my $n = $NODEMOD->new (type => '#reference',
654 namespace_uri => SGML_NCR,
655 value => 0x0020);
656 OK $n->outer_xml,
657 [q<&#32;>],
658 'A numeric character reference';
659 },
660 },
661 {
662 main => sub {
663 my $n = $NODEMOD->new (type => '#reference',
664 namespace_uri => SGML_NCR,
665 value => 0x0000);
666 OK $n->outer_xml,
667 [q<&#0;>, q<&#00;>],
668 'A numeric character reference (invalid in XML)';
669 },
670 },
671 {
672 main => sub {
673 my $n = $NODEMOD->new (type => '#reference',
674 namespace_uri => SGML_HEX_CHAR_REF,
675 value => 0x0020);
676 OK $n->outer_xml,
677 [q<&#x20;>, q<&#x0020;>, q<&#x000020;>, q<&#x00000020;>],
678 'A hex character reference';
679 },
680 },
681 {
682 main => sub {
683 my $n = $NODEMOD->new (type => '#reference',
684 namespace_uri => SGML_HEX_CHAR_REF,
685 value => 0x0000);
686 OK $n->outer_xml,
687 [q<&#x0;>, q<&#x00;>, q<&#x0000;>, q<&#x000000;>,
688 q<&#x00000000;>],
689 'A hex character reference (invalid in XML)';
690 },
691 },
692
693 {
694 main => sub {
695 my $n = $NODEMOD->new (type => '#declaration',
696 namespace_uri => SGML_GENERAL_ENTITY,
697 local_name => 'foo');
698 OK $n->outer_xml,
699 [q<<!ENTITY foo "">>],
700 'ENTITY declaration';
701 },
702 },
703 {
704 main => sub {
705 my $n = $NODEMOD->new (type => '#declaration',
706 namespace_uri => SGML_GENERAL_ENTITY,
707 local_name => 'foo');
708 $n->set_attribute (value => '<Entity&Value>');
709 OK $n->outer_xml,
710 [q<<!ENTITY foo "<Entity&#x26;Value>">>],
711 'ENTITY declaration with EntityValue';
712 },
713 },
714 {
715 main => sub {
716 my $n = $NODEMOD->new (type => '#declaration',
717 namespace_uri => SGML_GENERAL_ENTITY,
718 local_name => 'foo');
719 $n->append_new_node (type => '#reference',
720 namespace_uri => SGML_PARAM_ENTITY,
721 local_name => 'foo.val');
722 OK $n->outer_xml,
723 [q<<!ENTITY foo %foo.val;>>],
724 'ENTITY declaration with parameter ref';
725 },
726 },
727 {
728 main => sub {
729 my $n = $NODEMOD->new (type => '#declaration',
730 namespace_uri => SGML_GENERAL_ENTITY);
731 $n->append_new_node (type => '#reference',
732 namespace_uri => SGML_PARAM_ENTITY,
733 local_name => 'foo.val');
734 OK $n->outer_xml,
735 [q<<!ENTITY %foo.val;>>],
736 'ENTITY declaration with parameter ref';
737 },
738 },
739 {
740 main => sub {
741 my $n = $NODEMOD->new (type => '#declaration',
742 namespace_uri => SGML_PARAM_ENTITY);
743 $n->append_new_node (type => '#reference',
744 namespace_uri => SGML_PARAM_ENTITY,
745 local_name => 'foo.val');
746 OK $n->outer_xml,
747 [q<<!ENTITY % %foo.val;>>],
748 'ENTITY declaration with parameter ref';
749 },
750 },
751 {
752 main => sub {
753 my $n = $NODEMOD->new (type => '#declaration',
754 namespace_uri => SGML_GENERAL_ENTITY,
755 local_name => 'foo');
756 $n->set_attribute (SYSTEM => q<http://foo.example/xml>);
757 OK $n->outer_xml,
758 [q<<!ENTITY foo SYSTEM "http://foo.example/xml">>],
759 'ENTITY declaration with SYSTEM';
760 },
761 },
762 {
763 main => sub {
764 my $n = $NODEMOD->new (type => '#declaration',
765 namespace_uri => SGML_GENERAL_ENTITY,
766 local_name => 'foo');
767 $n->set_attribute (PUBLIC => q"+//IDN foo.example//DTD foo//EN");
768 $n->set_attribute (SYSTEM => q<http://foo.example/xml>);
769 OK $n->outer_xml,
770 [q<<!ENTITY foo PUBLIC "+//IDN foo.example//DTD foo//EN" "http://foo.example/xml">>],
771 'ENTITY declaration with PUBLIC';
772 },
773 },
774
775 {
776 main => sub {
777 my $n = $NODEMOD->new (type => '#declaration',
778 namespace_uri => SGML_NOTATION,
779 local_name => 'f');
780 $n->set_attribute (PUBLIC => q"+//IDN f.example//NOTATION f//EN");
781 OK $n->outer_xml,
782 [q<<!NOTATION f PUBLIC "+//IDN f.example//NOTATION f//EN">>],
783 'NOTATION declaration with PUBLIC';
784 },
785 },
786 {
787 main => sub {
788 my $n = $NODEMOD->new (type => '#declaration',
789 namespace_uri => SGML_NOTATION,
790 local_name => 'f');
791 $n->set_attribute (SYSTEM => q<http://f.example/>);
792 OK $n->outer_xml,
793 [q<<!NOTATION f SYSTEM "http://f.example/">>],
794 'NOTATION declaration with SYSTEM';
795 },
796 },
797 {
798 main => sub {
799 my $n = $NODEMOD->new (type => '#declaration',
800 namespace_uri => SGML_NOTATION,
801 local_name => 'f');
802 $n->set_attribute (PUBLIC => q"+//IDN f.example//NOTATION f//EN");
803 $n->set_attribute (SYSTEM => q<http://f.example/>);
804 OK $n->outer_xml,
805 [q<<!NOTATION f PUBLIC "+//IDN f.example//NOTATION f//EN" "http://f.example/">>],
806 'NOTATION declaration with PUBLIC and SYSTEM';
807 },
808 },
809
810 {
811 main => sub {
812 my $n = $NODEMOD->new (type => '#declaration',
813 namespace_uri => SGML_ATTLIST);
814 $n->set_attribute (qname => 'foo');
815 OK $n->outer_xml,
816 [q<<!ATTLIST foo>>, q<<!ATTLIST foo >>],
817 'An empty ATTLIST';
818 },
819 },
820 {
821 main => sub {
822 my $n = $NODEMOD->new (type => '#declaration',
823 namespace_uri => SGML_ATTLIST);
824 $n->set_attribute (qname => 'foo:bar');
825 OK $n->outer_xml,
826 [q<<!ATTLIST foo:bar>>, q<<!ATTLIST foo:bar >>],
827 'An empty ATTLIST with prefixed name';
828 },
829 },
830 {
831 main => sub {
832 my $n = $NODEMOD->new (type => '#declaration',
833 namespace_uri => SGML_ATTLIST);
834 $n->set_attribute (qname => 'foo');
835 my $attr = $n->append_new_node (type => '#element',
836 namespace_uri => XML_ATTLIST,
837 local_name => 'AttDef');
838 $attr->set_attribute (qname => 'bar');
839 $attr->set_attribute (type => 'CDATA');
840 $attr->set_attribute (default_type => 'REQUIRED');
841 OK $n->outer_xml,
842 [qq<<!ATTLIST foo\n\tbar\tCDATA\t#REQUIRED>>];
843 },
844 },
845 {
846 main => sub {
847 my $n = $NODEMOD->new (type => '#declaration',
848 namespace_uri => SGML_ATTLIST);
849 $n->set_attribute (qname => 'foo');
850 my $attr = $n->append_new_node (type => '#element',
851 namespace_uri => XML_ATTLIST,
852 local_name => 'AttDef');
853 $attr->set_attribute (qname => 'bar');
854 my $att2 = $n->append_new_node (type => '#element',
855 namespace_uri => XML_ATTLIST,
856 local_name => 'AttDef');
857 $att2->set_attribute (qname => 'ba2');
858 OK $n->outer_xml,
859 [qq<<!ATTLIST foo\n\tbar\tCDATA\t""\n\tba2\tCDATA\t"">>];
860 },
861 },
862 {
863 main => sub {
864 my $n = $NODEMOD->new (type => '#declaration',
865 namespace_uri => SGML_ATTLIST);
866 $n->set_attribute (qname => 'foo');
867 my $attr = $n->append_new_node (type => '#element',
868 namespace_uri => XML_ATTLIST,
869 local_name => 'AttDef');
870 $attr->set_attribute (qname => 'bar');
871 $attr->set_attribute (type => 'enum');
872 $attr->append_new_node (type => '#element',
873 namespace_uri => XML_ATTLIST,
874 local_name => 'enum')
875 ->append_text ('enum1');
876 $attr->append_new_node (type => '#element',
877 namespace_uri => XML_ATTLIST,
878 local_name => 'enum')
879 ->append_text ('enum2');
880 $attr->set_attribute (default_value => 'enum2');
881 OK $n->outer_xml,
882 [qq<<!ATTLIST foo\n\tbar\t(enum1|enum2)\t"enum2">>];
883 },
884 },
885 {
886 main => sub {
887 my $n = $NODEMOD->new (type => '#declaration',
888 namespace_uri => SGML_ATTLIST);
889 $n->set_attribute (qname => 'foo');
890 my $attr = $n->append_new_node (type => '#element',
891 namespace_uri => XML_ATTLIST,
892 local_name => 'AttDef');
893 $attr->set_attribute (qname => 'bar');
894 $attr->set_attribute (type => 'NOTATION');
895 $attr->append_new_node (type => '#element',
896 namespace_uri => XML_ATTLIST,
897 local_name => 'enum')
898 ->append_text ('enum1');
899 $attr->set_attribute (default_type => 'FIXED');
900 $attr->set_attribute (default_value => 'enum1');
901 OK $n->outer_xml,
902 [qq<<!ATTLIST foo\n\tbar\tNOTATION\t(enum1)\t#FIXED\t"enum1">>];
903 },
904 },
905 {
906 main => sub {
907 my $n = $NODEMOD->new (type => '#declaration',
908 namespace_uri => SGML_ATTLIST);
909 $n->append_new_node (type => '#reference',
910 namespace_uri => SGML_PARAM_ENTITY,
911 local_name => 'bar');
912 OK $n->outer_xml,
913 [qq<<!ATTLIST %bar;>>];
914 },
915 },
916
917 {
918 main => sub {
919 my $n = $NODEMOD->new (type => '#declaration',
920 namespace_uri => SGML_ELEMENT);
921 $n->set_attribute (qname => 'foo');
922 OK $n->outer_xml,
923 [qq<<!ELEMENT foo EMPTY>>];
924 },
925 },
926 {
927 main => sub {
928 my $n = $NODEMOD->new (type => '#declaration',
929 namespace_uri => SGML_ELEMENT);
930 $n->set_attribute (qname => 'foo:bar');
931 OK $n->outer_xml,
932 [qq<<!ELEMENT foo:bar EMPTY>>];
933 },
934 },
935 {
936 main => sub {
937 my $n = $NODEMOD->new (type => '#declaration',
938 namespace_uri => SGML_ELEMENT);
939 $n->append_new_node (type => '#reference',
940 namespace_uri => SGML_PARAM_ENTITY,
941 local_name => 'bar');
942 OK $n->outer_xml,
943 [qq<<!ELEMENT %bar;>>];
944 },
945 },
946 {
947 main => sub {
948 my $n = $NODEMOD->new (type => '#declaration',
949 namespace_uri => SGML_ELEMENT);
950 $n->set_attribute (qname => 'foo');
951 $n->set_attribute (content => 'element');
952 my $g = $n->append_new_node (type => '#element',
953 namespace_uri => SGML_ELEMENT,
954 local_name => 'group');
955 $g->append_new_node (type => '#element',
956 namespace_uri => SGML_ELEMENT,
957 local_name => 'element')
958 ->set_attribute (qname => 'e');
959 OK $n->outer_xml,
960 [qq<<!ELEMENT foo (e)>>];
961 },
962 },
963 {
964 main => sub {
965 my $n = $NODEMOD->new (type => '#declaration',
966 namespace_uri => SGML_ELEMENT);
967 $n->set_attribute (qname => 'foo');
968 $n->set_attribute (content => 'element');
969 my $g = $n->append_new_node (type => '#element',
970 namespace_uri => SGML_ELEMENT,
971 local_name => 'group');
972 my $e = $g->append_new_node (type => '#element',
973 namespace_uri => SGML_ELEMENT,
974 local_name => 'element');
975 $e->set_attribute (qname => 'e');
976 $e->set_attribute (occurence => '?');
977 $g->set_attribute (occurence => '+');
978 OK $n->outer_xml,
979 [qq<<!ELEMENT foo (e?)+>>];
980 },
981 },
982 {
983 main => sub {
984 my $n = $NODEMOD->new (type => '#declaration',
985 namespace_uri => SGML_ELEMENT);
986 $n->set_attribute (qname => 'foo');
987 $n->set_attribute (content => 'element');
988 my $g = $n->append_new_node (type => '#element',
989 namespace_uri => SGML_ELEMENT,
990 local_name => 'group');
991 my $e = $g->append_new_node (type => '#element',
992 namespace_uri => SGML_ELEMENT,
993 local_name => 'element');
994 $e->set_attribute (qname => 'e');
995 my $f = $g->append_new_node (type => '#element',
996 namespace_uri => SGML_ELEMENT,
997 local_name => 'element');
998 $f->set_attribute (qname => 'f');
999 $g->set_attribute (connector => ',');
1000 OK $n->outer_xml,
1001 [qq<<!ELEMENT foo (e,f)>>];
1002 },
1003 },
1004 {
1005 main => sub {
1006 my $n = $NODEMOD->new (type => '#declaration',
1007 namespace_uri => SGML_ELEMENT);
1008 $n->set_attribute (qname => 'foo');
1009 $n->set_attribute (content => 'mixed');
1010 my $g = $n->append_new_node (type => '#element',
1011 namespace_uri => SGML_ELEMENT,
1012 local_name => 'group');
1013 my $e = $g->append_new_node (type => '#element',
1014 namespace_uri => SGML_ELEMENT,
1015 local_name => 'element');
1016 $e->set_attribute (qname => 'e');
1017 $g->set_attribute (occurence => '+'); # Oops!
1018 OK $n->outer_xml,
1019 [qq<<!ELEMENT foo (#PCDATA|e)*>>];
1020 },
1021 },
1022
1023 {
1024 main => sub {
1025 my $n = $NODEMOD->new (type => '#declaration',
1026 namespace_uri => SGML_DOCTYPE);
1027 $n->set_attribute (qname => 'foo');
1028 OK $n->outer_xml,
1029 [q<<!DOCTYPE foo>>, q<<!DOCTYPE foo []>>];
1030 },
1031 },
1032 {
1033 main => sub {
1034 my $n = $NODEMOD->new (type => '#declaration',
1035 namespace_uri => SGML_DOCTYPE);
1036 $n->set_attribute (qname => 'foo:bar');
1037 OK $n->outer_xml,
1038 [q<<!DOCTYPE foo:bar>>, q<<!DOCTYPE foo:bar []>>];
1039 },
1040 },
1041 {
1042 main => sub {
1043 my $n = $NODEMOD->new (type => '#declaration',
1044 namespace_uri => SGML_DOCTYPE);
1045 $n->set_attribute (qname => 'foo');
1046 $n->append_new_node (type => '#comment');
1047 OK $n->outer_xml,
1048 [qq<<!DOCTYPE foo [<!---->]>>];
1049 },
1050 },
1051 {
1052 main => sub {
1053 my $n = $NODEMOD->new (type => '#declaration',
1054 namespace_uri => SGML_DOCTYPE);
1055 $n->set_attribute (qname => 'foo');
1056 $n->set_attribute (SYSTEM => q<http://dtd.example/>);
1057 OK $n->outer_xml,
1058 [qq<<!DOCTYPE foo SYSTEM "http://dtd.example/">>];
1059 },
1060 },
1061 {
1062 main => sub {
1063 my $n = $NODEMOD->new (type => '#declaration',
1064 namespace_uri => SGML_DOCTYPE);
1065 $n->set_attribute (qname => 'foo');
1066 $n->set_attribute (PUBLIC => q<+//IDN dtd.example//DTD ex//EN>);
1067 $n->set_attribute (SYSTEM => q<http://dtd.example/>);
1068 OK $n->outer_xml,
1069 [qq<<!DOCTYPE foo PUBLIC "+//IDN dtd.example//DTD ex//EN" "http://dtd.example/">>];
1070 },
1071 },
1072 {
1073 main => sub {
1074 my $n = $NODEMOD->new (type => '#declaration',
1075 namespace_uri => SGML_DOCTYPE);
1076 $n->set_attribute (qname => 'foo');
1077 $n->set_attribute (SYSTEM => q<http://dtd.example/>);
1078 $n->append_new_node (type => '#comment');
1079 OK $n->outer_xml,
1080 [qq<<!DOCTYPE foo SYSTEM "http://dtd.example/" [<!---->]>>];
1081 },
1082 },
1083
1084 {
1085 main => sub {
1086 my $n = $NODEMOD->new (type => '#document');
1087 OK $n->outer_xml,
1088 [qq<>];
1089 },
1090 },
1091 {
1092 main => sub {
1093 my $n = $NODEMOD->new (type => '#fragment');
1094 OK $n->outer_xml,
1095 [qq<>];
1096 },
1097 },
1098
1099 {
1100 main => sub {
1101 my $n = $NODEMOD->new (type => '#document');
1102 my $d = $n->append_new_node (type => '#declaration',
1103 namespace_uri => SGML_DOCTYPE);
1104 $d->set_attribute (qname => 'foo');
1105 $d->append_new_node (type => '#comment');
1106 OK $n->outer_xml,
1107 [qq<<!DOCTYPE foo [<!---->]>>];
1108 },
1109 },
1110 {
1111 main => sub {
1112 my $n = $NODEMOD->new (type => '#document');
1113 my $d = $n->append_new_node (type => '#declaration',
1114 namespace_uri => SGML_DOCTYPE);
1115 $d->append_new_node (type => '#comment');
1116 $n->append_new_node (type => '#element',
1117 namespace_uri => NULL_URI,
1118 local_name => 'root');
1119 OK $n->outer_xml,
1120 [qq<<!DOCTYPE root [<!---->]><root xmlns=""></root>>];
1121 },
1122 },
1123
1124 {
1125 main => sub {
1126 my $n = $NODEMOD->new (type => '#document');
1127 my $p = $n->append_new_node (type => '#pi', local_name => 'xml');
1128 $p->set_attribute (version => '1.0');
1129 OK $n->outer_xml,
1130 [qq<<?xml version="1.0"?>>];
1131 },
1132 },
1133
1134 {
1135 main => sub {
1136 my $n = $NODEMOD->new (type => '#text', value => "\x00\x01\x02\x03");
1137 OK $n->outer_xml,
1138 [qq<&amp;#0;&amp;#1;&amp;#2;&amp;#3;>]; # XML 1.0
1139 },
1140 },
1141 {
1142 main => sub {
1143 my $n = $NODEMOD->new (type => '#text', value => "\x09\x0A\x0D\x20");
1144 OK $n->outer_xml,
1145 [qq<\x09\x0A\x0D\x20>];
1146 },
1147 },
1148 {
1149 main => sub {
1150 my $n = $NODEMOD->new (type => '#text', value => "\x7F\x80\x81\x85");
1151 OK $n->outer_xml,
1152 [qq<\x7F\x80\x81\x85>]; # XML 1.0
1153 },
1154 },
1155
1156 {
1157 main => sub {
1158 my $n = $NODEMOD->new (type => '#attribute',
1159 local_name => 'a',
1160 value => "\x20abc\x20def\x20");
1161 OK $n->outer_xml,
1162 [qq<a="\x20abc\x20def\x20">];
1163 },
1164 },
1165 {
1166 main => sub {
1167 my $n = $NODEMOD->new (type => '#attribute',
1168 local_name => 'a',
1169 value => "\x20\x20abc\x20def\x20\x20");
1170 OK $n->outer_xml,
1171 [qq<a="\x20\x20abc\x20def\x20\x20">];
1172 },
1173 },
1174 {
1175 main => sub {
1176 my $n = $NODEMOD->new (type => '#attribute',
1177 local_name => 'a',
1178 value => "\x09abc\x09def\x09");
1179 OK $n->outer_xml,
1180 [qq<a="&#9;abc&#9;def&#9;">];
1181 },
1182 },
1183 {
1184 main => sub {
1185 my $n = $NODEMOD->new (type => '#attribute',
1186 local_name => 'a',
1187 value => "\x0Aabc\x0Adef\x0A");
1188 OK $n->outer_xml,
1189 [qq<a="&#10;abc&#10;def&#10;">];
1190 },
1191 },
1192 {
1193 main => sub {
1194 my $n = $NODEMOD->new (type => '#attribute',
1195 local_name => 'a',
1196 value => "\x0Dabc\x0Ddef\x0D");
1197 OK $n->outer_xml,
1198 [qq<a="&#13;abc&#13;def&#13;">];
1199 },
1200 },
1201
1202 {
1203 main => sub {
1204 my $n = $NODEMOD->new (type => '#element',
1205 local_name => 'ex',
1206 namespace_uri => NS_xml_URI);
1207 $n->append_new_node (type => '#attribute',
1208 local_name => 'lang',
1209 namespace_uri => NS_xml_URI,
1210 value => 'ja');
1211 OK $n->outer_xml,
1212 [qq<<xml:ex xml:lang="ja"></xml:ex>>];
1213 },
1214 },
1215 );
1216 $tests += @s;
1217
1218 Test::Simple->import (tests => $tests);
1219
1220 for (@s) {
1221 $_->{main}->() if ref $_;
1222 }
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24