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