Move Pod::Simple from ext/ to cpan/
[perl.git] / cpan / Pod-Simple / t / accept01.t
1 # Testing accept_codes
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