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