This difference listing shows how I am checking the DECC feature
logicals to so that the Perl script will handle pathnames in the same
way that the CRTL has been told to.
It is against the 5.8.7 perl as I had to install the pathtool patch on
Perl 5.8.6 which is now part of 5.8.7.
Use of some of the DECC$ feature logicals that I have in these patches
may not work properly until all the patches that I have are installed.
However using those same feature logicals now on the Perl from CPAN with
out any of my patches is probably also not going to work in the same way.
So these patches should be able to be applied to a bleadperl in advance
of the entire set being applied.
I am not doing the value check of the logical names exactly the same as
the CRTL. While the CRTL is more liberal on what it will accept for an
"ENABLE" setting, HP recommends that the string "ENABLE" be used on
them. So this is how
The DECC$POSIX_COMPLIANT_PATHNAMES is active with a value from 1 to 4,
where 4 is a special mode that disallows UNIX names being passed to the
CRTL. I do not see 4 as a valid mode to run Perl in. And this value
range is still subject to change.
Currently mode 0 (or undefined) or mode 3 is the only one that will work
with the Symbolic Link SDK.
If you do not have the symbolic link SDK, then there is no reason for
this logical name to be defined.
But that is why I an checking for non-zero, and not 3.
The DECC$FILENAME_UNIX_ONLY means that the CRTL assumes that all
pathnames given to it will be UNIX. So it will treat "X:[FOO]BAR" as
the VMS file specification "[]X^:^[FOO^]BAR.". I do not see this as a
useful mode of running Perl, but am putting in the foundation of this
just in case someone else wants to complete the job.
The DECC$FILENAME_UNIX_ONLY also implies DECC$FILENAME_REPORT_UNIX.
In DECC$FILENAME_UNIX_REPORT mode, the CRTL will default to returning
UNIX specifications, but still will accept VMS ones. Of course
sometimes it is not possible to detect the difference, and on an ODS-5
volume, the UNIX "Perl.5.8.7" can exist as [.Perl^.5^.8^.7].
Many of the Perl scripts needed modifications based on what the DECC$
feature logicals implied.
One of the things I have discovered is that in the UNIX_REPORT modes,
Perl seems to be able to find the GNV components when they are installed
and tries to use them in the tests. Unfortunately if there is a
conflicting DCL verb, the results may be not what you expect.
In this case, the GNV pwd command is the quickest way I have to get the
current working directory in a UNIX format outside of Perl.
In debugging this case, I discovered that Perl on VMS is depending on
the CRTL accepting a previously invalid pathname to the chdir() routine.
Perl is passing that argument with leading spaces.
Leading spaces are valid in filenames on ODS-5 volumes, so in a UNIX
mode, chdir " foo" would be expected to do a change dir to [.^_^_foo].
In order to keep from having to find all the perl scripts that are
taking the output of SHOW DEFAULT or equivalent with out trimming the
spaces, I have modified the chdir() in VMS.C to trim the leading spaces
off. [I may have forgotten to put this in a readme file]
-John
[EMAIL PROTECTED]
Personal Opinion Only
--- ext/Cwd/t/cwd.t_5_8_6 Mon Mar 14 15:25:16 2005
+++ ext/Cwd/t/cwd.t Wed Jun 15 15:19:11 2005
@@ -1,31 +1,64 @@
-#!./perl
+#!./perl -w
BEGIN {
- chdir 't' if -d 't';
if ($ENV{PERL_CORE}) {
+ chdir 't';
@INC = '../lib';
}
}
use Cwd;
+chdir 't';
-use Config;
use strict;
-use warnings;
+use Config;
use File::Spec;
use File::Path;
+use lib File::Spec->catdir('t', 'lib');
use Test::More;
+require VMS::Filespec if $^O eq 'VMS';
-my $tests = 24;
-my $EXTRA_ABSPATH_TESTS = $ENV{PERL_CORE} || $ENV{TEST_PERL_CWD_CODE};
+my $tests = 28;
# _perl_abs_path() currently only works when the directory separator
# is '/', so don't test it when it won't work.
-$EXTRA_ABSPATH_TESTS &&= $Config{prefix} =~ m/\//;
-$tests += 3 if $EXTRA_ABSPATH_TESTS;
+my $EXTRA_ABSPATH_TESTS = ($Config{prefix} =~ m/\//) && $^O ne 'cygwin';
+$tests += 4 if $EXTRA_ABSPATH_TESTS;
plan tests => $tests;
+SKIP: {
+ skip "no need to check for blib/ in the core", 1 if $ENV{PERL_CORE};
+ like $INC{'Cwd.pm'}, qr{blib}i, "Cwd should be loaded from blib/ during
testing";
+}
+
my $IsVMS = $^O eq 'VMS';
my $IsMacOS = $^O eq 'MacOS';
+my $posix_compliant;
+my $unix_report;
+my $unix_only;
+
+if ($IsVMS) {
+ $posix_compliant = $ENV{'DECC$POSIX_COMPLIANT_PATHNAMES'};
+ if (defined $posix_compliant) {
+ if (($posix_compliant lt '1') && ($posix_compliant ne 'ENABLE')) {
+ $posix_compliant = undef;
+ }
+ }
+ $unix_report = $ENV{'DECC$FILENAME_UNIX_REPORT'};
+ if (defined $unix_report) {
+ if (($unix_report lt '1') && ($unix_report ne 'ENABLE')) {
+ $unix_report = undef;
+ }
+ }
+ $unix_only = $ENV{'DECC$FILENAME_UNIX_ONLY'};
+ if (defined $unix_only) {
+ if (($unix_only lt '1') && ($unix_only ne 'ENABLE')) {
+ $unix_only = undef;
+ }
+ }
+ $unix_report = 1 if (defined $unix_only);
+
+}
+
# check imports
can_ok('main', qw(cwd getcwd fastcwd fastgetcwd));
@@ -49,7 +82,13 @@
(grep { -x && -f } map { "$_/$pwd$Config{exe_ext}" }
split m/$Config{path_sep}/, $ENV{PATH})[0];
-$pwd_cmd = 'SHOW DEFAULT' if $IsVMS;
+if ($IsVMS) {
+ if (defined $unix_report) {
+ $pwd_cmd = "bash -c pwd";
+ } else {
+ $pwd_cmd = 'SHOW DEFAULT';
+ }
+}
if ($^O eq 'MSWin32') {
$pwd_cmd =~ s,/,\\,g;
$pwd_cmd = "$pwd_cmd /c cd";
@@ -69,6 +108,10 @@
$start =~ s,\\,/,g if ($^O eq 'MSWin32' || $^O eq "NetWare");
# DCL SHOW DEFAULT has leading spaces
$start =~ s/^\s+// if $IsVMS;
+
+ #Compensate for bug in older GNV bash on OpenVMS.
+ $start =~ s|\/000000\/|\/| if defined($unix_report);
+
SKIP: {
skip("'$pwd_cmd' failed, nothing to test against", 4) if $?;
skip("/afs seen, paths unlikely to match", 4) if $start =~ m|/afs/|;
@@ -129,15 +172,29 @@
rmtree($test_dirs[0], 0, 0);
{
- my $check = ($IsVMS ? qr|\b((?i)t)\]$| :
+ my $check = (($IsVMS and (!defined $unix_report)) ? qr|\b((?i)t)\]$| :
$IsMacOS ? qr|\bt:$| :
qr|\bt$| );
like($ENV{PWD}, $check);
}
+{
+ # Make sure abs_path() doesn't trample $ENV{PWD}
+ my $start_pwd = $ENV{PWD};
+ mkpath([$Test_Dir], 0, 0777);
+ Cwd::abs_path($Test_Dir);
+ is $ENV{PWD}, $start_pwd;
+ rmtree($test_dirs[0], 0, 0);
+}
+
SKIP: {
skip "no symlinks on this platform", 2+$EXTRA_ABSPATH_TESTS unless
$Config{d_symlink};
+ if ($IsVMS) {
+ if (!defined $posix_compliant) {
+ skip "OpenVMS symlinks can not be tested in this mode.",
2+$EXTRA_ABSPATH_TESTS;
+ }
+ }
mkpath([$Test_Dir], 0, 0777);
symlink $Test_Dir, "linktest";
@@ -173,6 +230,27 @@
if $EXTRA_ABSPATH_TESTS;
+
+SKIP: {
+ my $file;
+ {
+ my $root = File::Spec->rootdir;
+ local *FH;
+ opendir FH, $root or skip("Can't opendir($root): $!",
2+$EXTRA_ABSPATH_TESTS);
+ ($file) = grep {-f $_ and not -l $_} map File::Spec->catfile($root, $_),
readdir FH;
+ closedir FH;
+ }
+ skip "No plain file in root directory to test with", 2+$EXTRA_ABSPATH_TESTS
unless $file;
+
+ $file = VMS::Filespec::rmsexpand($file)
+ if ($^O eq 'VMS' and (!defined $unix_report));
+ is Cwd::abs_path($file), $file, 'abs_path() works on files in the root
directory';
+ is Cwd::fast_abs_path($file), $file, 'fast_abs_path() works on files in the
root directory';
+ is Cwd::_perl_abs_path($file), $file, '_perl_abs_path() works on files in
the root directory'
+ if $EXTRA_ABSPATH_TESTS;
+}
+
+
#############################################
# These routines give us sort of a poor-man's cross-platform
# directory or path comparison capability.
