1# Testing extend and accept_codes
2BEGIN {
3    if($ENV{PERL_CORE}) {
4        chdir 't';
5        @INC = '../lib';
6    }
7}
8
9use strict;
10use warnings;
11use Test;
12BEGIN { plan tests => 24 };
13
14#use Pod::Simple::Debug (2);
15
16ok 1;
17
18use Pod::Simple::DumpAsXML;
19use Pod::Simple::XMLOutStream;
20print "# Pod::Simple version $Pod::Simple::VERSION\n";
21
22BEGIN {
23  require FindBin;
24  unshift @INC, $FindBin::Bin . '/lib';
25  require helpers;
26  helpers->import;
27}
28
29my $x = 'Pod::Simple::XMLOutStream';
30sub accept_Q    { $_[0]->accept_codes('Q') }
31sub accept_prok { $_[0]->accept_codes('prok') }
32sub accept_zing_prok { $_[0]->accept_codes('zing:prok') }
33sub accept_zing_superprok { $_[0]->accept_codes('z.i_ng:Prok-12') }
34sub accept_zing_superduperprok {
35  $_[0]->accept_codes('A');
36  $_[0]->accept_codes('z.i_ng:Prok-12');
37}
38
39
40#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
41
42
43print "# Some sanity tests...\n";
44ok( $x->_out( "=pod\n\nI like pie.\n"),
45  '<Document><Para>I like pie.</Para></Document>'
46);
47ok( $x->_out( "=extend N C Y,W\n\nI like pie.\n"),
48  '<Document><Para>I like pie.</Para></Document>'
49);
50ok( $x->_out( "=extend N C,F Y,W\n\nI like pie.\n"),
51  '<Document><Para>I like pie.</Para></Document>'
52);
53ok( $x->_out( "=extend N C,F,I Y,W\n\nI like pie.\n"),
54  '<Document><Para>I like pie.</Para></Document>'
55);
56
57
58#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
59
60
61print "## OK, actually trying to use an extended code...\n";
62
63print "# extending but not accepted (so hitting fallback)\n";
64
65ok( $x->_out( "=extend N B Y,W\n\nI N<like> pie.\n"),
66  '<Document><Para>I <B>like</B> pie.</Para></Document>'
67);
68ok( $x->_out( "=extend N B,I Y,W\n\nI N<like> pie.\n"),
69  '<Document><Para>I <B><I>like</I></B> pie.</Para></Document>'
70);
71ok( $x->_out( "=extend N C,B,I Y,W\n\nI N<like> pie.\n"),
72  '<Document><Para>I <C><B><I>like</I></B></C> pie.</Para></Document>'
73);
74
75
76
77print "# extending to one-letter accepted (not hitting fallback)\n";
78
79ok( $x->_out( \&accept_Q, "=extend N B Y,Q,A,bzroch\n\nI N<like> pie.\n"),
80  '<Document><Para>I <Q>like</Q> pie.</Para></Document>'
81);
82ok( $x->_out( \&accept_Q, "=extend N B,I Y,Q,A,bzroch\n\nI N<like> pie.\n"),
83  '<Document><Para>I <Q>like</Q> pie.</Para></Document>'
84);
85ok( $x->_out( \&accept_Q, "=extend N C,B,I Y,Q,A,bzroch\n\nI N<like> pie.\n"),
86  '<Document><Para>I <Q>like</Q> pie.</Para></Document>'
87);
88
89
90
91print "# extending to many-letter accepted (not hitting fallback)\n";
92
93ok( $x->_out( \&accept_prok, "=extend N B Y,prok,A,bzroch\n\nI N<like> pie.\n"),
94  '<Document><Para>I <prok>like</prok> pie.</Para></Document>'
95);
96ok( $x->_out( \&accept_prok, "=extend N B,I Y,prok,A,bzroch\n\nI N<like> pie.\n"),
97  '<Document><Para>I <prok>like</prok> pie.</Para></Document>'
98);
99ok( $x->_out( \&accept_prok, "=extend N C,B,I Y,prok,A,bzroch\n\nI N<like> pie.\n"),
100  '<Document><Para>I <prok>like</prok> pie.</Para></Document>'
101);
102
103
104
105print "# extending to :-containing, many-letter accepted (not hitting fallback)\n";
106
107ok( $x->_out( \&accept_zing_prok, "=extend N B Y,zing:prok,A,bzroch\n\nI N<like> pie.\n"),
108  '<Document><Para>I <zing:prok>like</zing:prok> pie.</Para></Document>'
109);
110ok( $x->_out( \&accept_zing_prok, "=extend N B,I Y,zing:prok,A,bzroch\n\nI N<like> pie.\n"),
111  '<Document><Para>I <zing:prok>like</zing:prok> pie.</Para></Document>'
112);
113ok( $x->_out( \&accept_zing_prok, "=extend N C,B,I Y,zing:prok,A,bzroch\n\nI N<like> pie.\n"),
114  '<Document><Para>I <zing:prok>like</zing:prok> pie.</Para></Document>'
115);
116
117
118
119
120print "# extending to _:-0-9-containing, many-letter accepted (not hitting fallback)\n";
121
122ok( $x->_out( \&accept_zing_superprok, "=extend N B Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"),
123  '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>'
124);
125ok( $x->_out( \&accept_zing_superprok, "=extend N B,I Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"),
126  '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>'
127);
128ok( $x->_out( \&accept_zing_superprok, "=extend N C,B,I Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"),
129  '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>'
130);
131
132
133
134print "#\n# Testing acceptance order\n";
135
136ok( $x->_out( \&accept_zing_superduperprok, "=extend N B Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"),
137  '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>'
138);
139ok( $x->_out( \&accept_zing_superduperprok, "=extend N B,I Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"),
140  '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>'
141);
142ok( $x->_out( \&accept_zing_superduperprok, "=extend N C,B,I Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"),
143  '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>'
144);
145
146
147
148print "# Wrapping up... one for the road...\n";
149ok 1;
150print "# --- Done with ", __FILE__, " --- \n";
151
152