manakai/t/markup-xml--ns.t

#!/usr/bin/perl
use strict;
require Test::Simple; sub ok ($;$);
use Message::Markup::XML;
use Message::Markup::XML::QName qw:DEFAULT_PFX UNDEF_URI NULL_URI:;
                              
sub OK ($$) {
  my ($result, $expect) = @_;
  if ($result eq $expect) {
    ok 1;
  } else {
    ok 0, $result;
  }
}

my $e = Message::Markup::XML->new (type => '#element',
                                   namespace_uri => q<http://e.test/>,
                                   local_name => 'e');

my @s = (
         {
          g  => sub {
          },
          reset => 1,
          result => q<<e.test:e xmlns:e.test="http://e.test/"></e.test:e>>,
         },
         {
          g => sub {
            $e->define_new_namespace ('' => q<http://e.test/>);
          },
          reset => 1,
          result => q<<e xmlns="http://e.test/"></e>>,
         },
         {
          g => sub {
            $e->define_new_namespace (e => q<http://e.test/>);
          },
          reset => 1,
          result => q<<e:e xmlns:e="http://e.test/"></e:e>>,
         },
         {
          g  => sub {
            $e->define_new_namespace (e => q<http://f.test/>);
          },
          reset => 1,
          result => q<<e.test:e xmlns:e="http://f.test/" xmlns:e.test="http://e.test/"></e.test:e>>,
         },
         {
          g  => sub {
            $e->set_attribute (foo => 'bar', namespace_uri => q<http://a.test/>);
          },
          reset => 1,
          result => q<<e.test:e a.test:foo="bar" xmlns:a.test="http://a.test/" xmlns:e.test="http://e.test/"></e.test:e>>,
         },
        );

my @f = (
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<foo:bar>,
               namespace_uri => q<http://foo.test/>);
            OK $el, q<<foo:bar xmlns:foo="http://foo.test/"></foo:bar>>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<bar>,
               namespace_uri => q<http://foo.test/>);
            OK $el, q<<bar xmlns="http://foo.test/"></bar>>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<foo:bar>,
               namespace_uri => q<>);
            OK $el, q<<bar xmlns=""></bar>>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<bar>,
               namespace_uri => NULL_URI);
            OK $el, q<<bar xmlns=""></bar>>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<foo:bar>,
               namespace_uri => q<http://foo.test/>);
            $el->set_attribute (foo => 'bar', 
                                namespace_uri => q<http://foo.test/>);
            OK $el, q<<foo:bar foo:foo="bar" xmlns:foo="http://foo.test/"></foo:bar>>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<bar>,
               namespace_uri => q<http://foo.test/>);
            $el->set_attribute (foo => 'bar',
                                namespace_uri => q<http://foo.test/>);
            ok ($el eq q<<bar foo.test:foo="bar" xmlns="http://foo.test/" xmlns:foo.test="http://foo.test/"></bar>>
             || $el eq q<<foo.test:bar foo.test:foo="bar" xmlns="http://foo.test/" xmlns:foo.test="http://foo.test/"></foo.test:bar>>), $el;
          },
         },

         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<bar>,
               namespace_uri => q<http://foo.test/>);
            OK $el->namespace_prefix, DEFAULT_PFX;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<foo:bar>,
               namespace_uri => q<http://foo.test/>);
            OK $el->namespace_prefix, q:foo:;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               local_name => q<bar>,
               namespace_uri => q<http://foo.test/>);
            $el->namespace_prefix (q:foo:);
            OK $el, q<<foo:bar xmlns:foo="http://foo.test/"></foo:bar>>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               local_name => q<bar>,
               namespace_uri => q<http://foo.test/>);
            $el->define_new_namespace (q:foo: => q<http://foo.test/>);
            OK $el, q<<foo:bar xmlns:foo="http://foo.test/"></foo:bar>>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<foo:bar>,
               namespace_uri => q<http://foo.test/>);
            $el->define_new_namespace (q:bar: => q<http://bar.test/>);
            OK $el, q<<foo:bar xmlns:bar="http://bar.test/" xmlns:foo="http://foo.test/"></foo:bar>>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<foo:bar>,
               namespace_uri => q<http://foo.test/>);
            $el->define_new_namespace (q:bar: => NULL_URI);
            OK $el, q<<foo:bar xmlns:foo="http://foo.test/"></foo:bar>>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<foo:bar>,
               namespace_uri => q<http://foo.test/>);
            $el->define_new_namespace (DEFAULT_PFX, q<http://bar.test/>);
            OK $el, q<<foo:bar xmlns="http://bar.test/" xmlns:foo="http://foo.test/"></foo:bar>>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<foo:bar>,
               namespace_uri => q<http://foo.test/>);
            $el->define_new_namespace (DEFAULT_PFX, NULL_URI);
            OK $el, q<<foo:bar xmlns="" xmlns:foo="http://foo.test/"></foo:bar>>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<foo:bar>,
               namespace_uri => q<http://foo.test/>);
            OK $el->defined_namespace_prefix (q:foo:), q<http://foo.test/>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<bar>);
            OK $el->defined_namespace_prefix (DEFAULT_PFX), NULL_URI;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<bar>,
               namespace_uri => q<http://foo.test/>);
            OK $el->defined_namespace_prefix (DEFAULT_PFX), q<http://foo.test/>;
          },
         },

         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<bar>,
               namespace_uri => q<http://foo.test/>);
            OK $el->qname, q<bar>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<foo:bar>,
               namespace_uri => q<http://foo.test/>);
            OK $el->qname, q<foo:bar>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<bar>,
               namespace_uri => NULL_URI);
            OK $el->qname, q<bar>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<foo:bar>,
               namespace_uri => q<http://foo.test/>);
            $el->define_new_namespace (foo => q<http://bar.test/>);
            OK $el->qname, q<foo.test:bar>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<foo:bar>,
               namespace_uri => q<http://foo.test/>);
            $el->define_new_namespace (foo => q<http://bar.test/>);
            $el->define_new_namespace ('foo.test' => q<http://baz.test/>);
            $el->define_new_namespace (http => q<http://bar.test/>);
            OK $el->qname, q<ns0:bar>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<bar>,
               namespace_uri => q<http://foo.test/>);
            $el->define_new_namespace (DEFAULT_PFX, q<http://bar.test/>);
            OK $el->qname, q<foo.test:bar>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<bar>,
               namespace_uri => NULL_URI);
            $el->define_new_namespace (DEFAULT_PFX, q<http://bar.test/>);
            OK $el->qname, q<bar>;
            OK $el, q<<bar xmlns=""></bar>>;
          },
         },1,
         
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<bar>,
               namespace_uri => NULL_URI);
            $el->append_new_node 
              (type => '#element',
               qname => q<baz>,
               namespace_uri => NULL_URI);
            OK $el, q<<bar xmlns=""><baz></baz></bar>>;
          },
         },
         {
          g => sub {
            my $el = Message::Markup::XML->new
              (type => '#element',
               qname => q<bar>,
               namespace_uri => q<http://foo.test/>);
            $el->append_new_node
              (type => '#element',
               qname => q<baz>,
               namespace_uri => q<http://foo.test/>);
            OK $el, q<<bar xmlns="http://foo.test/"><baz></baz></bar>>;
          },
         },
);

Test::Simple->import (tests => scalar @s
                             + scalar @f);
                              
for (@s) {
  if (ref $_) {
    $e->{ns} = {} if $_->{reset};
    $e->{node} = [] if $_->{reset};
    &{$_->{g}};
    my $result = $e . '';
    ok $result eq $_->{result}, $result ne $_->{result} ? $result : undef;
  }
}

                              
for (@f) {
  &{$_->{g}} if ref;
}
1	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3			require Test::Simple; sub ok ($;$);
4			use Message::Markup::XML;
5			use Message::Markup::XML::QName qw:DEFAULT_PFX UNDEF_URI NULL_URI:;
6
7			sub OK ($$) {
8			my ($result, $expect) = @_;
9			if ($result eq $expect) {
10			ok 1;
11			} else {
12			ok 0, $result;
13			}
14			}
15
16			my $e = Message::Markup::XML->new (type => '#element',
17			namespace_uri => q<http://e.test/>,
18			local_name => 'e');
19
20			my @s = (
21			{
22			g => sub {
23			},
24			reset => 1,
25			result => q<<e.test:e xmlns:e.test="http://e.test/"></e.test:e>>,
26			},
27			{
28			g => sub {
29			$e->define_new_namespace ('' => q<http://e.test/>);
30			},
31			reset => 1,
32			result => q<<e xmlns="http://e.test/"></e>>,
33			},
34			{
35			g => sub {
36			$e->define_new_namespace (e => q<http://e.test/>);
37			},
38			reset => 1,
39			result => q<<e:e xmlns:e="http://e.test/"></e:e>>,
40			},
41			{
42			g => sub {
43			$e->define_new_namespace (e => q<http://f.test/>);
44			},
45			reset => 1,
46			result => q<<e.test:e xmlns:e="http://f.test/" xmlns:e.test="http://e.test/"></e.test:e>>,
47			},
48			{
49			g => sub {
50			$e->set_attribute (foo => 'bar', namespace_uri => q<http://a.test/>);
51			},
52			reset => 1,
53			result => q<<e.test:e a.test:foo="bar" xmlns:a.test="http://a.test/" xmlns:e.test="http://e.test/"></e.test:e>>,
54			},
55			);
56
57			my @f = (
58			{
59			g => sub {
60			my $el = Message::Markup::XML->new
61			(type => '#element',
62			qname => q<foo:bar>,
63			namespace_uri => q<http://foo.test/>);
64			OK $el, q<<foo:bar xmlns:foo="http://foo.test/"></foo:bar>>;
65			},
66			},
67			{
68			g => sub {
69			my $el = Message::Markup::XML->new
70			(type => '#element',
71			qname => q<bar>,
72			namespace_uri => q<http://foo.test/>);
73			OK $el, q<<bar xmlns="http://foo.test/"></bar>>;
74			},
75			},
76			{
77			g => sub {
78			my $el = Message::Markup::XML->new
79			(type => '#element',
80			qname => q<foo:bar>,
81			namespace_uri => q<>);
82			OK $el, q<<bar xmlns=""></bar>>;
83			},
84			},
85			{
86			g => sub {
87			my $el = Message::Markup::XML->new
88			(type => '#element',
89			qname => q<bar>,
90			namespace_uri => NULL_URI);
91			OK $el, q<<bar xmlns=""></bar>>;
92			},
93			},
94			{
95			g => sub {
96			my $el = Message::Markup::XML->new
97			(type => '#element',
98			qname => q<foo:bar>,
99			namespace_uri => q<http://foo.test/>);
100			$el->set_attribute (foo => 'bar',
101			namespace_uri => q<http://foo.test/>);
102			OK $el, q<<foo:bar foo:foo="bar" xmlns:foo="http://foo.test/"></foo:bar>>;
103			},
104			},
105			{
106			g => sub {
107			my $el = Message::Markup::XML->new
108			(type => '#element',
109			qname => q<bar>,
110			namespace_uri => q<http://foo.test/>);
111			$el->set_attribute (foo => 'bar',
112			namespace_uri => q<http://foo.test/>);
113			ok ($el eq q<<bar foo.test:foo="bar" xmlns="http://foo.test/" xmlns:foo.test="http://foo.test/"></bar>>
114			\|\| $el eq q<<foo.test:bar foo.test:foo="bar" xmlns="http://foo.test/" xmlns:foo.test="http://foo.test/"></foo.test:bar>>), $el;
115			},
116			},
117
118			{
119			g => sub {
120			my $el = Message::Markup::XML->new
121			(type => '#element',
122			qname => q<bar>,
123			namespace_uri => q<http://foo.test/>);
124			OK $el->namespace_prefix, DEFAULT_PFX;
125			},
126			},
127			{
128			g => sub {
129			my $el = Message::Markup::XML->new
130			(type => '#element',
131			qname => q<foo:bar>,
132			namespace_uri => q<http://foo.test/>);
133			OK $el->namespace_prefix, q:foo:;
134			},
135			},
136			{
137			g => sub {
138			my $el = Message::Markup::XML->new
139			(type => '#element',
140			local_name => q<bar>,
141			namespace_uri => q<http://foo.test/>);
142			$el->namespace_prefix (q:foo:);
143			OK $el, q<<foo:bar xmlns:foo="http://foo.test/"></foo:bar>>;
144			},
145			},
146			{
147			g => sub {
148			my $el = Message::Markup::XML->new
149			(type => '#element',
150			local_name => q<bar>,
151			namespace_uri => q<http://foo.test/>);
152			$el->define_new_namespace (q:foo: => q<http://foo.test/>);
153			OK $el, q<<foo:bar xmlns:foo="http://foo.test/"></foo:bar>>;
154			},
155			},
156			{
157			g => sub {
158			my $el = Message::Markup::XML->new
159			(type => '#element',
160			qname => q<foo:bar>,
161			namespace_uri => q<http://foo.test/>);
162			$el->define_new_namespace (q:bar: => q<http://bar.test/>);
163			OK $el, q<<foo:bar xmlns:bar="http://bar.test/" xmlns:foo="http://foo.test/"></foo:bar>>;
164			},
165			},
166			{
167			g => sub {
168			my $el = Message::Markup::XML->new
169			(type => '#element',
170			qname => q<foo:bar>,
171			namespace_uri => q<http://foo.test/>);
172			$el->define_new_namespace (q:bar: => NULL_URI);
173			OK $el, q<<foo:bar xmlns:foo="http://foo.test/"></foo:bar>>;
174			},
175			},
176			{
177			g => sub {
178			my $el = Message::Markup::XML->new
179			(type => '#element',
180			qname => q<foo:bar>,
181			namespace_uri => q<http://foo.test/>);
182			$el->define_new_namespace (DEFAULT_PFX, q<http://bar.test/>);
183			OK $el, q<<foo:bar xmlns="http://bar.test/" xmlns:foo="http://foo.test/"></foo:bar>>;
184			},
185			},
186			{
187			g => sub {
188			my $el = Message::Markup::XML->new
189			(type => '#element',
190			qname => q<foo:bar>,
191			namespace_uri => q<http://foo.test/>);
192			$el->define_new_namespace (DEFAULT_PFX, NULL_URI);
193			OK $el, q<<foo:bar xmlns="" xmlns:foo="http://foo.test/"></foo:bar>>;
194			},
195			},
196			{
197			g => sub {
198			my $el = Message::Markup::XML->new
199			(type => '#element',
200			qname => q<foo:bar>,
201			namespace_uri => q<http://foo.test/>);
202			OK $el->defined_namespace_prefix (q:foo:), q<http://foo.test/>;
203			},
204			},
205			{
206			g => sub {
207			my $el = Message::Markup::XML->new
208			(type => '#element',
209			qname => q<bar>);
210			OK $el->defined_namespace_prefix (DEFAULT_PFX), NULL_URI;
211			},
212			},
213			{
214			g => sub {
215			my $el = Message::Markup::XML->new
216			(type => '#element',
217			qname => q<bar>,
218			namespace_uri => q<http://foo.test/>);
219			OK $el->defined_namespace_prefix (DEFAULT_PFX), q<http://foo.test/>;
220			},
221			},
222
223			{
224			g => sub {
225			my $el = Message::Markup::XML->new
226			(type => '#element',
227			qname => q<bar>,
228			namespace_uri => q<http://foo.test/>);
229			OK $el->qname, q<bar>;
230			},
231			},
232			{
233			g => sub {
234			my $el = Message::Markup::XML->new
235			(type => '#element',
236			qname => q<foo:bar>,
237			namespace_uri => q<http://foo.test/>);
238			OK $el->qname, q<foo:bar>;
239			},
240			},
241			{
242			g => sub {
243			my $el = Message::Markup::XML->new
244			(type => '#element',
245			qname => q<bar>,
246			namespace_uri => NULL_URI);
247			OK $el->qname, q<bar>;
248			},
249			},
250			{
251			g => sub {
252			my $el = Message::Markup::XML->new
253			(type => '#element',
254			qname => q<foo:bar>,
255			namespace_uri => q<http://foo.test/>);
256			$el->define_new_namespace (foo => q<http://bar.test/>);
257			OK $el->qname, q<foo.test:bar>;
258			},
259			},
260			{
261			g => sub {
262			my $el = Message::Markup::XML->new
263			(type => '#element',
264			qname => q<foo:bar>,
265			namespace_uri => q<http://foo.test/>);
266			$el->define_new_namespace (foo => q<http://bar.test/>);
267			$el->define_new_namespace ('foo.test' => q<http://baz.test/>);
268			$el->define_new_namespace (http => q<http://bar.test/>);
269			OK $el->qname, q<ns0:bar>;
270			},
271			},
272			{
273			g => sub {
274			my $el = Message::Markup::XML->new
275			(type => '#element',
276			qname => q<bar>,
277			namespace_uri => q<http://foo.test/>);
278			$el->define_new_namespace (DEFAULT_PFX, q<http://bar.test/>);
279			OK $el->qname, q<foo.test:bar>;
280			},
281			},
282			{
283			g => sub {
284			my $el = Message::Markup::XML->new
285			(type => '#element',
286			qname => q<bar>,
287			namespace_uri => NULL_URI);
288			$el->define_new_namespace (DEFAULT_PFX, q<http://bar.test/>);
289			OK $el->qname, q<bar>;
290			OK $el, q<<bar xmlns=""></bar>>;
291			},
292			},1,
293
294			{
295			g => sub {
296			my $el = Message::Markup::XML->new
297			(type => '#element',
298			qname => q<bar>,
299			namespace_uri => NULL_URI);
300			$el->append_new_node
301			(type => '#element',
302			qname => q<baz>,
303			namespace_uri => NULL_URI);
304			OK $el, q<<bar xmlns=""><baz></baz></bar>>;
305			},
306			},
307			{
308			g => sub {
309			my $el = Message::Markup::XML->new
310			(type => '#element',
311			qname => q<bar>,
312			namespace_uri => q<http://foo.test/>);
313			$el->append_new_node
314			(type => '#element',
315			qname => q<baz>,
316			namespace_uri => q<http://foo.test/>);
317			OK $el, q<<bar xmlns="http://foo.test/"><baz></baz></bar>>;
318			},
319			},
320			);
321
322			Test::Simple->import (tests => scalar @s
323			+ scalar @f);
324
325			for (@s) {
326			if (ref $_) {
327			$e->{ns} = {} if $_->{reset};
328			$e->{node} = [] if $_->{reset};
329			&{$_->{g}};
330			my $result = $e . '';
331			ok $result eq $_->{result}, $result ne $_->{result} ? $result : undef;
332			}
333			}
334
335
336			for (@f) {
337			&{$_->{g}} if ref;
338			}