| Subject: | [PATCH] VMS update for find.t, etc. |
There were some things not working quite right in both find.t and the code that it's testing,
partly caused by the over-complicated handling of so-called "unix mode" on VMS. The
attached patch gets all tests passing both in and out of that mode and makes the code simpler
and more maintainable in the process.
| Subject: | podparser.patch |
--- cpan/Pod-Parser/lib/Pod/Find.pm;-0 2009-11-19 10:51:37 -0600
+++ cpan/Pod-Parser/lib/Pod/Find.pm 2010-02-28 17:50:23 -0600
@@ -198,8 +198,13 @@ sub pod_find
# simplify path
# on VMS canonpath will vmsify:[the.path], but File::Find::find
# wants /unixy/paths
- $try = File::Spec->canonpath($try) if ($^O ne 'VMS');
- $try = VMS::Filespec::unixify($try) if ($^O eq 'VMS');
+ if ($^O eq 'VMS') {
+ $try = VMS::Filespec::unixify($try);
+ }
+ else {
+ $try = File::Spec->canonpath($try);
+ }
+
my $name;
if(-f $try) {
if($name = _check_and_extract_name($try, $opts{-verbose})) {
@@ -208,6 +213,7 @@ sub pod_find
next;
}
my $root_rx = $^O eq 'MacOS' ? qq!^\Q$try\E! : qq!^\Q$try\E/!;
+ $root_rx=~ s|//$|/|; # remove trailing double slash
File::Find::find( sub {
my $item = $File::Find::name;
if(-d) {
@@ -268,8 +274,8 @@ sub _check_and_extract_name {
# TODO what happens on e.g. Win32?
my $name = $file;
if(defined $root_rx) {
- $name =~ s/$root_rx//s;
- $name =~ s/$SIMPLIFY_RX//s if(defined $SIMPLIFY_RX);
+ $name =~ s/$root_rx//is;
+ $name =~ s/$SIMPLIFY_RX//is if(defined $SIMPLIFY_RX);
}
else {
if ($^O eq 'MacOS') {
@@ -443,6 +449,7 @@ sub pod_where {
# Now concatenate this directory with the pod we are searching for
my $fullname = File::Spec->catfile($dir, @parts);
+ $fullname = VMS::Filespec::unixify($fullname) if $^O eq 'VMS';
warn "Filename is now $fullname\n"
if $options{'-verbose'};
--- cpan/Pod-Parser/t/pod/find.t;-0 2009-11-19 10:51:37 -0600
+++ cpan/Pod-Parser/t/pod/find.t 2010-02-28 17:59:52 -0600
@@ -3,6 +3,7 @@
$| = 1;
+use strict;
use Test::More tests => 4;
BEGIN {
@@ -17,35 +18,15 @@ my $THISDIR = Cwd::cwd();
my $VERBOSE = $ENV{PERL_CORE} ? 0 : ($ENV{TEST_VERBOSE} || 0);
my $lib_dir = File::Spec->catdir($THISDIR,'lib');
-my $vms_unix_rpt = 0;
-my $vms_efs = 0;
-my $unix_mode = 1;
-
if ($^O eq 'VMS') {
- $lib_dir = VMS::Filespec::unixify(File::Spec->catdir($THISDIR,'-','lib','pod'));
- $Qlib_dir = $lib_dir;
- $Qlib_dir =~ s#\/#::#g;
-
- $unix_mode = 0;
- if (eval 'require VMS::Feature') {
- $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
- $vms_efs = VMS::Feature::current("efs_charset");
- } else {
- my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
- my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
- $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
- $vms_efs = $efs_charset =~ /^[ET1]/i;
- }
-
- # Traditional VMS mode only if VMS is not in UNIX compatible mode.
- $unix_mode = ($vms_efs && $vms_unix_rpt);
+ $lib_dir = VMS::Filespec::unixify($lib_dir);
}
print "### 2. searching $lib_dir\n";
my %pods = pod_find($lib_dir);
my $result = join(',', sort values %pods);
print "### found $result\n";
-my $compare = join(',', sort qw(
+my @compare = qw(
Pod::Checker
Pod::Find
Pod::InputObjects
@@ -54,28 +35,14 @@ my $compare = join(',', sort qw(
Pod::PlainText
Pod::Select
Pod::Usage
-));
-if ($^O eq 'VMS') {
- $compare = lc($compare);
- my $undollared = $Qlib_dir;
- $undollared =~ s/\$/\\\$/g;
- $undollared =~ s/\-/\\\-/g;
- $result =~ s/$undollared/pod::/g;
- $result =~ s/\$//g;
- my $count = 0;
- my @result = split(/,/,$result);
- my @compare = split(/,/,$compare);
- foreach(@compare) {
- $count += grep {/$_/} @result;
- }
- is($count/($#result+1)-1,$#compare);
-}
-elsif (File::Spec->case_tolerant || $^O eq 'dos') {
- is(lc $result,lc $compare);
-}
-else {
- is($result,$compare);
+);
+if (File::Spec->case_tolerant || $^O eq 'dos') {
+ # must downcase before sorting
+ map {$_ = lc $_} @compare;
+ $result = lc $result;
}
+my $compare = join(',', sort @compare);
+is($result, $compare);
print "### 3. searching for File::Find\n";
$result = pod_where({ -inc => 1, -verbose => $VERBOSE }, 'File::Find')
@@ -83,31 +50,19 @@ $result = pod_where({ -inc => 1, -verbos
print "### found $result\n";
require Config;
-if ($^O eq 'VMS') { # privlib is perl_root:[lib] OK but not under mms
- if ($unix_mode) {
- $compare = "../lib/File/Find.pm";
- } else {
- $compare = "lib.File]Find.pm";
- }
- $result =~ s/perl_root:\[\-?\.?//i;
- $result =~ s/\[\-?\.?//i; # needed under `mms test`
- is($result,$compare);
-}
-else {
- $compare = $ENV{PERL_CORE} ?
+$compare = $ENV{PERL_CORE} ?
File::Spec->catfile(File::Spec->updir, File::Spec->updir, 'lib','File','Find.pm')
: File::Spec->catfile($Config::Config{privlibexp},"File","Find.pm");
- my $resfile = _canon($result);
- my $cmpfile = _canon($compare);
- if($^O =~ /dos|win32/i && $resfile =~ /~\d(?=\\|$)/) {
+my $resfile = _canon($result);
+my $cmpfile = _canon($compare);
+if($^O =~ /dos|win32/i && $resfile =~ /~\d(?=\\|$)/) {
# we have ~1 short filenames
$resfile = quotemeta($resfile);
$resfile =~ s/\\~\d(?=\\|$)/[^\\\\]+/g;
ok($cmpfile =~ /^$resfile$/, "pod_where found File::Find (with long filename matching)") ||
diag("'$cmpfile' does not match /^$resfile\$/");
- } else {
+} else {
is($resfile,$cmpfile,"pod_where found File::Find");
- }
}
# Search for a documentation pod rather than a module