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