Move Pod::Parser from ext/ to cpan/
[perl.git] / ext / Pod-Simple / t / accept05.t
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