# Testing accept_codes
BEGIN {
if($ENV{PERL_CORE}) {
chdir 't';
@INC = '../lib';
}
}
use strict;
use Test;
BEGIN { plan tests => 13 };
#use Pod::Simple::Debug (6);
ok 1;
use Pod::Simple::DumpAsXML;
use Pod::Simple::XMLOutStream;
print "# Pod::Simple version $Pod::Simple::VERSION\n";
sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) }
my $x = 'Pod::Simple::XMLOutStream';
sub accept_N { $_[0]->accept_codes('N') }
print "# Some sanity tests...\n";
ok( $x->_out( "=pod\n\nI like pie.\n"), # without acceptor
'I like pie.'
);
ok( $x->_out( \&accept_N, "=pod\n\nI like pie.\n"),
'I like pie.'
);
ok( $x->_out( "=pod\n\nB\n"), # without acceptor
'foo '
);
ok( $x->_out( \&accept_N, "=pod\n\nB\n"),
'foo '
);
print "# Some real tests...\n";
ok( $x->_out( \&accept_N, "=pod\n\nN\n"),
'foo '
);
ok( $x->_out( \&accept_N, "=pod\n\nB>\n"),
'foo '
);
ok( $x->_out( "=pod\n\nB>\n") # without the mutor
ne 'foo '
# make sure it DOESN'T pass thru the N<...> when not accepted
);
ok( $x->_out( \&accept_N, "=pod\n\nBNI>\n"),
'piezorchfoopling'
);
print "# Tests of nonacceptance...\n";
sub starts_with {
my($large, $small) = @_;
print("# supahstring is undef\n"),
return '' unless defined $large;
print("# supahstring $large is smaller than target-starter $small\n"),
return '' if length($large) < length($small);
if( substr($large, 0, length($small)) eq $small ) {
#print "# Supahstring $large\n# indeed starts with $small\n";
return 1;
} else {
print "# Supahstring $large\n# !starts w/ $small\n";
return '';
}
}
ok( starts_with( $x->_out( "=pod\n\nB>\n"), # without the mutor
'foo '
# make sure it DOESN'T pass thru the N<...>, when not accepted
));
ok( starts_with( $x->_out( "=pod\n\nBNI>\n"), # !mutor
'piezorchfoopling'
# make sure it DOESN'T pass thru the N<...>, when not accepted
));
ok( starts_with( $x->_out( "=pod\n\nBN>I>\n"), # !mutor
'piezorchfoopling'
# make sure it DOESN'T pass thru the N<...>, when not accepted
));
print "# Wrapping up... one for the road...\n";
ok 1;
print "# --- Done with ", __FILE__, " --- \n";