/[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.2 - (hide annotations) (download) (as text)
Sun Sep 28 01:05:04 2003 UTC (21 years, 2 months ago) by wakaba
Branch: MAIN
Changes since 1.1: +175 -1 lines
File MIME type: application/x-troff
Some new functions

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24