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