1# Testing accept_codes 2use strict; 3use warnings; 4use Test::More tests => 11; 5 6#use Pod::Simple::Debug (6); 7 8use Pod::Simple::DumpAsXML; 9use Pod::Simple::XMLOutStream; 10print "# Pod::Simple version $Pod::Simple::VERSION\n"; 11 12BEGIN { 13 require FindBin; 14 unshift @INC, $FindBin::Bin . '/lib'; 15} 16use helpers; 17 18my $x = 'Pod::Simple::XMLOutStream'; 19sub accept_N { $_[0]->accept_codes('N') } 20 21print "# Some sanity tests...\n"; 22is( $x->_out( "=pod\n\nI like pie.\n"), # without acceptor 23 '<Document><Para>I like pie.</Para></Document>' 24); 25is( $x->_out( \&accept_N, "=pod\n\nI like pie.\n"), 26 '<Document><Para>I like pie.</Para></Document>' 27); 28is( $x->_out( "=pod\n\nB<foo\t>\n"), # without acceptor 29 '<Document><Para><B>foo </B></Para></Document>' 30); 31is( $x->_out( \&accept_N, "=pod\n\nB<foo\t>\n"), 32 '<Document><Para><B>foo </B></Para></Document>' 33); 34 35print "# Some real tests...\n"; 36 37is( $x->_out( \&accept_N, "=pod\n\nN<foo\t>\n"), 38 '<Document><Para><N>foo </N></Para></Document>' 39); 40is( $x->_out( \&accept_N, "=pod\n\nB<N<foo\t>>\n"), 41 '<Document><Para><B><N>foo </N></B></Para></Document>' 42); 43isnt( $x->_out( "=pod\n\nB<N<foo\t>>\n"), # without the mutor 44 '<Document><Para><B><N>foo </N></B></Para></Document>' 45 # make sure it DOESN'T pass thru the N<...> when not accepted 46); 47is( $x->_out( \&accept_N, "=pod\n\nB<pieF<zorch>N<foo>I<pling>>\n"), 48 '<Document><Para><B>pie<F>zorch</F><N>foo</N><I>pling</I></B></Para></Document>' 49); 50 51print "# Tests of nonacceptance...\n"; 52 53sub starts_with { 54 my($large, $small) = @_; 55 print("# supahstring is undef\n"), 56 return '' unless defined $large; 57 print("# supahstring $large is smaller than target-starter $small\n"), 58 return '' if length($large) < length($small); 59 if( substr($large, 0, length($small)) eq $small ) { 60 #print "# Supahstring $large\n# indeed starts with $small\n"; 61 return 1; 62 } else { 63 print "# Supahstring $large\n# !starts w/ $small\n"; 64 return ''; 65 } 66} 67 68 69ok( starts_with( $x->_out( "=pod\n\nB<N<foo\t>>\n"), # without the mutor 70 '<Document><Para><B>foo </B></Para>' 71 # make sure it DOESN'T pass thru the N<...>, when not accepted 72)); 73 74ok( starts_with( $x->_out( "=pod\n\nB<pieF<zorch>N<foo>I<pling>>\n"), # !mutor 75 '<Document><Para><B>pie<F>zorch</F>foo<I>pling</I></B></Para>' 76 # make sure it DOESN'T pass thru the N<...>, when not accepted 77)); 78 79ok( starts_with( $x->_out( "=pod\n\nB<pieF<zorch>N<C<foo>>I<pling>>\n"), # !mutor 80 '<Document><Para><B>pie<F>zorch</F><C>foo</C><I>pling</I></B></Para>' 81 # make sure it DOESN'T pass thru the N<...>, when not accepted 82)); 83