Commit | Line | Data |
7b43481a |
1 | # Testing of Pod::Find |
2 | # Author: Marek Rouchal <marek@saftsack.fs.uni-bayreuth.de> |
3 | |
a8135056 |
4 | BEGIN { |
22ea838f |
5 | chdir 't' if -d 't'; |
6 | # The ../../../../../lib is for finding lib/utf8.pm |
7 | # when running under all-utf8 settings (pod/find.t) |
8 | # does not directly require lib/utf8.pm but regular |
9 | # expressions will need that. |
10 | @INC = qw(../lib ../../../../../lib); |
a8135056 |
11 | } |
12 | |
7b43481a |
13 | $| = 1; |
14 | |
15 | use Test; |
16 | |
8ac1de08 |
17 | BEGIN { |
18 | plan tests => 4; |
19 | use File::Spec; |
8ac1de08 |
20 | } |
7b43481a |
21 | |
22 | use Pod::Find qw(pod_find pod_where); |
7b43481a |
23 | |
24 | # load successful |
25 | ok(1); |
26 | |
27 | require Cwd; |
7b43481a |
28 | my $VERBOSE = 0; |
8ac1de08 |
29 | my $lib_dir = File::Spec->catdir('pod', 'testpods', 'lib'); |
16be52b8 |
30 | if ($^O eq 'VMS') { |
8ac1de08 |
31 | $lib_dir = VMS::Filespec::unixify(File::Spec->catdir('pod', 'testpods', 'lib')); |
16be52b8 |
32 | $Qlib_dir = $lib_dir; |
33 | $Qlib_dir =~ s#\/#::#g; |
34 | } |
35 | print "### searching $lib_dir\n"; |
8ac1de08 |
36 | my %pods = pod_find($lib_dir); |
37 | my $result = join(',', sort values %pods); |
38 | my $compare = join(',', sort qw( |
39 | Pod::Stuff |
7b43481a |
40 | )); |
16be52b8 |
41 | if ($^O eq 'VMS') { |
42 | $compare = lc($compare); |
e4dfc136 |
43 | my $undollared = $Qlib_dir; |
44 | $undollared =~ s/\$/\\\$/g; |
45 | $undollared =~ s/\-/\\\-/g; |
46 | $result =~ s/$undollared/pod::/g; |
53ecdda1 |
47 | $result =~ s/\$//g; |
16be52b8 |
48 | my $count = 0; |
49 | my @result = split(/,/,$result); |
50 | my @compare = split(/,/,$compare); |
51 | foreach(@compare) { |
52 | $count += grep {/$_/} @result; |
53 | } |
54 | ok($count/($#result+1)-1,$#compare); |
55 | } |
ea9ff3e9 |
56 | elsif ($^O eq 'dos') { |
57 | ok(lc $result,lc $compare); |
58 | } |
16be52b8 |
59 | else { |
60 | ok($result,$compare); |
61 | } |
7b43481a |
62 | |
7b43481a |
63 | |
16be52b8 |
64 | print "### searching for File::Find\n"; |
7b43481a |
65 | $result = pod_where({ -inc => 1, -verbose => $VERBOSE }, 'File::Find') |
66 | || 'undef - pod not found!'; |
16be52b8 |
67 | print "### found $result\n"; |
7b43481a |
68 | |
69 | require Config; |
16be52b8 |
70 | if ($^O eq 'VMS') { # privlib is perl_root:[lib] OK but not under mms |
71 | $compare = "lib.File]Find.pm"; |
72 | $result =~ s/perl_root:\[\-?\.?//i; |
73 | $result =~ s/\[\-?\.?//i; # needed under `mms test` |
74 | ok($result,$compare); |
75 | } |
76 | else { |
8ac1de08 |
77 | $compare = File::Spec->catfile(File::Spec->updir, 'lib','File','Find.pm'); |
16be52b8 |
78 | ok(_canon($result),_canon($compare)); |
79 | } |
7b43481a |
80 | |
81 | # Search for a documentation pod rather than a module |
8ac1de08 |
82 | print "### searching for Stuff.pod\n"; |
83 | my $search = File::Spec->catdir('pod', 'testpods', 'lib', 'Pod'); |
84 | $result = pod_where({ -dirs => [$search], -verbose => $VERBOSE }, 'Stuff') |
85 | || 'undef - Stuff.pod not found!'; |
16be52b8 |
86 | print "### found $result\n"; |
7b43481a |
87 | |
8ac1de08 |
88 | $compare = File::Spec->catfile('pod', 'testpods', 'lib', 'Pod' ,'Stuff.pod'); |
89 | ok(_canon($result),_canon($compare)); |
7b43481a |
90 | |
91 | # make the path as generic as possible |
92 | sub _canon |
93 | { |
94 | my ($path) = @_; |
95 | $path = File::Spec->canonpath($path); |
96 | my @comp = File::Spec->splitpath($path); |
97 | my @dir = File::Spec->splitdir($comp[1]); |
98 | $comp[1] = File::Spec->catdir(@dir); |
99 | $path = File::Spec->catpath(@dir); |
100 | $path = uc($path) if File::Spec->case_tolerant; |
101 | $path; |
102 | } |
103 | |