Commit | Line | Data |
---|---|---|
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 | ||
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 | } |