This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Pod::Html - correctly link to =item's on the same page
[perl5.git] / lib / Pod / t / parselink.t
CommitLineData
b616daaf
JH
1#!/usr/bin/perl -w
2# $Id: parselink.t,v 1.1 2001/11/23 10:09:06 eagle Exp $
3#
4# parselink.t -- Tests for Pod::ParseLink.
5#
6# Copyright 2001 by Russ Allbery <rra@stanford.edu>
7#
8# This program is free software; you may redistribute it and/or modify it
9# under the same terms as Perl itself.
10
11# The format of each entry in this array is the L<> text followed by the
12# five-element parse returned by parselink. When adding a new test, also
13# increment the test count in the BEGIN block below. We don't use any of the
14# fancy test modules intentionally for backward compatibility to older
15# versions of Perl.
16@TESTS = (
17 [ 'foo',
18 undef, 'foo', 'foo', undef, 'pod' ],
19
20 [ 'foo|bar',
21 'foo', 'foo', 'bar', undef, 'pod' ],
22
23 [ 'foo/bar',
24 undef, '"bar" in foo', 'foo', 'bar', 'pod' ],
25
26 [ 'foo/"baz boo"',
27 undef, '"baz boo" in foo', 'foo', 'baz boo', 'pod' ],
28
29 [ '/bar',
30 undef, '"bar"', undef, 'bar', 'pod' ],
31
32 [ '/"baz boo"',
33 undef, '"baz boo"', undef, 'baz boo', 'pod' ],
34
35 [ '/baz boo',
36 undef, '"baz boo"', undef, 'baz boo', 'pod' ],
37
38 [ 'foo bar/baz boo',
39 undef, '"baz boo" in foo bar', 'foo bar', 'baz boo', 'pod' ],
40
41 [ 'foo bar / baz boo',
42 undef, '"baz boo" in foo bar', 'foo bar', 'baz boo', 'pod' ],
43
44 [ "foo\nbar\nbaz\n/\nboo",
45 undef, '"boo" in foo bar baz', 'foo bar baz', 'boo', 'pod' ],
46
47 [ 'anchor|name/section',
48 'anchor', 'anchor', 'name', 'section', 'pod' ],
49
50 [ '"boo var baz"',
51 undef, '"boo var baz"', undef, 'boo var baz', 'pod' ],
52
53 [ 'bar baz',
54 undef, '"bar baz"', undef, 'bar baz', 'pod' ],
55
56 [ '"boo bar baz / baz boo"',
57 undef, '"boo bar baz / baz boo"', undef, 'boo bar baz / baz boo',
58 'pod' ],
59
60 [ 'fooZ<>bar',
61 undef, 'fooZ<>bar', 'fooZ<>bar', undef, 'pod' ],
62
63 [ 'Testing I<italics>|foo/bar',
64 'Testing I<italics>', 'Testing I<italics>', 'foo', 'bar', 'pod' ],
65
66 [ 'foo/I<Italic> text',
67 undef, '"I<Italic> text" in foo', 'foo', 'I<Italic> text', 'pod' ],
68
69 [ 'fooE<verbar>barZ<>/Section C<with> I<B<other> markup',
70 undef, '"Section C<with> I<B<other> markup" in fooE<verbar>barZ<>',
71 'fooE<verbar>barZ<>', 'Section C<with> I<B<other> markup', 'pod' ],
72
73 [ 'Nested L<http://www.perl.org/>|fooE<sol>bar',
74 'Nested L<http://www.perl.org/>', 'Nested L<http://www.perl.org/>',
75 'fooE<sol>bar', undef, 'pod' ],
76
77 [ 'ls(1)',
78 undef, 'ls(1)', 'ls(1)', undef, 'man' ],
79
80 [ ' perlfunc(1)/open ',
81 undef, '"open" in perlfunc(1)', 'perlfunc(1)', 'open', 'man' ],
82
83 [ 'some manual page|perl(1)',
84 'some manual page', 'some manual page', 'perl(1)', undef, 'man' ],
85
86 [ 'http://www.perl.org/',
87 undef, 'http://www.perl.org/', 'http://www.perl.org/', undef, 'url' ],
88
89 [ 'news:yld72axzc8.fsf@windlord.stanford.edu',
90 undef, 'news:yld72axzc8.fsf@windlord.stanford.edu',
91 'news:yld72axzc8.fsf@windlord.stanford.edu', undef, 'url' ]
92);
93
94BEGIN {
95 chdir 't' if -d 't';
96 unshift (@INC, '../blib/lib');
97 $| = 1;
98 print "1..25\n";
99}
100
101END {
102 print "not ok 1\n" unless $loaded;
103}
104
105use Pod::ParseLink;
106$loaded = 1;
107print "ok 1\n";
108
109# Used for reporting test failures.
110my @names = qw(text inferred name section type);
111
112my $n = 2;
113for (@TESTS) {
114 my @expected = @$_;
115 my $link = shift @expected;
116 my @results = parselink ($link);
117 my $okay = 1;
118 for (0..4) {
119 # Make sure to check undef explicitly; we don't want undef to match
120 # the empty string because they're semantically different.
121 unless ((!defined ($results[$_]) && !defined ($expected[$_]))
122 || (defined ($results[$_]) && defined ($expected[$_])
123 && $results[$_] eq $expected[$_])) {
124 print "not ok $n\n" if $okay;
125 print "# Incorrect $names[$_]:\n";
126 print "# expected: $expected[$_]\n";
127 print "# seen: $results[$_]\n";
128 $okay = 0;
129 }
130 }
131 print "ok $n\n" if $okay;
132 $n++;
133}