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