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