Commit | Line | Data |
4f90f8a5 |
1 | # Testing accept_codes |
351625bd |
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 => 13 }; |
12 | |
13 | #use Pod::Simple::Debug (6); |
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_N { $_[0]->accept_codes('N') } |
24 | |
25 | print "# Some sanity tests...\n"; |
26 | ok( $x->_out( "=pod\n\nI like pie.\n"), # without acceptor |
27 | '<Document><Para>I like pie.</Para></Document>' |
28 | ); |
29 | ok( $x->_out( \&accept_N, "=pod\n\nI like pie.\n"), |
30 | '<Document><Para>I like pie.</Para></Document>' |
31 | ); |
32 | ok( $x->_out( "=pod\n\nB<foo\t>\n"), # without acceptor |
33 | '<Document><Para><B>foo </B></Para></Document>' |
34 | ); |
35 | ok( $x->_out( \&accept_N, "=pod\n\nB<foo\t>\n"), |
36 | '<Document><Para><B>foo </B></Para></Document>' |
37 | ); |
38 | |
39 | print "# Some real tests...\n"; |
40 | |
41 | ok( $x->_out( \&accept_N, "=pod\n\nN<foo\t>\n"), |
42 | '<Document><Para><N>foo </N></Para></Document>' |
43 | ); |
44 | ok( $x->_out( \&accept_N, "=pod\n\nB<N<foo\t>>\n"), |
45 | '<Document><Para><B><N>foo </N></B></Para></Document>' |
46 | ); |
47 | ok( $x->_out( "=pod\n\nB<N<foo\t>>\n") # without the mutor |
48 | ne '<Document><Para><B><N>foo </N></B></Para></Document>' |
49 | # make sure it DOESN'T pass thru the N<...> when not accepted |
50 | ); |
51 | ok( $x->_out( \&accept_N, "=pod\n\nB<pieF<zorch>N<foo>I<pling>>\n"), |
52 | '<Document><Para><B>pie<F>zorch</F><N>foo</N><I>pling</I></B></Para></Document>' |
53 | ); |
54 | |
55 | print "# Tests of nonacceptance...\n"; |
56 | |
57 | sub starts_with { |
58 | my($large, $small) = @_; |
59 | print("# supahstring is undef\n"), |
60 | return '' unless defined $large; |
61 | print("# supahstring $large is smaller than target-starter $small\n"), |
62 | return '' if length($large) < length($small); |
63 | if( substr($large, 0, length($small)) eq $small ) { |
64 | #print "# Supahstring $large\n# indeed starts with $small\n"; |
65 | return 1; |
66 | } else { |
67 | print "# Supahstring $large\n# !starts w/ $small\n"; |
68 | return ''; |
69 | } |
70 | } |
71 | |
72 | |
73 | ok( starts_with( $x->_out( "=pod\n\nB<N<foo\t>>\n"), # without the mutor |
74 | '<Document><Para><B>foo </B></Para>' |
75 | # make sure it DOESN'T pass thru the N<...>, when not accepted |
76 | )); |
77 | |
78 | ok( starts_with( $x->_out( "=pod\n\nB<pieF<zorch>N<foo>I<pling>>\n"), # !mutor |
79 | '<Document><Para><B>pie<F>zorch</F>foo<I>pling</I></B></Para>' |
80 | # make sure it DOESN'T pass thru the N<...>, when not accepted |
81 | )); |
82 | |
83 | ok( starts_with( $x->_out( "=pod\n\nB<pieF<zorch>N<C<foo>>I<pling>>\n"), # !mutor |
84 | '<Document><Para><B>pie<F>zorch</F><C>foo</C><I>pling</I></B></Para>' |
85 | # make sure it DOESN'T pass thru the N<...>, when not accepted |
86 | )); |
87 | |
88 | |
89 | |
90 | |
91 | |
92 | print "# Wrapping up... one for the road...\n"; |
93 | ok 1; |
94 | print "# --- Done with ", __FILE__, " --- \n"; |
95 | |