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