Commit | Line | Data |
7b43481a |
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 |
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 |
13 | } |
14 | |
7b43481a |
15 | $| = 1; |
16 | |
8b2bdce6 |
17 | use Test::More tests => 4; |
7b43481a |
18 | |
c23d1eb0 |
19 | BEGIN { |
8b2bdce6 |
20 | # 1. load successful |
21 | use_ok('Pod::Find', qw(pod_find pod_where)); |
8ac1de08 |
22 | } |
7b43481a |
23 | |
c23d1eb0 |
24 | use File::Spec; |
7b43481a |
25 | |
7b43481a |
26 | require Cwd; |
c23d1eb0 |
27 | my $THISDIR = Cwd::cwd(); |
28 | my $VERBOSE = $ENV{PERL_CORE} ? 0 : ($ENV{TEST_VERBOSE} || 0); |
29 | my $lib_dir = $ENV{PERL_CORE} ? |
30 | File::Spec->catdir('pod', 'testpods', 'lib') |
31 | : File::Spec->catdir($THISDIR,'lib'); |
1bc4b319 |
32 | |
33 | my $vms_unix_rpt = 0; |
34 | my $vms_efs = 0; |
35 | my $unix_mode = 1; |
36 | |
16be52b8 |
37 | if ($^O eq 'VMS') { |
c23d1eb0 |
38 | $lib_dir = $ENV{PERL_CORE} ? |
39 | VMS::Filespec::unixify(File::Spec->catdir('pod', 'testpods', 'lib')) |
40 | : VMS::Filespec::unixify(File::Spec->catdir($THISDIR,'-','lib','pod')); |
16be52b8 |
41 | $Qlib_dir = $lib_dir; |
42 | $Qlib_dir =~ s#\/#::#g; |
1bc4b319 |
43 | |
44 | $unix_mode = 0; |
45 | if (eval 'require VMS::Feature') { |
46 | $vms_unix_rpt = VMS::Feature::current("filename_unix_report"); |
47 | $vms_efs = VMS::Feature::current("efs_charset"); |
48 | } else { |
49 | my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; |
50 | my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || ''; |
51 | $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; |
52 | $vms_efs = $efs_charset =~ /^[ET1]/i; |
53 | } |
54 | |
55 | # Traditional VMS mode only if VMS is not in UNIX compatible mode. |
56 | $unix_mode = ($vms_efs && $vms_unix_rpt); |
16be52b8 |
57 | } |
c23d1eb0 |
58 | |
8b2bdce6 |
59 | print "### 2. searching $lib_dir\n"; |
8ac1de08 |
60 | my %pods = pod_find($lib_dir); |
61 | my $result = join(',', sort values %pods); |
c23d1eb0 |
62 | print "### found $result\n"; |
63 | my $compare = $ENV{PERL_CORE} ? |
64 | join(',', sort qw( |
8ac1de08 |
65 | Pod::Stuff |
c23d1eb0 |
66 | )) |
7d8277e2 |
67 | : join(',', sort qw( |
c23d1eb0 |
68 | Pod::Checker |
69 | Pod::Find |
70 | Pod::InputObjects |
71 | Pod::ParseUtils |
72 | Pod::Parser |
73 | Pod::PlainText |
74 | Pod::Select |
75 | Pod::Usage |
7b43481a |
76 | )); |
16be52b8 |
77 | if ($^O eq 'VMS') { |
78 | $compare = lc($compare); |
e4dfc136 |
79 | my $undollared = $Qlib_dir; |
80 | $undollared =~ s/\$/\\\$/g; |
81 | $undollared =~ s/\-/\\\-/g; |
82 | $result =~ s/$undollared/pod::/g; |
53ecdda1 |
83 | $result =~ s/\$//g; |
16be52b8 |
84 | my $count = 0; |
85 | my @result = split(/,/,$result); |
86 | my @compare = split(/,/,$compare); |
87 | foreach(@compare) { |
88 | $count += grep {/$_/} @result; |
89 | } |
8b2bdce6 |
90 | is($count/($#result+1)-1,$#compare); |
16be52b8 |
91 | } |
c23d1eb0 |
92 | elsif (File::Spec->case_tolerant || $^O eq 'dos') { |
8b2bdce6 |
93 | is(lc $result,lc $compare); |
ea9ff3e9 |
94 | } |
16be52b8 |
95 | else { |
8b2bdce6 |
96 | is($result,$compare); |
16be52b8 |
97 | } |
7b43481a |
98 | |
8b2bdce6 |
99 | print "### 3. searching for File::Find\n"; |
7b43481a |
100 | $result = pod_where({ -inc => 1, -verbose => $VERBOSE }, 'File::Find') |
101 | || 'undef - pod not found!'; |
16be52b8 |
102 | print "### found $result\n"; |
7b43481a |
103 | |
104 | require Config; |
16be52b8 |
105 | if ($^O eq 'VMS') { # privlib is perl_root:[lib] OK but not under mms |
1bc4b319 |
106 | if ($unix_mode) { |
107 | $compare = "../lib/File/Find.pm"; |
108 | } else { |
109 | $compare = "lib.File]Find.pm"; |
110 | } |
16be52b8 |
111 | $result =~ s/perl_root:\[\-?\.?//i; |
112 | $result =~ s/\[\-?\.?//i; # needed under `mms test` |
8b2bdce6 |
113 | is($result,$compare); |
16be52b8 |
114 | } |
115 | else { |
c23d1eb0 |
116 | $compare = $ENV{PERL_CORE} ? |
117 | File::Spec->catfile(File::Spec->updir, 'lib','File','Find.pm') |
1bc4b319 |
118 | : File::Spec->catfile($Config::Config{privlibexp},"File","Find.pm"); |
8b2bdce6 |
119 | my $resfile = _canon($result); |
120 | my $cmpfile = _canon($compare); |
121 | if($^O =~ /dos|win32/i && $resfile =~ /~\d(?=\\|$)/) { |
122 | # we have ~1 short filenames |
123 | $resfile = quotemeta($resfile); |
124 | $resfile =~ s/\\~\d(?=\\|$)/[^\\\\]+/g; |
125 | ok($cmpfile =~ /^$resfile$/, "pod_where found File::Find (with long filename matching)") || |
126 | diag("'$cmpfile' does not match /^$resfile\$/"); |
127 | } else { |
128 | is($resfile,$cmpfile,"pod_where found File::Find"); |
129 | } |
16be52b8 |
130 | } |
7b43481a |
131 | |
132 | # Search for a documentation pod rather than a module |
7b47f8ec |
133 | my $searchpod = 'Stuff'; |
8b2bdce6 |
134 | print "### 4. searching for $searchpod.pod\n"; |
7b47f8ec |
135 | $result = pod_where( |
136 | { -dirs => [ File::Spec->catdir( |
137 | $ENV{PERL_CORE} ? () : qw(t), 'pod', 'testpods', 'lib', 'Pod') ], |
138 | -verbose => $VERBOSE }, $searchpod) |
c23d1eb0 |
139 | || "undef - $searchpod.pod not found!"; |
16be52b8 |
140 | print "### found $result\n"; |
7b43481a |
141 | |
7b47f8ec |
142 | $compare = File::Spec->catfile( |
143 | $ENV{PERL_CORE} ? () : qw(t), |
144 | 'pod', 'testpods', 'lib', 'Pod' ,'Stuff.pm'); |
8b2bdce6 |
145 | is(_canon($result),_canon($compare)); |
146 | |
7b43481a |
147 | |
148 | # make the path as generic as possible |
149 | sub _canon |
150 | { |
151 | my ($path) = @_; |
152 | $path = File::Spec->canonpath($path); |
153 | my @comp = File::Spec->splitpath($path); |
154 | my @dir = File::Spec->splitdir($comp[1]); |
155 | $comp[1] = File::Spec->catdir(@dir); |
c23d1eb0 |
156 | $path = File::Spec->catpath(@comp); |
7b43481a |
157 | $path = uc($path) if File::Spec->case_tolerant; |
c23d1eb0 |
158 | print "### general path: $path\n" if $VERBOSE; |
7b43481a |
159 | $path; |
160 | } |
161 | |