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 | 90 | if ($^O eq 'VMS') { # privlib is perl_root:[lib] OK but not under mms |
16ed4686 | 91 | $result = VMS::Filespec::vmsify($result); #if you want VMS you need to force it. |
16be52b8 PP |
92 | $compare = "lib.File]Find.pm"; |
93 | $result =~ s/perl_root:\[\-?\.?//i; | |
94 | $result =~ s/\[\-?\.?//i; # needed under `mms test` | |
95 | ok($result,$compare); | |
96 | } | |
97 | else { | |
c23d1eb0 MR |
98 | $compare = $ENV{PERL_CORE} ? |
99 | File::Spec->catfile(File::Spec->updir, 'lib','File','Find.pm') | |
100 | : File::Spec->catfile($Config::Config{privlib},"File","Find.pm"); | |
16be52b8 PP |
101 | ok(_canon($result),_canon($compare)); |
102 | } | |
7b43481a JH |
103 | |
104 | # Search for a documentation pod rather than a module | |
c23d1eb0 MR |
105 | my $searchpod = $ENV{PERL_CORE} ? 'Stuff' : 'perlfunc'; |
106 | print "### searching for $searchpod.pod\n"; | |
107 | $result = pod_where($ENV{PERL_CORE} ? | |
108 | { -dirs => [ File::Spec->catdir('pod', 'testpods', 'lib', 'Pod') ], | |
109 | -verbose => $VERBOSE } | |
110 | : { -inc => 1, -verbose => $VERBOSE }, $searchpod) | |
111 | || "undef - $searchpod.pod not found!"; | |
16be52b8 | 112 | print "### found $result\n"; |
7b43481a | 113 | |
c23d1eb0 MR |
114 | if($ENV{PERL_CORE}) { |
115 | $compare = File::Spec->catfile('pod', 'testpods', 'lib', 'Pod' ,'Stuff.pm'); | |
116 | ok(_canon($result),_canon($compare)); | |
117 | } | |
118 | elsif ($^O eq 'VMS') { # privlib is perl_root:[lib] unfortunately | |
119 | $compare = "/lib/pod/perlfunc.pod"; | |
120 | $result = VMS::Filespec::unixify($result); | |
121 | $result =~ s/perl_root\///i; | |
122 | $result =~ s/^\.\.//; # needed under `mms test` | |
123 | ok($result,$compare); | |
124 | } | |
125 | else { | |
126 | $compare = File::Spec->catfile($Config::Config{privlib}, | |
127 | ($^O =~ /macos|darwin|cygwin/i ? 'pods' : 'pod'),"perlfunc.pod"); | |
128 | ok(_canon($result),_canon($compare)); | |
129 | } | |
7b43481a JH |
130 | |
131 | # make the path as generic as possible | |
132 | sub _canon | |
133 | { | |
134 | my ($path) = @_; | |
135 | $path = File::Spec->canonpath($path); | |
136 | my @comp = File::Spec->splitpath($path); | |
137 | my @dir = File::Spec->splitdir($comp[1]); | |
138 | $comp[1] = File::Spec->catdir(@dir); | |
c23d1eb0 | 139 | $path = File::Spec->catpath(@comp); |
7b43481a | 140 | $path = uc($path) if File::Spec->case_tolerant; |
c23d1eb0 | 141 | print "### general path: $path\n" if $VERBOSE; |
7b43481a JH |
142 | $path; |
143 | } | |
144 |