#!perl use strict; use warnings; use Test::More tests => 70; use Pod::Advent; use IO::CaptureOutput qw(capture); sub test_snippet { my $desc = shift; my $pod = shift; my $expected = shift; my $no_extra_newline = shift || 0; my $s; my $ADVENT = Pod::Advent->new; $Pod::Advent::BODY_ONLY = 1; $ADVENT->output_string( \$s ); $ADVENT->parse_string_document("=pod\n\n" . $pod . "\n\n=cut"); is( $s, $expected.($no_extra_newline?'':"\n"), $desc ); } sub test_error { my $desc = shift; my $pod = shift; my $expected = shift; my $s; my $ADVENT = Pod::Advent->new; $Pod::Advent::BODY_ONLY = 1; $ADVENT->output_string( \$s ); my $rc = eval { $ADVENT->parse_string_document("=pod\n\n" . $pod . "\n\n=cut"); }; is( $rc, undef, "{error checking} $desc - got undef" ); like( $@, qr/^$expected\n$/, "{error checking} $desc - got error" ); } test_snippet 'bold line', 'This is a B.', '

This is a test.

'; test_snippet 'italics line', 'This is a I.', '

This is a test.

'; test_snippet 'A', 'A', '

http://example.com

'; test_snippet 'A', 'A', '

stuff

'; test_snippet 'M', 'M', '

Foo::Bar

'; test_snippet 'L<>', 'L', '

test

'; test_snippet 'F<>', 'F', '

test

'; test_snippet 'C<>', 'C', qq{

test

}; test_snippet 'I<>', 'I', '

test

'; test_snippet 'B<>', 'B', '

test

'; test_snippet 'B>', 'B bar>', '

foo test bar

'; test_snippet 'P<> a', 'P<2008-1>', '

2008/1

'; test_snippet 'P<> b', 'P<2008-1|One>', '

One

'; test_snippet 'P<> c', 'P<2008-12-1>', '

2008/1

'; test_snippet 'P<> d', 'P<2008-12-1|One>', '

One

'; test_snippet 'P<> e', 'P<2008-01>', '

2008/1

'; test_snippet 'D<>', 'D', '

test

'; test_snippet 'D>', 'D bar>', '

foo test bar

'; test_snippet 'code', qq{=begin code\n\nfoo\n\n=end code}, q{
foo
}; test_snippet 'codeNNN', qq{=begin codeNNN\n\nfoo\n\n=end codeNNN}, q{
   1 foo
}; test_snippet 'pre', qq{=begin pre\n\nfoo\n\n=end pre}, q{
foo
}; test_snippet 'quote', qq{=begin quote\n\nfoo\n\n=end quote}, q{

foo

}, 1; test_snippet 'eds', qq{=begin eds\n\nfoo\n\n=end eds}, q{

foo

}, 1; test_snippet 'unknown', qq{=begin unknown\n\nfoo\n\n=end unknown}, '', 1; test_snippet 'head1', qq{=head1 foo}, q{

foo

}; test_snippet 'head1a', qq{=head1 foo\nbar}, q{

foo bar

}; test_snippet 'head1b', qq{=head1 foo\n\nbar}, qq{

foo

\n

bar

}; test_snippet 'head2', qq{=head2 foo}, q{

foo

}; test_snippet 'head3', qq{=head3 foo}, q{

foo

}; test_snippet 'head4', qq{=head4 foo}, q{

foo

}; test_snippet 'html-b/i', q{foobarstuff}, q{

foobarstuff

}; test_snippet 'html-tt.1', q{CPANZ<>}, q{

CPAN

}; test_snippet 'html-tt.2', q{CPANE/tt>}, q{

CPAN

}; test_snippet 'html-comment.1', qq{}, q{

}; test_snippet 'html-comment.2', qq{}, q{

}; test_snippet 'html-comment.3', qq{}, q{

}; TODO: { local $TODO = 'need to figure out how to do special treatment of html comments'; test_snippet 'html-comment.4', qq{}, q{

}, 1; test_snippet 'html-comment.5', qq{}, q{

}, 1; } ##################################################### foreach my $s ( qw{ 2008-X 208-1 2008 foo 2008/1 2009-1 2007-50 2008-1| 2008-13-1 2008/1 2008/12/1 2008-123 2008-12-123 } ){ test_error "P<$s>", "P<$s>", qr{invalid date from P<\Q$s\E> at .*?lib/Pod/Advent.pm line \d+.}; } test_error "N", "N", qr{footnote 'foo' is not defined at .*?lib/Pod/Advent.pm line \d+.}; test_error "N,N", "N,N", qr{footnote 'foo' is already referenced at .*?lib/Pod/Advent.pm line \d+.}; test_error "footnote foo", < stuff =end footnote foo EOF