/[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 - (hide 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 wakaba 1.1 #!/usr/bin/perl -w
2     use strict;
3     require Test::Simple;
4 wakaba 1.2 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 wakaba 1.1 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 wakaba 1.2 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 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_GENERAL_ENTITY,
635 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_PARAM_ENTITY,
645 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_NCR,
655 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_NCR,
665 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_HEX_CHAR_REF,
675 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_HEX_CHAR_REF,
685 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_GENERAL_ENTITY,
697 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_GENERAL_ENTITY,
707 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_GENERAL_ENTITY,
718 wakaba 1.1 local_name => 'foo');
719     $n->append_new_node (type => '#reference',
720 wakaba 1.2 namespace_uri => SGML_PARAM_ENTITY,
721 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_GENERAL_ENTITY);
731 wakaba 1.1 $n->append_new_node (type => '#reference',
732 wakaba 1.2 namespace_uri => SGML_PARAM_ENTITY,
733 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_PARAM_ENTITY);
743 wakaba 1.1 $n->append_new_node (type => '#reference',
744 wakaba 1.2 namespace_uri => SGML_PARAM_ENTITY,
745 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_GENERAL_ENTITY,
755 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_GENERAL_ENTITY,
766 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_NOTATION,
779 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_NOTATION,
790 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_NOTATION,
801 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_ATTLIST);
814 wakaba 1.1 $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 wakaba 1.2 namespace_uri => SGML_ATTLIST);
824 wakaba 1.1 $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 wakaba 1.2 namespace_uri => SGML_ATTLIST);
834 wakaba 1.1 $n->set_attribute (qname => 'foo');
835     my $attr = $n->append_new_node (type => '#element',
836 wakaba 1.2 namespace_uri => XML_ATTLIST,
837 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_ATTLIST);
849 wakaba 1.1 $n->set_attribute (qname => 'foo');
850     my $attr = $n->append_new_node (type => '#element',
851 wakaba 1.2 namespace_uri => XML_ATTLIST,
852 wakaba 1.1 local_name => 'AttDef');
853     $attr->set_attribute (qname => 'bar');
854     my $att2 = $n->append_new_node (type => '#element',
855 wakaba 1.2 namespace_uri => XML_ATTLIST,
856 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_ATTLIST);
866 wakaba 1.1 $n->set_attribute (qname => 'foo');
867     my $attr = $n->append_new_node (type => '#element',
868 wakaba 1.2 namespace_uri => XML_ATTLIST,
869 wakaba 1.1 local_name => 'AttDef');
870     $attr->set_attribute (qname => 'bar');
871     $attr->set_attribute (type => 'enum');
872     $attr->append_new_node (type => '#element',
873 wakaba 1.2 namespace_uri => XML_ATTLIST,
874 wakaba 1.1 local_name => 'enum')
875     ->append_text ('enum1');
876     $attr->append_new_node (type => '#element',
877 wakaba 1.2 namespace_uri => XML_ATTLIST,
878 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_ATTLIST);
889 wakaba 1.1 $n->set_attribute (qname => 'foo');
890     my $attr = $n->append_new_node (type => '#element',
891 wakaba 1.2 namespace_uri => XML_ATTLIST,
892 wakaba 1.1 local_name => 'AttDef');
893     $attr->set_attribute (qname => 'bar');
894     $attr->set_attribute (type => 'NOTATION');
895     $attr->append_new_node (type => '#element',
896 wakaba 1.2 namespace_uri => XML_ATTLIST,
897 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_ATTLIST);
909 wakaba 1.1 $n->append_new_node (type => '#reference',
910 wakaba 1.2 namespace_uri => SGML_PARAM_ENTITY,
911 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_ELEMENT);
921 wakaba 1.1 $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 wakaba 1.2 namespace_uri => SGML_ELEMENT);
930 wakaba 1.1 $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 wakaba 1.2 namespace_uri => SGML_ELEMENT);
939 wakaba 1.1 $n->append_new_node (type => '#reference',
940 wakaba 1.2 namespace_uri => SGML_PARAM_ENTITY,
941 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_ELEMENT);
950 wakaba 1.1 $n->set_attribute (qname => 'foo');
951     $n->set_attribute (content => 'element');
952     my $g = $n->append_new_node (type => '#element',
953 wakaba 1.2 namespace_uri => SGML_ELEMENT,
954 wakaba 1.1 local_name => 'group');
955     $g->append_new_node (type => '#element',
956 wakaba 1.2 namespace_uri => SGML_ELEMENT,
957 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_ELEMENT);
967 wakaba 1.1 $n->set_attribute (qname => 'foo');
968     $n->set_attribute (content => 'element');
969     my $g = $n->append_new_node (type => '#element',
970 wakaba 1.2 namespace_uri => SGML_ELEMENT,
971 wakaba 1.1 local_name => 'group');
972     my $e = $g->append_new_node (type => '#element',
973 wakaba 1.2 namespace_uri => SGML_ELEMENT,
974 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_ELEMENT);
986 wakaba 1.1 $n->set_attribute (qname => 'foo');
987     $n->set_attribute (content => 'element');
988     my $g = $n->append_new_node (type => '#element',
989 wakaba 1.2 namespace_uri => SGML_ELEMENT,
990 wakaba 1.1 local_name => 'group');
991     my $e = $g->append_new_node (type => '#element',
992 wakaba 1.2 namespace_uri => SGML_ELEMENT,
993 wakaba 1.1 local_name => 'element');
994     $e->set_attribute (qname => 'e');
995     my $f = $g->append_new_node (type => '#element',
996 wakaba 1.2 namespace_uri => SGML_ELEMENT,
997 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_ELEMENT);
1008 wakaba 1.1 $n->set_attribute (qname => 'foo');
1009     $n->set_attribute (content => 'mixed');
1010     my $g = $n->append_new_node (type => '#element',
1011 wakaba 1.2 namespace_uri => SGML_ELEMENT,
1012 wakaba 1.1 local_name => 'group');
1013     my $e = $g->append_new_node (type => '#element',
1014 wakaba 1.2 namespace_uri => SGML_ELEMENT,
1015 wakaba 1.1 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 wakaba 1.2 namespace_uri => SGML_DOCTYPE);
1027 wakaba 1.1 $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 wakaba 1.2 namespace_uri => SGML_DOCTYPE);
1036 wakaba 1.1 $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 wakaba 1.2 namespace_uri => SGML_DOCTYPE);
1045 wakaba 1.1 $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 wakaba 1.2 namespace_uri => SGML_DOCTYPE);
1055 wakaba 1.1 $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 wakaba 1.2 namespace_uri => SGML_DOCTYPE);
1065 wakaba 1.1 $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 wakaba 1.2 namespace_uri => SGML_DOCTYPE);
1076 wakaba 1.1 $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 wakaba 1.2 namespace_uri => SGML_DOCTYPE);
1104 wakaba 1.1 $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 wakaba 1.2 namespace_uri => SGML_DOCTYPE);
1115 wakaba 1.1 $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 wakaba 1.2 },
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 wakaba 1.1 },
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