| Subject: | parselink() "inferred text" inconsistent with perlpodspec examples |
parselink does not entirely agree with perlpodspec in regards to the
"inferred text".
The current parselink matches the example output for all but one case.
See the first patch for those tests (including one failure).
I believe the examples in perlpodspec are incorrect.
See the report here:
https://rt.perl.org/rt3/Ticket/Display.html?id=104000
If that report is correct and the example gets fixed,
then parselink would need the second patch applied.
This is not backward-compatible (previous behavior being a bug)
though it seems unlikely for anything downstream to use the inferred
text when alternate text is present (in which case the change wouldn't
break anything).
If anything did in fact want the inferred text in addition to the
specified alternate text then this change would make that data available.
It also makes the code simpler which is always a win!
| Subject: | parselink-02-inferred-text.patch |
diff --git a/lib/Pod/ParseLink.pm b/lib/Pod/ParseLink.pm
index 750fdfb..47a46a0 100644
--- a/lib/Pod/ParseLink.pm
+++ b/lib/Pod/ParseLink.pm
@@ -86,20 +86,10 @@ sub parselink {
($text, $link) = split (/\|/, $link, 2);
}
if ($link =~ /\A\w+:[^:\s]\S*\Z/) {
- my $inferred;
- if (defined ($text) && length ($text) > 0) {
- return ($text, $text, $link, undef, 'url');
- } else {
- return ($text, $link, $link, undef, 'url');
- }
+ return ($text, $link, $link, undef, 'url');
} else {
my ($name, $section) = _parse_section ($link);
- my $inferred;
- if (defined ($text) && length ($text) > 0) {
- $inferred = $text;
- } else {
- $inferred = _infer_text ($name, $section);
- }
+ my $inferred = _infer_text ($name, $section);
my $type = ($name && $name =~ /\(\S*\)/) ? 'man' : 'pod';
return ($text, $inferred, $name, $section, $type);
}
diff --git a/t/parselink.t b/t/parselink.t
index bb3485e..cd2318d 100755
--- a/t/parselink.t
+++ b/t/parselink.t
@@ -14,7 +14,7 @@ our @TESTS = (
undef, 'foo', 'foo', undef, 'pod' ],
[ 'foo|bar',
- 'foo', 'foo', 'bar', undef, 'pod' ],
+ 'foo', 'bar', 'bar', undef, 'pod' ],
[ 'foo/bar',
undef, '"bar" in foo', 'foo', 'bar', 'pod' ],
@@ -41,7 +41,7 @@ our @TESTS = (
undef, '"boo" in foo bar baz', 'foo bar baz', 'boo', 'pod' ],
[ 'anchor|name/section',
- 'anchor', 'anchor', 'name', 'section', 'pod' ],
+ 'anchor', '"section" in name', 'name', 'section', 'pod' ],
[ '"boo var baz"',
undef, '"boo var baz"', undef, 'boo var baz', 'pod' ],
@@ -57,7 +57,7 @@ our @TESTS = (
undef, 'fooZ<>bar', 'fooZ<>bar', undef, 'pod' ],
[ 'Testing I<italics>|foo/bar',
- 'Testing I<italics>', 'Testing I<italics>', 'foo', 'bar', 'pod' ],
+ 'Testing I<italics>', '"bar" in foo', 'foo', 'bar', 'pod' ],
[ 'foo/I<Italic> text',
undef, '"I<Italic> text" in foo', 'foo', 'I<Italic> text', 'pod' ],
@@ -67,7 +67,7 @@ our @TESTS = (
'fooE<verbar>barZ<>', 'Section C<with> I<B<other> markup', 'pod' ],
[ 'Nested L<http://www.perl.org/>|fooE<sol>bar',
- 'Nested L<http://www.perl.org/>', 'Nested L<http://www.perl.org/>',
+ 'Nested L<http://www.perl.org/>', 'fooE<sol>bar',
'fooE<sol>bar', undef, 'pod' ],
[ 'ls(1)',
@@ -77,7 +77,7 @@ our @TESTS = (
undef, '"open" in perlfunc(1)', 'perlfunc(1)', 'open', 'man' ],
[ 'some manual page|perl(1)',
- 'some manual page', 'some manual page', 'perl(1)', undef, 'man' ],
+ 'some manual page', 'perl(1)', 'perl(1)', undef, 'man' ],
[ 'http://www.perl.org/',
undef, 'http://www.perl.org/', 'http://www.perl.org/', undef, 'url' ],
@@ -87,13 +87,13 @@ our @TESTS = (
'news:yld72axzc8.fsf@windlord.stanford.edu', undef, 'url' ],
[ 'link|http://www.perl.org/',
- 'link', 'link', 'http://www.perl.org/', undef, 'url' ],
+ 'link', 'http://www.perl.org/', 'http://www.perl.org/', undef, 'url' ],
[ '0|http://www.perl.org/',
- '0', '0', 'http://www.perl.org/', undef, 'url' ],
+ '0', 'http://www.perl.org/', 'http://www.perl.org/', undef, 'url' ],
[ '0|Pod::Parser',
- '0', '0', 'Pod::Parser', undef, 'pod' ],
+ '0', 'Pod::Parser', 'Pod::Parser', undef, 'pod' ],
# specifically test the examples from perlpodspec:
@@ -101,7 +101,7 @@ our @TESTS = (
undef, "Foo::Bar", "Foo::Bar", undef, 'pod' ],
[ "Perlport's section on NL's|perlport/Newlines",
- "Perlport's section on NL's", "Perlport's section on NL's", "perlport", "Newlines", 'pod' ],
+ "Perlport's section on NL's", '"Newlines" in perlport', "perlport", "Newlines", 'pod' ],
[ 'perlport/Newlines',
undef, '"Newlines" in perlport', "perlport", "Newlines", 'pod' ],
| Subject: | parselink-01-perlpodspec-tests.patch |
diff --git a/t/parselink.t b/t/parselink.t
index 828b2ec..bb3485e 100755
--- a/t/parselink.t
+++ b/t/parselink.t
@@ -94,6 +94,29 @@ our @TESTS = (
[ '0|Pod::Parser',
'0', '0', 'Pod::Parser', undef, 'pod' ],
+
+ # specifically test the examples from perlpodspec:
+
+ [ 'Foo::Bar',
+ undef, "Foo::Bar", "Foo::Bar", undef, 'pod' ],
+
+ [ "Perlport's section on NL's|perlport/Newlines",
+ "Perlport's section on NL's", "Perlport's section on NL's", "perlport", "Newlines", 'pod' ],
+
+ [ 'perlport/Newlines',
+ undef, '"Newlines" in perlport', "perlport", "Newlines", 'pod' ],
+
+ [ 'crontab(5)/"DESCRIPTION"',
+ undef, '"DESCRIPTION" in crontab(5)', "crontab(5)", "DESCRIPTION", 'man' ],
+
+ [ '/Object Attributes',
+ undef, '"Object Attributes"', undef, "Object Attributes", 'pod' ],
+
+ [ 'http://www.perl.org/',
+ undef, "http://www.perl.org/", "http://www.perl.org/", undef, 'url' ],
+
+ [ 'Perl.org|http://www.perl.org/',
+ "Perl.org", "http://www.perl.org/", "http://www.perl.org/", undef, 'url' ],
);
BEGIN {
@@ -104,7 +127,7 @@ BEGIN {
use strict;
-use Test::More tests => 28;
+use Test::More tests => 35;
BEGIN { use_ok ('Pod::ParseLink') }
# Used for reporting test failures.