Codebase list libtest-pod-perl / 07c4b7b
Merge commit 'jettero/master' Andy Lester 14 years ago
6 changed file(s) with 98 addition(s) and 3 deletion(s). Raw diff Collapse all Expand all
+1
-0
.gitignore less more
22 Makefile.old
33 blib/
44 pm_to_blib
5 notes.txt
+3
-0
MANIFEST less more
2222 t/spaced-directives.t
2323 t/unknown-directive.pod
2424 t/unknown-directive.t
25 t/a-href-L.pod
26 t/a-href-L.t
27
2528 META.yml Module meta-data (added by MakeMaker)
+1
-1
Makefile.PL less more
44 'NAME' => 'Test::Pod',
55 'VERSION_FROM' => 'Pod.pm',
66 'PREREQ_PM' => {
7 'Pod::Simple' => '2.04',
7 'Pod::Simple' => '3.07', # required for t/a-href-L.t apparently
88 'Test::More' => '0.62',
99 'Test::Builder::Tester' => '1.02',
1010 'File::Spec' => 0,
+49
-2
Pod.pm less more
0 package Test::Pod::_parser;
1 use base 'Pod::Simple';
2 use strict;
3
4 sub _handle_element_start {
5 my($parser, $element_name, $attr_hash_r) = @_;
6
7 # Curiously, Pod::Simple supports L<text|scheme:...> rather well.
8
9 if( $element_name eq "L" and $attr_hash_r->{type} eq "url") {
10 $parser->{_state_of_concern}{'Lurl'} = $attr_hash_r->{to};
11 }
12
13 return $parser->SUPER::_handle_element_start(@_);
14 }
15
16 sub _handle_element_end {
17 my($parser, $element_name) = @_;
18
19 delete $parser->{_state_of_concern}{'Lurl'}
20 if $element_name eq "L" and exists $parser->{_state_of_concern}{'Lurl'};
21
22 return $parser->SUPER::_handle_element_end(@_);
23 }
24
25 sub _handle_text {
26 my($parser, $text) = @_;
27 if( my $href = $parser->{_state_of_concern}{'Lurl'} ) {
28 if( $href ne $text ) {
29 my $line = $parser->line_count() -2; # XXX: -2, WHY WHY WHY??
30
31 $parser->whine($line, "L<text|scheme:...> is invalid according to perlpod");
32 }
33 }
34
35 return $parser->SUPER::_handle_text(@_);
36 }
37
38 1;
39
040 package Test::Pod;
141
242 use strict;
63103
64104 use 5.008;
65105
66 use Pod::Simple;
67106 use Test::Builder;
68107 use File::Spec;
69108
80119
81120 $Test->exported_to($caller);
82121 $Test->plan(@_);
122 }
123
124 sub _additional_test_pod_specific_checks {
125 my ($ok, $errata, $file) = @_;
126
127 return $ok;
83128 }
84129
85130 =head1 FUNCTIONS
108153 return;
109154 }
110155
111 my $checker = Pod::Simple->new;
156 my $checker = Test::Pod::_parser->new;
112157
113158 $checker->output_string( \my $trash ); # Ignore any output
114159 $checker->parse_file( $file );
115160
116161 my $ok = !$checker->any_errata_seen;
162 $ok = _additional_test_pod_specific_checks( $ok, ($checker->{errata}||={}), $file );
163
117164 $Test->ok( $ok, $name );
118165 if ( !$ok ) {
119166 my $lines = $checker->{errata};
+25
-0
t/a-href-L.pod less more
0
1 =head1 COPYRIGHT
2
3 Copyright 2009, Paul Miller C<< <jettero@cpan.org> >>
4
5
6 ... test text, please ignore
7
8 =head1 SEE ALSO
9
10 ... test text, please ignore
11
12 Invalid according to L<perlpod/Formatting Codes>:
13 L<Paul's Perl Modules|http://voltar.org/perl>
14
15 This should be OK:
16
17 L<Paul's Perl Modules|http://voltar.org/perl>
18
19 This should also be OK: L<http://voltar.org/perl>
20
21 ... test text, please ignore
22
23 =cut
24
+19
-0
t/a-href-L.t less more
0 #!perl -T
1
2 use strict;
3
4 use Test::Builder::Tester tests => 2;
5 use Test::More;
6
7 BEGIN {
8 use_ok( 'Test::Pod' );
9 }
10
11 my $file = 't/a-href-L.pod';
12 test_out( "not ok 1 - POD test for $file" );
13 pod_file_ok( $file );
14 test_fail(-1);
15 test_diag(
16 "$file (14): L<text|scheme:...> is invalid according to perlpod",
17 );
18 test_test( "$file is bad" );