John E. Malmberg wrote:
Craig A. Berry wrote:
At 12:27 AM -0500 9/14/07, John E. Malmberg wrote:
Hello Ken,
Here is another step in getting Module::Build going on VMS.
This is generally a step in the right direction in principle, but
causes the following failure on OS X:
lib/Module/Build/t/install....................................#
Failed test at ../lib/Module/Build/t/install.t line 68.
# got: 'Can't open file
/Users/craig/perl/t/install_test/usr/local/lib/perl5/site_perl/5.10.0/darwin-2level/auto/Simple/.packlist/:
No such file or directory at
/Users/craig/perl/t/../lib/ExtUtils/Install.pm line 691
# '
# expected: ''
FAILED at test 2
That should be addressed by the attached patch.
Traditional VMS returns filenames and pathnames in lower case, so
the key $expect to $pods->{$expect} needs to be converted to lowercase.
TODO:
However this will need to be fixed for VMS ODS-5 support as that
will return the filename in the exact case it was created in. Currently
>> there is no API to let a module know that VMS is in this mode.
IMO all tests of the type "Is this filename the one I'm expecting?"
should be case blind on all platforms. The default filename lookup
behavior is case blind on the default filesystem on every non-UNIX
platform Perl supports, as well as on OS X with HFS+, so unless you
are doing something intentionally non-portable, I see no reason for
these tests to be case sensitive. There are of course lots of ways
to do it, but using C<like> instead of C<is> makes sense to me:
% perl -e 'use Test::More qw(no_plan); like (q{Foo.Dat},
qr{^(?i:foo.dat)$}, q{File matches});'
ok 1 - File matches
1..1
Unfortunately in the case of install.t, the pathname is used as a key to
a hash, and that key is in the case that the OS returned the filename
in, and in traditional VMS, that is lower case.
I updated the comment in the install.t patch to make this more clear.
Additional changes:
In VMS.pm,
Fix man3page_name so that the "__" prefix is actually removed.
In manifypods.t,
When comparing paths, the directory delimiters can get in the way.
In metadata.t,
Again, file case comparison issues. I do not know how to make is_deeply
do a case insensitive compare. So another one to be revised when ODS-5
support is fully implemented.
This leaves me with the following tests not working:
ppm.t, tilde.t, xs.t
-John
[EMAIL PROTECTED]
Personal Opinion Only
--- /rsync_root/perl/lib/Module/Build/Base.pm Sat Sep 8 15:48:35 2007
+++ lib/Module/Build/Base.pm Sun Sep 16 01:11:43 2007
@@ -3804,8 +3804,22 @@
foreach (keys %map) {
# Need to remove volume from $map{$_} using splitpath, or else
# we'll create something crazy like C:\Foo\Bar\E:\Baz\Quux
- my ($volume, $path) = File::Spec->splitpath( $map{$_}, 1 );
- $map{$_} = File::Spec->catdir($destdir, $path);
+ # VMS will always have the file separate than the path.
+ my ($volume, $path, $file) = File::Spec->splitpath( $map{$_}, 1 );
+
+ # catdir needs a list of directories, or it will create something
+ # crazy like volume:[Foo.Bar.volume.Baz.Quux]
+ my @dirs = File::Spec->splitdir($path);
+
+ # First merge the directories
+ $path = File::Spec->catdir($destdir, @dirs);
+
+ # Then put the file back on if there is one.
+ if ($file ne '') {
+ $map{$_} = File::Spec->catfile($path, $file)
+ } else {
+ $map{$_} = $path;
+ }
}
}
--- /rsync_root/perl/lib/Module/Build/Platform/VMS.pm Sat Sep 8 15:48:36 2007
+++ lib/Module/Build/Platform/VMS.pm Sun Sep 16 14:16:41 2007
@@ -246,7 +246,8 @@
my $self = shift;
my $mpname = $self->SUPER::man3page_name( shift );
- $mpname =~ s/^$self->manpage_separator//;
+ my $sep = $self->manpage_separator;
+ $mpname =~ s/^$sep//;
return $mpname;
}
--- /rsync_root/perl/lib/Module/Build/t/install.t Tue Jun 13 14:29:16 2006
+++ lib/Module/Build/t/install.t Sun Sep 16 01:27:14 2007
@@ -67,26 +67,27 @@
eval {$mb->dispatch('install', destdir => $destdir)};
is $@, '';
- my $libdir = strip_volume( $mb->install_destination('lib') );
- my $install_to = File::Spec->catfile($destdir, $libdir, $dist->name ) .
'.pm';
+ my @libdir = strip_volume( $mb->install_destination('lib') );
+ my $install_to = File::Spec->catfile($destdir, @libdir, $dist->name ) .
'.pm';
file_exists($install_to);
- local @INC = (@INC, File::Spec->catdir($destdir, $libdir));
+ local @INC = (@INC, File::Spec->catdir($destdir, @libdir));
eval "require @{[$dist->name]}";
is $@, '';
# Make sure there's a packlist installed
my $archdir = $mb->install_destination('arch');
- my ($v, $d) = File::Spec->splitpath($archdir, 1);
- my $packlist = File::Spec->catdir($destdir, $d, 'auto', $dist->name,
'.packlist');
+ my @dirs = strip_volume($archdir);
+ my $packlist = File::Spec->catfile
+ ($destdir, @dirs, 'auto', $dist->name,
'.packlist');
is -e $packlist, 1, "$packlist should be written";
}
{
eval {$mb->dispatch('install', installdirs => 'core', destdir => $destdir)};
is $@, '';
- my $libdir = strip_volume( $Config{installprivlib} );
- my $install_to = File::Spec->catfile($destdir, $libdir, $dist->name ) .
'.pm';
+ my @libdir = strip_volume( $Config{installprivlib} );
+ my $install_to = File::Spec->catfile($destdir, @libdir, $dist->name ) .
'.pm';
file_exists($install_to);
}
@@ -94,7 +95,8 @@
my $libdir = File::Spec->catdir(File::Spec->rootdir, 'foo', 'bar');
eval {$mb->dispatch('install', install_path => {lib => $libdir}, destdir =>
$destdir)};
is $@, '';
- my $install_to = File::Spec->catfile($destdir, $libdir, $dist->name ) .
'.pm';
+ my @dirs = strip_volume($libdir);
+ my $install_to = File::Spec->catfile($destdir, @dirs, $dist->name ) . '.pm';
file_exists($install_to);
}
@@ -102,7 +104,8 @@
my $libdir = File::Spec->catdir(File::Spec->rootdir, 'foo', 'base');
eval {$mb->dispatch('install', install_base => $libdir, destdir =>
$destdir)};
is $@, '';
- my $install_to = File::Spec->catfile($destdir, $libdir, 'lib', 'perl5',
$dist->name ) . '.pm';
+ my @dirs = strip_volume($libdir);
+ my $install_to = File::Spec->catfile($destdir, @dirs, 'lib', 'perl5',
$dist->name ) . '.pm';
file_exists($install_to);
}
@@ -115,8 +118,8 @@
eval {$mb->dispatch('install', destdir => $destdir)};
is $@, '';
- my $libdir = strip_volume( $mb->install_destination('lib') );
- local @INC = (@INC, File::Spec->catdir($destdir, $libdir));
+ my @libdir = strip_volume( $mb->install_destination('lib') );
+ local @INC = (@INC, File::Spec->catdir($destdir, @libdir));
eval "require @{[$dist->name]}::ConfigData";
is $mb->feature('auto_foo'), 1;
@@ -156,13 +159,15 @@
eval {$mb->run_perl_script('Build.PL', [], ['--install_path',
"lib=$libdir"])};
is $@, '';
- eval {$mb->run_perl_script('Build', [], ['install', '--destdir', $destdir])};
+ my $cmd = 'Build';
+ $cmd .= ".COM" if $^O eq 'VMS';
+ eval {$mb->run_perl_script($cmd, [], ['install', '--destdir', $destdir])};
is $@, '';
my $install_to = File::Spec->catfile($destdir, $libdir, $dist->name ) .
'.pm';
file_exists($install_to);
my $basedir = File::Spec->catdir('', 'bar');
- eval {$mb->run_perl_script('Build', [], ['install', '--destdir', $destdir,
+ eval {$mb->run_perl_script($cmd, [], ['install', '--destdir', $destdir,
'--install_base', $basedir])};
is $@, '';
@@ -204,6 +209,15 @@
my $pods = $mb->_find_file_by_type('pod', 'lib');
is keys %$pods, 1;
my $expect = $mb->localize_file_path('lib/Simple/Docs.pod');
+
+ # TODO:
+ # True for traditional VMS, but will need to be changed when ODS-5 support
+ # for case preserved filenames is active.
+ # The issue is that the keys to the $pods hash are currently being set to
+ # lowercase on VMS so can not be found in exact case.
+
+ $expect = lc($expect) if $^O eq 'VMS';
+
is $pods->{$expect}, $expect;
my $pms = $mb->_find_file_by_type('awefawef', 'lib');
@@ -225,7 +239,8 @@
sub strip_volume {
my $dir = shift;
(undef, $dir) = File::Spec->splitpath( $dir, 1 );
- return $dir;
+ my @dirs = File::Spec->splitdir($dir);
+ return @dirs;
}
sub file_exists {
--- /rsync_root/perl/lib/Module/Build/t/manifypods.t Mon Jul 16 22:38:20 2007
+++ lib/Module/Build/t/manifypods.t Sun Sep 16 12:52:07 2007
@@ -102,6 +102,11 @@
%distro = map {$mb->localize_file_path($_), $distro{$_}} keys %distro;
+my $lib_path = $mb->localize_dir_path('lib');
+
+# Remove trailing directory delimiter on VMS for compares
+$lib_path =~ s/\]// if $^O eq 'VMS';
+
$mb->dispatch('build');
eval {$mb->dispatch('docs')};
@@ -123,7 +128,8 @@
while (my ($from, $v) = each %distro) {
next unless $v;
- my $to = File::Spec->catfile($destdir, 'man', $man{($from =~ /^lib/ ? 'dir3'
: 'dir1')}, $v);
+ my $to = File::Spec->catfile
+ ($destdir, 'man', $man{($from =~ /^\Q$lib_path\E/ ? 'dir3' : 'dir1')},
$v);
ok -e $to, "Created $to manpage";
}
--- /rsync_root/perl/lib/Module/Build/t/metadata.t Sat Apr 21 04:33:07 2007
+++ lib/Module/Build/t/metadata.t Sun Sep 16 13:43:58 2007
@@ -30,6 +30,20 @@
---
$dist->regen;
+my $simple_file = 'lib/Simple.pm';
+my $simple2_file = 'lib/Simple2.pm';
+
+ #TODO:
+ # Traditional VMS will return the file in in lower case, and is_deeply
+ # does exact case comparisons.
+ # When ODS-5 support is active for preserved case file names, this will
+ # need to be changed.
+ if ($^O eq 'VMS') {
+ $simple_file = lc($simple_file);
+ $simple2_file = lc($simple2_file);
+ }
+
+
chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
use Module::Build;
@@ -87,7 +101,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => {file => 'lib/Simple.pm',
+ {'Simple' => {file => $simple_file,
version => '1.23'}});
$dist->change_file( 'lib/Simple.pm', <<'---' );
@@ -96,7 +110,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => {file => 'lib/Simple.pm'}});
+ {'Simple' => {file => $simple_file}});
# File with no corresponding package (w/ or w/o version)
# Simple.pm => Foo::Bar v1.23
@@ -108,7 +122,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Foo::Bar' => { file => 'lib/Simple.pm',
+ {'Foo::Bar' => { file => $simple_file,
version => '1.23' }});
$dist->change_file( 'lib/Simple.pm', <<'---' );
@@ -117,7 +131,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Foo::Bar' => { file => 'lib/Simple.pm'}});
+ {'Foo::Bar' => { file => $simple_file}});
# Single file with multiple differing packages (w/ or w/o version)
@@ -133,9 +147,9 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' },
- 'Foo::Bar' => { file => 'lib/Simple.pm',
+ 'Foo::Bar' => { file => $simple_file,
version => '1.23' }});
{
@@ -167,9 +181,9 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Foo' => { file => 'lib/Simple.pm',
+ {'Foo' => { file => $simple_file,
version => '1.23' },
- 'Foo::Bar' => { file => 'lib/Simple.pm',
+ 'Foo::Bar' => { file => $simple_file,
version => '1.23' }});
@@ -185,7 +199,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => { file => 'lib/Simple.pm' }});
+ {'Simple' => { file => $simple_file }});
# Single file with same package appearing multiple times, single
@@ -201,7 +215,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }});
@@ -218,7 +232,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }});
@@ -237,7 +251,7 @@
$err = stderr_of( sub { $mb = new_build() } );
$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
is_deeply($provides,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }}); # XXX should be 2.34?
like( $err, qr/already declared/, ' with conflicting versions reported' );
@@ -256,7 +270,7 @@
$err = stderr_of( sub { $mb = new_build() } );
$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
is_deeply($provides,
- {'Foo' => { file => 'lib/Simple.pm',
+ {'Foo' => { file => $simple_file,
version => '1.23' }}); # XXX should be 2.34?
like( $err, qr/already declared/, ' with conflicting versions reported' );
@@ -277,7 +291,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => { file => 'lib/Simple.pm' }});
+ {'Simple' => { file => $simple_file }});
$dist->remove_file( 'lib/Simple2.pm' );
@@ -295,7 +309,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }});
$dist->remove_file( 'lib/Simple2.pm' );
@@ -315,7 +329,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => { file => 'lib/Simple2.pm',
+ {'Simple' => { file => $simple2_file,
version => '1.23' }});
$dist->remove_file( 'lib/Simple2.pm' );
@@ -336,7 +350,7 @@
$mb = new_build();
$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
is_deeply($provides,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }});
like( $err, qr/Found conflicting versions for package/,
' with conflicting versions reported' );
@@ -359,7 +373,7 @@
$mb = new_build();
$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
is_deeply($provides,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }});
$dist->remove_file( 'lib/Simple2.pm' );
@@ -400,7 +414,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Foo' => { file => 'lib/Simple.pm',
+ {'Foo' => { file => $simple_file,
version => '1.23' }});
$dist->remove_file( 'lib/Simple2.pm' );
@@ -419,7 +433,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Foo' => { file => 'lib/Simple2.pm',
+ {'Foo' => { file => $simple2_file,
version => '1.23' }});
$dist->remove_file( 'lib/Simple2.pm' );
@@ -489,7 +503,7 @@
} );
$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
is_deeply($provides,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }});
like( $err, qr/Found conflicting versions for package/,
' corresponding package conflicts with multiple alternatives' );
@@ -515,7 +529,7 @@
} );
$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
is_deeply($provides,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }});
like( $err, qr/Found conflicting versions for package/,
' only one alternative conflicts with corresponding package' );
@@ -539,7 +553,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }});
