BEGIN { if($ENV{PERL_CORE}) { chdir 't'; @INC = '../lib'; } } use strict; use Test; BEGIN { plan tests => 24 }; 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'; print "##### Tests for =item directives via class $x\n"; $Pod::Simple::XMLOutStream::ATTR_PAD = ' '; $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output print "#\n# Tests for simple =item *'s\n"; ok( $x->_out("\n=over\n\n=item *\n\nStuff\n\n=item *\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); ok( $x->_out("\n=over\n\n=item *\n\nStuff\n\n=cut\n\nStuff\n\n=item *\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); ok( $x->_out("\n=over 10\n\n=item *\n\nStuff\n\n=cut\n\nStuff\n\n=item *\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); ok( $x->_out("\n=over\n\n=item *\n\nStuff\n=cut\nStuff\n\n=item *\n\nBar I!\n\n=back"), 'StuffBar baz!' ); print "#\n# Tests for simple =item 1.'s\n"; ok( $x->_out("\n=over\n\n=item 1.\n\nStuff\n\n=item 2.\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); ok( $x->_out("\n=over\n\n=item 1.\n\nStuff\n\n=cut\n\nStuff\n\n=item 2.\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); # Now without a dot ok( $x->_out("\n=over\n\n=item 1\n\nStuff\n\n=cut\n\nStuff\n\n=item 2\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); ok( $x->_out("\n=over\n\n=item 1\n\nStuff\n=cut\nStuff\n\n=item 2\n\nBar I!\n\n=back"), 'StuffBar baz!' ); print "#\n# Tests for =over blocks (without =items)\n"; ok( $x->_out("\n=over\n\nStuff\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); ok( $x->_out("\n=over\n\n Stuff\n\nBar I!\n\n=back\n\n"), ' StuffBar baz!' ); ok( $x->_out("\n=over\n\nBar I!\n\n Stuff\n\n=back\n\n"), 'Bar baz! Stuff' ); print "#\n# Tests for =item Text blocks...\n"; ok( $x->_out("\n=over\n\n=item Foo\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item Bar I!\n\nQuux\n\n=back\n\n"), 'FooStuffBar baz!Quux' ); ok( $x->_out("\n=over\n\n=item Foo\n\n Stuff\n\tSnork\n\n=cut\n\nCrunk\nZorp\n\n=item Bar I!\n\nQuux\n\n=back\n\n"), qq{Foo Stuff\n Snork} . qq{Bar baz!Quux} ); ok( $x->_out("\n=over\n\n=item Foo\n\n Stuff\n\tSnork\n=cut\n\nCrunk\nZorp\n\n=item Bar I!\n\nQuux\n\n=back\n\n"), qq{Foo Stuff\n Snork} . qq{Bar baz!Quux} ); print "#\n# Test for mixed =item blocks...\n"; ok( $x->_out( sub { $_[0]->no_errata_section(1) }, # We know this will complain "\n=over\n\n=item Foo\n\nStuff\n\n=item 2.\n\nBar I!\n\nQuux\n\n=item *\n\nThwoong\n\n=back\n\n"), qq{FooStuff} . qq{2.Bar baz!Quux} . qq{*Thwoong} ); # ok( $x->_out("\n=over\n\n=item *\n\nStuff\n\n=item 2.\n\nBar I!\n\nQuux\n\n=item *\n\nThwoong\n\n=back\n\n"), # ok( $x->_out("\n=over\n\n=item 1.\n\nStuff\n\n=item 2.\n\nBar I!\n\nQuux\n\n=item *\n\nThwoong\n\n=back\n\n"), print "#\n# Tests for indenting\n"; ok( $x->_out("\n=over 19\n\n=item *\n\nStuff\n\n=item *\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); ok( $x->_out("\n=over 19\n\n=item 1.\n\nStuff\n\n=item 2.\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); ok( $x->_out("\n=over 19\n\nStuff\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); ok( $x->_out("\n=over 19\n\n=item Foo\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item Bar I!\n\nQuux\n\n=back\n\n"), 'FooStuffBar baz!Quux' ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# Now testing nesting...\n"; ok( $x->_out(join "\n\n", '', '=over', '=item *', 'Stuff', '=cut', 'Stuff', '=over', '=item 1.', '=item 2.', 'Bar I!', '=back', '=item *', 'Bar I!', '=back', '' ), join '', '', '', 'Stuff', '', '', 'Bar baz!', '', 'Bar baz!', '' ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ok( $x->_out( join "\n\n", '', '', '=over', '=item *', 'Stuff', '=cut', 'Stuff', '=over', '=item 1.', '=over 19', 'Gleiven', 'Squim F<.thingrc>!', '=back', '=item 2.', 'Bar I!', '=back', '=item *', 'Bar I!', '=back', '', '' ), join '', '', '', 'Stuff', '', '', '', 'Gleiven', 'Squim .thingrc!', '', 'Bar baz!', '', 'Bar baz!', '' ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ $d = 11; print "# Now checking that document-end closes things right...\n"; ok( $x->_out( # We know there'd be a warning about implicit =back; disable it! sub { $_[0]->no_whining(1); }, join( "\n\n", '', '', '=over', '=item *', 'Stuff', '=cut', 'Stuff', '=over', '=item 1.', '=over 19', 'Gleiven', 'Squim F<.thingrc>!', '', '', ), ), join '', '', '', 'Stuff', '', '', '', 'Gleiven', 'Squim .thingrc!', '', '', '' ); # TODO: more checking of coercion in nesting? print "# Wrapping up... one for the road...\n"; ok 1; print "# --- Done with ", __FILE__, " --- \n";