The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

RGARCIA / perl-5.9.3 / lib / Pod / t / parselink.t 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133

              
#!/usr/bin/perl -w
# $Id: parselink.t,v 1.1 2001/11/23 10:09:06 eagle Exp $
#
# parselink.t -- Tests for Pod::ParseLink.
#
# Copyright 2001 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
# The format of each entry in this array is the L<> text followed by the
# five-element parse returned by parselink.  When adding a new test, also
# increment the test count in the BEGIN block below.  We don't use any of the
# fancy test modules intentionally for backward compatibility to older
# versions of Perl.
@TESTS = (
    [ 'foo',
      undef, 'foo', 'foo', undef, 'pod' ],
    [ 'foo|bar',
      'foo', 'foo', 'bar', undef, 'pod' ],
    [ 'foo/bar',
      undef, '"bar" in foo', 'foo', 'bar', 'pod' ],
    [ 'foo/"baz boo"',
      undef, '"baz boo" in foo', 'foo', 'baz boo', 'pod' ],
    [ '/bar',
      undef, '"bar"', undef, 'bar', 'pod' ],
    [ '/"baz boo"',
      undef, '"baz boo"', undef, 'baz boo', 'pod' ],
    [ '/baz boo',
      undef, '"baz boo"', undef, 'baz boo', 'pod' ],
    [ 'foo bar/baz boo',
      undef, '"baz boo" in foo bar', 'foo bar', 'baz boo', 'pod' ],
    [ 'foo bar  /  baz boo',
      undef, '"baz boo" in foo bar', 'foo bar', 'baz boo', 'pod' ],
    [ "foo\nbar\nbaz\n/\nboo",
      undef, '"boo" in foo bar baz', 'foo bar baz', 'boo', 'pod' ],
    [ 'anchor|name/section',
      'anchor', 'anchor', 'name', 'section', 'pod' ],
    [ '"boo var baz"',
      undef, '"boo var baz"', undef, 'boo var baz', 'pod' ],
    [ 'bar baz',
      undef, '"bar baz"', undef, 'bar baz', 'pod' ],
    [ '"boo bar baz / baz boo"',
      undef, '"boo bar baz / baz boo"', undef, 'boo bar baz / baz boo',
      'pod' ],
    [ 'fooZ<>bar',
      undef, 'fooZ<>bar', 'fooZ<>bar', undef, 'pod' ],
    [ 'Testing I<italics>|foo/bar',
      'Testing I<italics>', 'Testing I<italics>', 'foo', 'bar', 'pod' ],
    [ 'foo/I<Italic> text',
      undef, '"I<Italic> text" in foo', 'foo', 'I<Italic> text', 'pod' ],
    [ 'fooE<verbar>barZ<>/Section C<with> I<B<other> markup',
      undef, '"Section C<with> I<B<other> markup" in fooE<verbar>barZ<>',
      '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/>',
      'fooE<sol>bar', undef, 'pod' ],
    [ 'ls(1)',
      undef, 'ls(1)', 'ls(1)', undef, 'man' ],
    [ '  perlfunc(1)/open  ',
      undef, '"open" in perlfunc(1)', 'perlfunc(1)', 'open', 'man' ],
    [ 'some manual page|perl(1)',
      'some manual page', 'some manual page', 'perl(1)', undef, 'man' ],
    [ 'http://www.perl.org/',
      undef, 'http://www.perl.org/', 'http://www.perl.org/', undef, 'url' ],
    [ 'news:yld72axzc8.fsf@windlord.stanford.edu',
      undef, 'news:yld72axzc8.fsf@windlord.stanford.edu',
      'news:yld72axzc8.fsf@windlord.stanford.edu', undef, 'url' ]
);
BEGIN {
    chdir 't' if -d 't';
    unshift (@INC, '../blib/lib');
    $| = 1;
    print "1..25\n";
}
END {
    print "not ok 1\n" unless $loaded;
}
use Pod::ParseLink;
$loaded = 1;
print "ok 1\n";
# Used for reporting test failures.
my @names = qw(text inferred name section type);
my $n = 2;
for (@TESTS) {
    my @expected = @$_;
    my $link = shift @expected;
    my @results = parselink ($link);
    my $okay = 1;
    for (0..4) {
        # Make sure to check undef explicitly; we don't want undef to match
        # the empty string because they're semantically different.
        unless ((!defined ($results[$_]) && !defined ($expected[$_]))
                || (defined ($results[$_]) && defined ($expected[$_])
                    && $results[$_] eq $expected[$_])) {
            print "not ok $n\n" if $okay;
            print "# Incorrect $names[$_]:\n";
            print "#   expected: $expected[$_]\n";
            print "#       seen: $results[$_]\n";
            $okay = 0;
        }
    }
    print "ok $n\n" if $okay;
    $n++;
}