Commit | Line | Data |
b616daaf |
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 | |
94 | BEGIN { |
95 | chdir 't' if -d 't'; |
96 | unshift (@INC, '../blib/lib'); |
97 | $| = 1; |
98 | print "1..25\n"; |
99 | } |
100 | |
101 | END { |
102 | print "not ok 1\n" unless $loaded; |
103 | } |
104 | |
105 | use Pod::ParseLink; |
106 | $loaded = 1; |
107 | print "ok 1\n"; |
108 | |
109 | # Used for reporting test failures. |
110 | my @names = qw(text inferred name section type); |
111 | |
112 | my $n = 2; |
113 | for (@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 | } |