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