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