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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (hide annotations) (download) (as text)
Sun Feb 22 01:44:57 2004 UTC (20 years, 9 months 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
Changes since 1.5: +73 -5 lines
File MIME type: application/x-troff
New tests

1 wakaba 1.1 #!/usr/bin/perl
2     use strict;
3     require Test::Simple;
4 wakaba 1.6 require Message::Markup::XML::Node;
5     use Message::Markup::XML::QName qw/UNDEF_URI NULL_URI DEFAULT_PFX EMPTY_PFX
6     EMPTY_URI ZERO_PFX ZERO_URI/;
7 wakaba 1.1 sub ok ($;$);
8 wakaba 1.6 my $e = new Message::Markup::XML::Node
9     (type => '#element', local_name => 'test',
10     namespace_uri => 'http://something.test/');
11 wakaba 1.3 use Carp q(verbose);
12 wakaba 1.1 my @reg_p2n = (
13     {
14     prefix => q(test1),
15     name => q(http://test1.example/),
16     result => 1,
17     },
18     {
19     prefix => q(test1),
20     name => q(http://test1.example/),
21     result => 1,
22     },
23     {
24     prefix => q(test1),
25     name => q(http://test1.example/),
26     opt => {check_registered => 1},
27     result => 1,
28     },
29     {
30     prefix => q(test1),
31     name => q(http://test2.example/),
32     opt => {check_registered => 1},
33     result => 0,
34     },
35     {
36     prefix => q(test1),
37     name => q(http://test2.example/),
38     result => 1,
39     },
40     {
41     prefix => q(test1),
42     name => q(),
43     result => 0,
44     },
45     {
46     prefix => q(test1),
47     name => NULL_URI,
48     result => 0,
49     },
50     {
51     prefix => q(#default),
52     name => q(http://test2.example/),
53     result => 1,
54     },
55     {
56     prefix => DEFAULT_PFX,
57     name => q(http://test2.example/),
58     result => 1,
59     },
60     {
61     prefix => DEFAULT_PFX,
62     name => NULL_URI,
63     result => 1,
64     },
65     {
66     prefix => q:some-prefix:,
67     name => UNDEF_URI,
68     result => 0,
69     },
70     {
71     prefix => q:some-prefix:,
72     name => q<http://uri.test/>,
73     opt => {check_prefix => 1},
74     result => 1,
75     },
76     {
77     prefix => q:some invalid prefix:,
78     name => q<http://uri.test/>,
79     opt => {check_prefix => 1},
80     result => 0,
81     },
82     {
83     prefix => q:some-prefix-11:,
84     name => q<http://uri.test/>,
85     opt => {check_name => 1},
86     result => 1,
87     },
88     {
89     prefix => q:some-prefix-21:,
90     name => q<relative-uri>,
91     opt => {check_name => 1, check_name_uri_relative => 1},
92     result => 0,
93     },
94     {
95     prefix => q:some-prefix-31:,
96     name => q<relative-uri>,
97     opt => {check_name => 1, resolve_name_uri_relative => 1},
98     result => 1,
99     },
100 wakaba 1.6 {
101     prefix => EMPTY_PFX,
102     name => q<about:name>,
103     opt => {check_prefix => 1, use_prefix_empty => 0},
104     result => 0,
105     },
106     {
107     prefix => EMPTY_PFX,
108     name => q<about:name>,
109     opt => {check_prefix => 1, use_prefix_empty => 1},
110     result => 1,
111     },
112     {
113     prefix => ZERO_PFX,
114     name => q<about:name>,
115     opt => {check_prefix => 1},
116     result => 0,
117     },
118 wakaba 1.1 );
119    
120     my @get_p2n = (
121     {
122     prefix => q:prefix-1.:,
123     name => q<http://foo.test/>,
124     result => 1,
125     },
126     {
127     prefix => q:prefix-2.:,
128     name => q<http://foo2.test/>,
129     opt => {___dont_register => 1},
130     result => 0,
131     },
132     {
133     prefix => q:prefix-2.:,
134     name => NULL_URI,
135     opt => {___dont_register => 1},
136     result => 0,
137     },
138     {
139     prefix => q:prefix-2.:,
140     name => UNDEF_URI,
141     opt => {___dont_register => 1},
142     result => 0,
143     },
144     {
145     prefix => DEFAULT_PFX,
146     name => UNDEF_URI,
147     opt => {___dont_register => 1},
148     result => 0,
149     },
150     {
151     prefix => DEFAULT_PFX,
152     name => NULL_URI,
153     result => 0,
154     },
155     {
156     prefix => DEFAULT_PFX,
157     name => NULL_URI,
158     opt => {use_name_null => 1, use_prefix_default => 1},
159     result => 1,
160     },
161     {
162     prefix => DEFAULT_PFX,
163     name => NULL_URI,
164     opt => {___dont_register => 1},
165     result => 0,
166     },
167     {
168     prefix => DEFAULT_PFX,
169     name => NULL_URI,
170     opt => {use_name_null => 1, use_prefix_default => 1,
171     ___dont_register => 1},
172     result => 1,
173     },
174 wakaba 1.6 {
175     prefix => EMPTY_PFX,
176     name => q<http://test.test/2>,
177     opt => {use_prefix_empty => 1},
178     result => 1,
179     },
180 wakaba 1.1 );
181    
182     my @qname = (
183     {
184     qname => q"foo",
185     prefix => DEFAULT_PFX,
186     lname => q"foo",
187     result => 1,
188     opt => {check_qname => 1, check_prefix => 1,
189     check_local_name => 1},
190     },
191     {
192     qname => q"foo:bar",
193     prefix => q"foo",
194     lname => q"bar",
195     result => 1,
196     opt => {check_qname => 1, check_prefix => 1,
197     check_local_name => 1},
198     },
199     {
200     qname => q"foo:0",
201     prefix => q"foo",
202     lname => q"0",
203     result => 0,
204     opt => {check_qname => 1, check_prefix => 1,
205     check_local_name => 1},
206     },
207     {
208     qname => q"0:bar",
209     prefix => q"0",
210     lname => q"bar",
211     result => 0,
212     opt => {check_qname => 1, check_prefix => 1,
213     check_local_name => 1},
214     },
215     {
216     qname => q"foo:",
217     prefix => q"foo",
218     lname => q"",
219     result => 0,
220     opt => {check_qname => 1, check_prefix => 1,
221     check_local_name => 1},
222     },
223     {
224     qname => q":bar",
225 wakaba 1.3 join_qname => q"bar",
226 wakaba 1.5 prefix => DEFAULT_PFX,
227 wakaba 1.1 lname => q"bar",
228     result => 0,
229 wakaba 1.3 join_result => 1,
230 wakaba 1.1 opt => {check_qname => 1, check_prefix => 1,
231     check_local_name => 1},
232     },
233     {
234     qname => q"*",
235     prefix => DEFAULT_PFX,
236     lname => q"*",
237     result => 1,
238     opt => {check_qname => 1, check_prefix => 1,
239     check_local_name => 1, use_local_name_star => 1},
240     },
241     {
242     qname => q"foo:*",
243     prefix => q"foo",
244     lname => q"*",
245     result => 1,
246     opt => {check_qname => 1, check_prefix => 1,
247     check_local_name => 1, use_local_name_star => 1},
248     },
249 wakaba 1.2 {
250     qname => q"foo|bar",
251     prefix => q:foo:,
252     lname => q:bar:,
253     result => 1,
254     opt => {check_qname => 1, check_prefix => 1,
255     check_local_name => 1, qname_separator => '|'},
256     },
257     {
258     qname => q"foo|*",
259     prefix => q:foo:,
260     lname => q:*:,
261     result => 1,
262     opt => {check_qname => 1, check_prefix => 1,
263     check_local_name => 1, qname_separator => '|',
264     use_local_name_star => 1},
265     },
266 wakaba 1.6 {
267     qname => q":b",
268     prefix => EMPTY_PFX,
269     lname => q:b:,
270     result => 0,
271     opt => {check_qname => 1, check_prefix => 1,
272     check_local_name => 1,
273     use_prefix_empty => 0},
274     },
275     {
276     qname => q":b",
277     prefix => EMPTY_PFX,
278     lname => q:b:,
279     result => 1,
280     opt => {check_qname => 1, check_prefix => 1,
281     check_local_name => 1,
282     use_prefix_empty => 1},
283     },
284     {
285     qname => q"b",
286     prefix => DEFAULT_PFX,
287     lname => q:b:,
288     result => 1,
289     opt => {check_qname => 1, check_prefix => 1,
290     check_local_name => 1,
291     use_prefix_empty => 1},
292     },
293 wakaba 1.2 );
294    
295     my @gen_pfx = (
296     {
297     reset => 1,
298     name => q<http://www.w3.org/1999/xhtml>,
299     prefix => DEFAULT_PFX,
300     opt => {use_prefix_default => 1},
301     },
302     {
303     reset => 0,
304     name => q<http://www.w3.org/1999/xhtml>,
305     prefix => q:h:,
306     n2p => DEFAULT_PFX,
307     opt => {use_prefix_default => 1},
308     },
309     {
310     reset => 1,
311     name => q<http://www.w3.org/1999/xhtml>,
312     prefix => q:h:,
313     opt => {use_prefix_default => 0},
314     },
315     {
316     name => q<http://www.w3.org/1999/xhtml>,
317     prefix => q:h1:,
318     n2p => q:h:,
319     },
320     {
321     name => q<http://www.w3.org/1999/xhtml>,
322     prefix => q:xhtml:,
323     n2p => q:h:,
324     },
325     {
326     name => q<http://www.w3.org/1999/xhtml>,
327     prefix => q:xhtml1:,
328     n2p => q:h:,
329     },
330     {
331     name => q<http://www.w3.org/1999/xhtml>,
332     prefix => q:www.w3.org:,
333     n2p => q:h:,
334     },
335     {
336     name => q<http://www.w3.org/1999/xhtml>,
337     prefix => q:http:,
338     n2p => q:h:,
339     },
340     {
341     name => q<http://www.w3.org/1999/xhtml>,
342     prefix => q:ns0:,
343     n2p => q:h:,
344     },
345     {
346     name => q<http://www.w3.org/1999/xhtml>,
347     prefix => q:ns1:,
348     n2p => q:h:,
349     },
350     {
351 wakaba 1.4 name => q<http://uri.example/b>,
352     prefix => q:b:,
353     },
354     {
355     name => q<http://uri.example/bc>,
356     prefix => q:bc:,
357     },
358     {
359     name => q<http://uri.example/01w>,
360     prefix => q:w:,
361     },
362     {
363 wakaba 1.2 name => q<test/0name/xmlns>,
364     prefix => q:name:,
365     },
366     {
367     name => q<test/0name/xmlns>,
368     prefix => q:test:,
369     n2p => q:name:,
370     },
371     {
372     reset => 1,
373     name => q<:///:04465612@&>,
374     prefix => q:ns0:,
375     },
376     {
377     reset => 1,
378     name => NULL_URI,
379     prefix => DEFAULT_PFX,
380     opt => {use_prefix_default => 1},
381     },
382     {
383     reset => 0,
384     name => NULL_URI,
385     prefix => DEFAULT_PFX,
386     opt => {use_prefix_default => 1},
387     },
388     {
389     reset => 1,
390     name => NULL_URI,
391     prefix => DEFAULT_PFX,
392     opt => {use_prefix_default => 0},
393     },
394     );
395    
396     my @expand = (
397     {
398     reset => 1,
399     ns => {foo => q<http://foo.test/>},
400     qname => q"foo:bar",
401     xname => [q<http://foo.test/> => q:bar:],
402     },
403     {
404     reset => 0,
405     qname => q"foo:bar",
406     xname => [q<http://foo.test/> => q:bar:],
407     },
408     {
409     reset => 0,
410     qname => q"bar",
411     xname => [NULL_URI, q:bar:],
412     opt => {use_prefix_default => 1, use_name_null => 1},
413     },
414 wakaba 1.6 {
415     reset => 0,
416     ns => {(EMPTY_PFX) => q<about:>},
417     qname => q":bar",
418     xname => [q<about:>, q:bar:],
419     opt => {use_prefix_empty => 1},
420     },
421     {
422     reset => 0,
423     ns => {(EMPTY_PFX) => q<about:>,
424     (DEFAULT_PFX) => q<data:,>},
425     qname => q"bar",
426     xname => [q<data:,>, q:bar:],
427     opt => {use_prefix_empty => 1, use_prefix_default => 1},
428     },
429 wakaba 1.1 );
430    
431     Test::Simple->import (tests => scalar (@reg_p2n)
432     + scalar (@get_p2n) * 2
433 wakaba 1.2 + scalar (@qname) * 2
434     + scalar (@gen_pfx) * 2
435     + scalar (@expand) * 2);
436 wakaba 1.3 eval q{
437     sub ok ($;$) {
438     my ($cond, $desc) = @_;
439     if ($cond) {
440     Test::Simple::ok (1);
441     } else {
442     Test::Simple::ok (0, $desc);
443     }
444     }};
445 wakaba 1.1
446     for (@reg_p2n) {
447     my $chk = Message::Markup::XML::QName::register_prefix_to_name
448     ($e, $_->{prefix} => $_->{name}, %{$_->{opt}||{}});
449 wakaba 1.3 ok ($chk->{success} == $_->{result}, 'Register pfx->URI: '.$chk->{reason});
450 wakaba 1.1 }
451    
452     for (@get_p2n) {
453     $e->{ns} = {};
454     my $chk = Message::Markup::XML::QName::register_prefix_to_name
455     ($e, $_->{prefix} => $_->{name}, %{$_->{opt}||{}})
456     unless $_->{opt}->{___dont_register};
457     ok (Message::Markup::XML::QName::prefix_to_name ($e, $_->{prefix},
458     %{$_->{opt}||{}})
459     ->{name}
460     eq ($_->{result} ? ($_->{result_name} || $_->{name}) : undef),
461     ":$_->{prefix}: => <@{[$_->{result} ? ($_->{result_name} || $_->{name}) : undef]}>");
462     ok (Message::Markup::XML::QName::name_to_prefix ($e, $_->{name},
463     %{$_->{opt}||{}})
464     ->{prefix}
465     eq ($_->{result} ? ($_->{result_prefix} || $_->{prefix}) : undef),
466     "<$_->{name}> => :@{[$_->{result} ? ($_->{result_prefix} || $_->{prefix}) : undef]}:");
467     }
468    
469    
470     for (@qname) {
471     my $chk = Message::Markup::XML::QName::split_qname ($_->{qname},
472     %{$_->{opt}||{}});
473     if ($_->{result}) {
474     ok $chk->{prefix}.':'.($chk->{local_name_star} ? '*' : $chk->{local_name})
475     eq $_->{prefix} . ':' . $_->{lname},
476 wakaba 1.3 "Split 1: $_->{qname} => $chk->{prefix}:$chk->{local_name}($chk->{local_name_star})";
477 wakaba 1.1 } else {
478     ok $chk->{success} == $_->{result},
479 wakaba 1.3 "Split 0: $_->{qname} => $chk->{prefix}:$chk->{local_name}($chk->{local_name_star})";
480 wakaba 1.1 }
481    
482     $chk = Message::Markup::XML::QName::join_qname
483     ($_->{prefix}, $_->{lname}, %{$_->{opt}||{}});
484 wakaba 1.5 if (defined $_->{join_result} ? $_->{join_result} : $_->{result}) {
485     ok $chk->{qname} eq ($_->{join_qname} || $_->{qname}), qq(Join 1: "$_->{prefix}":"$_->{lname}" => "$chk->{qname}" ("@{[$_->{join_qname} || $_->{qname}]}" expected));
486 wakaba 1.1 } else {
487 wakaba 1.3 ok $chk->{success} == ((defined $_->{join_result} and $_->{join_result}) or $_->{result}),
488     "Join 0: $chk->{success}; $_->{prefix}, $_->{lname} => $chk->{qname}";
489 wakaba 1.1 }
490 wakaba 1.2 }
491    
492     for (@gen_pfx) {
493     $e->{ns} = {} if $_->{reset};
494     my $pfx = Message::Markup::XML::QName::generate_prefix ($e, $_->{name},
495     %{$_->{opt}||{}});
496     if ($pfx eq $_->{prefix}) {
497     my $chk = Message::Markup::XML::QName::register_prefix_to_name
498     ($e, $pfx => $_->{name});
499 wakaba 1.3 ok $chk->{success}, 'Generate pfx: '.$chk->{reason};
500 wakaba 1.2 } else {
501 wakaba 1.3 ok $pfx eq $_->{prefix}, "Generate pfx: :$pfx: (expected :$_->{prefix}:";
502 wakaba 1.2 }
503     }
504    
505     for (@gen_pfx) {
506     $e->{ns} = {} if $_->{reset};
507     my $chk = Message::Markup::XML::QName::name_to_prefix ($e, $_->{name},
508     %{$_->{opt}||{}},
509     make_new_prefix => 1);
510     ok $chk->{success} && ($chk->{prefix} eq ($_->{n2p} || $_->{prefix})),
511 wakaba 1.3 "URI->Pfx: $chk->{prefix} (@{[$_->{n2p} || $_->{prefix}]} is expected; $chk->{reason})";
512 wakaba 1.2 }
513    
514     for (@expand) {
515     $e->{ns} = {} if $_->{reset};
516     for my $pfx (keys %{$_->{ns}||{}}) {
517     Message::Markup::XML::QName::register_prefix_to_name
518     ($e, $pfx => $_->{ns}->{$pfx}, %{$_->{opt}||{}});
519     }
520     my $chk = Message::Markup::XML::QName::qname_to_expanded_name
521     ($e, $_->{qname}, %{$_->{opt}||{}});
522     ok $chk->{success} && ($_->{xname}->[0] eq $chk->{name}
523     && $_->{xname}->[1] eq $chk->{local_name}),
524 wakaba 1.3 qq(QName->expand: <$chk->{name}> (should be <$_->{xname}->[0]>), "$chk->{local_name}" (should be "$_->{xname}->[1]") (prefix "$chk->{prefix}"; $chk->{reason}));
525 wakaba 1.2 }
526    
527     for (@expand) {
528     $e->{ns} = {} if $_->{reset};
529     for my $pfx (keys %{$_->{ns}||{}}) {
530     Message::Markup::XML::QName::register_prefix_to_name
531     ($e, $pfx => $_->{ns}->{$pfx}, %{$_->{opt}||{}});
532     }
533     my $chk = Message::Markup::XML::QName::expanded_name_to_qname
534     ($e, $_->{xname}->[0], $_->{xname}->[1], %{$_->{opt}||{}});
535 wakaba 1.3 ok $chk->{success} && ($_->{qname} eq $chk->{qname}), 'Expand->QName: '.$chk->{reason};
536 wakaba 1.1 }
537    
538 wakaba 1.6 #print $e;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24