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