BEGIN {
if($ENV{PERL_CORE}) {
chdir 't';
@INC = '../lib';
}
}
use strict;
use Test;
BEGIN { plan tests => 62 };
my $d;
#use Pod::Simple::Debug (\$d, 0);
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';
$Pod::Simple::XMLOutStream::ATTR_PAD = ' ';
$Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output
sub moj {$_[0]->accept_target('mojojojo')}
sub mojtext {$_[0]->accept_target_as_text('mojojojo')}
sub any {$_[0]->accept_target_as_text('*')}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
print "# Testing non-matching complaint...\n";
{
my $out;
ok( ($out = $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\nStuff\n\n=end blorp\n\nYup.\n"))
=~ m/POD ERRORS/
) or print "# Didn't contain POD ERRORS:\n# $out\n";
ok( ($out = $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :mojojojo\n\nStuff\n\n=end :blorp\n\nYup.\n"))
=~ m/POD ERRORS/
) or print "# Didn't contain POD ERRORS:\n# $out\n";
ok( ($out = $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :mojojojo\n\n=begin :zaz\n\nStuff\n\n=end :blorp\n\nYup.\n"))
=~ m/POD ERRORS/
) or print "# Didn't contain POD ERRORS:\n# $out\n";
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
print "# Testing some trivial cases of non-acceptance...\n";
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\nStuff\n\n=end mojojojo\n\nYup.\n"),
'I like pie.Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\n\nStuff\n\n=end mojojojo\n\nYup.\n"),
'I like pie.Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin :mojojojo\n\n\nStuff\n\n=end :mojojojo\n\nYup.\n"),
'I like pie.Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\n Stuff\n\n=end mojojojo\n\nYup.\n"),
'I like pie.Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\n\n Stuff\n\n=end mojojojo\n\nYup.\n"),
'I like pie.Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin :mojojojo\n\n\n Stuff\n\n=end :mojojojo\n\nYup.\n"),
'I like pie.Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI\n\n=end mojojojo\n\nYup.\n"),
'I like pie.Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\n\nI\n\n=end mojojojo\n\nYup.\n"),
'I like pie.Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin :mojojojo\n\n\nI\n\n=end :mojojojo\n\nYup.\n"),
'I like pie.Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nStuff\n\n=end psketti,mojojojo,crunk\n\nYup.\n"),
'I like pie.Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\n\nStuff\n\n=end psketti,mojojojo,crunk\n\nYup.\n"),
'I like pie.Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\n\nStuff\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"),
'I like pie.Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\n Stuff\n\n=end psketti,mojojojo,crunk\n\nYup.\n"),
'I like pie.Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\n\n Stuff\n\n=end psketti,mojojojo,crunk\n\nYup.\n"),
'I like pie.Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\n\n Stuff\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"),
'I like pie.Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI\n\n=end psketti,mojojojo,crunk\n\nYup.\n"),
'I like pie.Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\n\nI\n\n=end psketti,mojojojo,crunk\n\nYup.\n"),
'I like pie.Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\n\nI\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"),
'I like pie.Yup.'
);
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
print "# Testing matching because of negated non-acceptance...\n";
#$d = 5;
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !crunk\n\nstuff\n\n=end !crunk\n\nYup.\n"),
'I like pie.stuffYup.'
);
ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin !crunk\n\nstuff\n\n=end !crunk\n\nYup.\n"),
'I like pie.stuffYup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !mojojojo\n\nstuff\n\n=end !mojojojo\n\nYup.\n"),
'I like pie.stuffYup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !mojojojo\n\nI\n\n=end !mojojojo\n\nYup.\n"),
'I like pie.I<stuff>Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !:mojojojo\n\nI\n\n=end !:mojojojo\n\nYup.\n"),
'I like pie.stuffYup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin :!mojojojo \n\nI\n\n=end :!mojojojo \t \n\nYup.\n"),
'I like pie.stuffYup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !crunk,zaz\n\nstuff\n\n=end !crunk,zaz\n\nYup.\n"),
'I like pie.stuffYup.'
);
ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin !crunk\n\nstuff\n\n=end !crunk\n\nYup.\n"),
'I like pie.stuffYup.'
);
ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin !crunk\n\nstuff\n\n=end !crunk\n\nYup.\n"),
'I like pie.stuffYup.'
);
ok( $x->_out( \&any, "=pod\n\nI like pie.\n\n=begin !crunk\n\nstuff\n\n=end !crunk\n\nYup.\n"),
'I like pie.stuffYup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !mojojojo\n\nstuff\n\n=end !mojojojo\n\nYup.\n"),
'I like pie.stuffYup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !mojojojo\n\nI\n\n\n=end !mojojojo\n\nYup.\n"),
'I like pie.I<stuff>Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !psketti,mojojojo,crunk\n\n\nI\n\n=end !psketti,mojojojo,crunk\n\nYup.\n"),
'I like pie.I<stuff>Yup.'
);
ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !:psketti,mojojojo,crunk\n\nI\n\n=end !:psketti,mojojojo,crunk\n\nYup.\n"),
'I like pie.stuffYup.'
);
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
print "# Testing accept_target + simple ...\n";
ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI\n\n=end mojojojo \n\nYup.\n"),
'I like pie.I<stuff>Yup.'
);
ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI\n\n=end psketti,mojojojo,crunk \n\nYup.\n"),
'I like pie.I<stuff>Yup.'
);
print "# Testing accept_target_as_text + simple ...\n";
ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI\n\n=end mojojojo \n\nYup.\n"),
'I like pie.stuffYup.'
);
ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI\n\n=end psketti,mojojojo,crunk \n\nYup.\n"),
'I like pie.stuffYup.'
);
print "# Testing accept_target + two simples ...\n";
#$d = 10;
ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI\n\nHm, B!\n\n=end mojojojo\n\n\nYup.\n"),
'I like pie.I<stuff>Hm, B<things>!Yup.'
);
ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI\n\nHm, B!\n\n=end psketti,mojojojo,crunk\n\nYup.\n"),
'I like pie.I<stuff>Hm, B<things>!Yup.'
);
ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :mojojojo\n\nI\n\nHm, B!\n\n=end :mojojojo\n\nYup.\n"),
'I like pie.stuffHm, things!Yup.'
);
ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\nI\n\nHm, B!\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"),
'I like pie.stuffHm, things!Yup.'
);
print "# Testing accept_target_as_text + two simples ...\n";
ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI\n\nHm, B!\n\n=end psketti,mojojojo,crunk\n\nYup.\n"),
'I like pie.stuffHm, things!Yup.'
);
ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\nI\n\nHm, B!\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"),
'I like pie.stuffHm, things!Yup.'
);
print "# Testing accept_target + two simples, latter with leading whitespace ...\n";
#$d = 10;
ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI\n\n Hm, B!\nTrala.\n\n=end mojojojo\n\n\nYup.\n"),
qq{I like pie.I<stuff> Hm, B<things>!\nTrala.\nYup.}
);
ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI\n\n Hm, B!\nTrala.\n\n=end psketti,mojojojo,crunk\n\nYup.\n"),
qq{I like pie.I<stuff> Hm, B<things>!\nTrala.\nYup.}
);
ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI\n\n Hm, B!\nTrala.\n\n\n=end mojojojo\n\n\nYup.\n"),
qq{I like pie.I<stuff> Hm, B<things>!\nTrala.\n\nYup.}
);
ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI\n\n Hm, B!\nTrala.\n\n\n=end psketti,mojojojo,crunk\n\nYup.\n"),
qq{I like pie.I<stuff> Hm, B<things>!\nTrala.\n\nYup.}
);
print "# Testing :-target and accept_target + two simples, latter with leading whitespace ...\n";
ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :mojojojo\n\nI\nTrala!\n\n Hm, B!\nTrala.\n\n=end :mojojojo\n\nYup.\n"),
qq{I like pie.stuff Trala! Hm, B<things>!\nTrala.Yup.}
);
ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\nI\nTrala!\n\n Hm, B!\nTrala.\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"),
qq{I like pie.stuff Trala! Hm, B<things>!\nTrala.Yup.}
);
print "# now with accept_target_as_text\n";
ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI\nTrala!\n\n Hm, B!\nTrala.\n\n=end mojojojo\n\nYup.\n"),
qq{I like pie.stuff Trala! Hm, B<things>!\nTrala.Yup.}
);
ok( $x->_out( \&mojtext, join "\n\n" =>
"=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk",
"I\nTrala!",
" Hm, B!\nTrala.",
"=end psketti,mojojojo,crunk",
"Yup.\n"
),
qq{I like pie.}.
qq{}.
qq{stuff Trala!}.
qq{ Hm, B<things>!\nTrala.}.
qq{Yup.}
);
print "# Now with five paragraphs (p,v,v,p,p) and accept_target_as_text\n";
ok( $x->_out( \&mojtext, join "\n\n" =>
"=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk",
"I\nTrala!",
" Hm, B!\nTrala.",
" Oh, F<< dodads >>!\nHurf.",
"Boing C\n Blorg!",
"Woohah Ssquim!",
"=end psketti,mojojojo,crunk",
"Yup.\n"
),
qq{I like pie.}.
qq{}.
qq{stuff Trala!}.
qq{ Hm, B<things>!\nTrala.\n\n}.
qq{ Oh, F<< dodads >>!\nHurf.}.
qq{Boing spr- oink Blorg!}.
qq{Woohah thwack woohahsquim!}.
qq{Yup.}
);
print "#\n# Now nested begin...end regions...\n";
sub mojprok { shift->accept_targets(qw{mojojojo prok}) }
ok( $x->_out( \&mojprok, join "\n\n" =>
"=pod\n\nI like pie.",
"=begin :psketti,mojojojo,crunk",
"I\nTrala!",
" Hm, B!\nTrala.",
" Oh, F<< dodads >>!\nHurf.",
"Boing C\n Blorg!",
"=begin :prok",
"Woohah Ssquim!",
"=end :prok",
"ZubZ<>aaz.",
"=end :psketti,mojojojo,crunk",
"Yup.\n"
),
qq{I like pie.}.
qq{}.
qq{stuff Trala!}.
qq{ Hm, B<things>!\nTrala.\n\n}.
qq{ Oh, F<< dodads >>!\nHurf.}.
qq{Boing spr- oink Blorg!}.
qq{}.
qq{Woohah thwack woohahsquim!}.
qq{}.
qq{Zubaaz.}.
qq{}.
qq{Yup.}
);
print "# a little more complex this time...\n";
ok( $x->_out( \&mojprok, join "\n\n" =>
"=pod\n\nI like pie.",
"=begin :psketti,mojojojo,crunk",
"I\nTrala!",
" Hm, B!\nTrala.",
" Oh, F<< dodads >>!\nHurf.",
"Boing C\n Blorg!",
"=begin :prok",
" Blorp, B!\nTrala.",
" Khh, F<< dodads >>!\nHurf.",
"Woohah Ssquim!",
"=end :prok",
"ZubZ<>aaz.",
"=end :psketti,mojojojo,crunk",
"Yup.\n"
),
qq{I like pie.}.
qq{}.
qq{stuff Trala!}.
qq{ Hm, B<things>!\nTrala.\n\n}.
qq{ Oh, F<< dodads >>!\nHurf.}.
qq{Boing spr- oink Blorg!}.
qq{}.
qq{ Blorp, B<things>!\nTrala.\n\n}.
qq{ Khh, F<< dodads >>!\nHurf.}.
qq{Woohah thwack woohahsquim!}.
qq{}.
qq{Zubaaz.}.
qq{}.
qq{Yup.}
);
$d = 10;
print "# Now with nesting where inner region is non-resolving...\n";
ok( $x->_out( \&mojprok, join "\n\n" =>
"=pod\n\nI like pie.",
"=begin :psketti,mojojojo,crunk",
"I\nTrala!",
" Hm, B!\nTrala.",
" Oh, F<< dodads >>!\nHurf.",
"Boing C\n Blorg!",
"=begin prok",
" Blorp, B!\nTrala.",
" Khh, F<< dodads >>!\nHurf.",
"Woohah Ssquim!",
"=end prok",
"ZubZ<>aaz.",
"=end :psketti,mojojojo,crunk",
"Yup.\n"
),
qq{I like pie.}.
qq{}.
qq{stuff Trala!}.
qq{ Hm, B<things>!\nTrala.\n\n}.
qq{ Oh, F<< dodads >>!\nHurf.}.
qq{Boing spr- oink Blorg!}.
qq{}.
qq{ Blorp, B<things>!\nTrala.\n\n}.
qq{ Khh, F<< dodads >>!\nHurf.\n}.
qq{Woohah S<thwack\nwoohah>squim!}.
qq{}.
qq{Zubaaz.}.
qq{}.
qq{Yup.}
);
print "# Now a begin...end with a non-resolving for inside\n";
ok( $x->_out( \&mojprok, join "\n\n" =>
"=pod\n\nI like pie.",
"=begin :psketti,mojojojo,crunk",
"I\nTrala!",
" Hm, B!\nTrala.",
" Oh, F<< dodads >>!\nHurf.",
"Boing C\n Blorg!",
"=for prok"
. " Blorp, B!\nTrala.\n Khh, F<< dodads >>!\nHurf.",
"ZubZ<>aaz.",
"=end :psketti,mojojojo,crunk",
"Yup.\n"
),
qq{I like pie.}.
qq{}.
qq{stuff Trala!}.
qq{ Hm, B<things>!\nTrala.\n\n}.
qq{ Oh, F<< dodads >>!\nHurf.}.
qq{Boing spr- oink Blorg!}.
qq{}.
qq{Blorp, B<things>!\nTrala.\n}.
qq{ Khh, F<< dodads >>!\nHurf.}.
qq{}.
qq{Zubaaz.}.
qq{}.
qq{Yup.}
);
print "# Now a begin...end with a resolving for inside\n";
ok( $x->_out( \&mojprok, join "\n\n" =>
"=pod\n\nI like pie.",
"=begin :psketti,mojojojo,crunk",
"I\nTrala!",
" Hm, B!\nTrala.",
" Oh, F<< dodads >>!\nHurf.",
"Boing C\n Blorg!",
"=for :prok"
. " Blorp, B!\nTrala.\n Khh, F<< dodads >>!\nHurf.",
"ZubZ<>aaz.",
"=end :psketti,mojojojo,crunk",
"Yup.\n"
),
qq{I like pie.}.
qq{}.
qq{stuff Trala!}.
qq{ Hm, B<things>!\nTrala.\n\n}.
qq{ Oh, F<< dodads >>!\nHurf.}.
qq{Boing spr- oink Blorg!}.
qq{}.
qq{Blorp, things! Trala. Khh, }.
qq{dodads! Hurf.}.
qq{}.
qq{Zubaaz.}.
qq{}.
qq{Yup.}
);
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
print "# Testing matching of begin block titles\n";
ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin mojojojo Title\n\nstuff\n\n=end mojojojo \n\nYup.\n"),
'I like pie.stuffYup.'
);
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
print "# Wrapping up... one for the road...\n";
ok 1;
print "# --- Done with ", __FILE__, " --- \n";