John E. Malmberg wrote:
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.
Additional changes:
In Base.pm, created a subroutine to return the regex either as case
insensitive or case sensitive based on the setting for
File::Spec::case_tolerant.
Note in the existing code, one place assumes that the
File::Spec::case_tolerant routine exists, and another tests to see if it
exists.
Converted were needed the qr{xxxx} to file_qr('xxxx')
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.
I missed runthrough.t in my last assessment.
This patch also fixes runthrough.t to pass all tests on VMS.
Modifying the expected dist_dir to meet what VMS expects it to be in,
handling both ODS-2 and ODS-5 cases.
Skipping the rewritten shebang test, since the shebang is not rewritten
on VMS.
-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 Fri Sep 28 00:05:37 2007
@@ -2184,7 +2184,8 @@
# See whether any of the *.pm files have changed since last time
# testcover was run. If so, start over.
if (-e 'cover_db') {
- my $pm_files = $self->rscan_dir(File::Spec->catdir($self->blib, 'lib'),
qr{\.pm$} );
+ my $pm_files = $self->rscan_dir
+ (File::Spec->catdir($self->blib, 'lib'), file_qr('\.pm$') );
my $cover_files = $self->rscan_dir('cover_db', sub {-f $_ and not
/\.html$/});
$self->do_system(qw(cover -delete))
@@ -2246,7 +2247,7 @@
push @{$p->{include_dirs}}, $p->{c_source};
- my $files = $self->rscan_dir($p->{c_source}, qr{\.c(pp)?$});
+ my $files = $self->rscan_dir($p->{c_source}, qr('\.c(pp)?$'));
foreach my $file (@$files) {
push @{$p->{objects}}, $self->compile_c($file);
}
@@ -2318,7 +2319,8 @@
}
return unless -d 'lib';
- return { map {$_, [/^(.*)\.PL$/]} @{ $self->rscan_dir('lib', qr{\.PL$}) } };
+ return { map {$_, [/^(.*)\.PL$/i ]} @{ $self->rscan_dir('lib',
+ file_qr('\.PL$')) }
};
}
sub find_pm_files { shift->_find_file_by_type('pm', 'lib') }
@@ -2371,7 +2373,7 @@
return { map {$_, $_}
map $self->localize_file_path($_),
grep !/\.\#/,
- @{ $self->rscan_dir($dir, qr{\.$type$}) } };
+ @{ $self->rscan_dir($dir, file_qr("\\.$type\$")) } };
}
sub localize_file_path {
@@ -2443,7 +2445,9 @@
or die "The 'testpod' action requires Test::Pod version 0.95";
my @files = sort keys %{$self->_find_pods($self->libdoc_dirs)},
- keys %{$self->_find_pods($self->bindoc_dirs, exclude => [
qr/\.bat$/ ])}
+ keys %{$self->_find_pods
+ ($self->bindoc_dirs,
+ exclude => [ file_qr('\.bat$') ])}
or die "Couldn't find any POD files to test\n";
{ package Module::Build::PodTester; # Don't want to pollute the main
namespace
@@ -2505,7 +2509,7 @@
foreach my $type ( qw(bin lib) ) {
my $files = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
- exclude => [ qr/\.bat$/ ] );
+ exclude => [ file_qr('\.bat$') ] );
next unless %$files;
my $sub = $self->can("manify_${type}_pods");
@@ -2524,7 +2528,7 @@
my $self = shift;
my $files = $self->_find_pods( $self->{properties}{bindoc_dirs},
- exclude => [ qr/\.bat$/ ] );
+ exclude => [ file_qr('\.bat$') ] );
return unless keys %$files;
my $mandir = File::Spec->catdir( $self->blib, 'bindoc' );
@@ -2607,7 +2611,8 @@
foreach my $type ( qw(bin lib) ) {
my $files = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
- exclude => [ qr/\.(?:bat|com|html)$/ ] );
+ exclude =>
+ [ file_qr('\.(?:bat|com|html)$') ] );
next unless %$files;
if ( $self->invoked_action eq 'html' ) {
@@ -2634,7 +2639,7 @@
$self->add_to_cleanup('pod2htm*');
my $pods = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
- exclude => [ qr/\.(?:bat|com|html)$/ ] );
+ exclude => [ file_qr('\.(?:bat|com|html)$') ]
);
return unless %$pods; # nothing to do
unless ( -d $htmldir ) {
@@ -2654,7 +2659,7 @@
foreach my $pod ( keys %$pods ) {
my ($name, $path) = File::Basename::fileparse($pods->{$pod},
- qr{\.(?:pm|plx?|pod)$});
+
file_qr('\.(?:pm|plx?|pod)$'));
my @dirs = File::Spec->splitdir( File::Spec->canonpath( $path ) );
pop( @dirs ) if $dirs[-1] eq File::Spec->curdir;
@@ -2744,7 +2749,7 @@
delete $installmap->{read};
delete $installmap->{write};
- my $text_suffix = qr{\.(pm|pod)$};
+ my $text_suffix = file_qr('\.(pm|pod)$');
while (my $localdir = each %$installmap) {
my @localparts = File::Spec->splitdir($localdir);
@@ -3203,6 +3208,11 @@
ExtUtils::Manifest::mkmanifest();
}
+# Case insenstive regex for files
+sub file_qr {
+ return File::Spec->case_tolerant ? qr($_[0])i : qr($_[0]);
+}
+
sub dist_dir {
my ($self) = @_;
return "$self->{properties}{dist_name}-$self->{properties}{dist_version}";
@@ -3804,8 +3814,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' }});
--- /rsync_root/perl/lib/Module/Build/t/runthrough.t Sat Jul 15 09:46:58 2006
+++ lib/Module/Build/t/runthrough.t Fri Sep 28 08:31:56 2007
@@ -83,7 +83,16 @@
is $@, '';
ok -e $mb->build_script;
-is $mb->dist_dir, 'Simple-0.01';
+my $dist_dir = 'Simple-0.01';
+
+# VMS may or may not need to modify the name, vmsify will do this if
+# the name looks like a UNIX directory.
+if ($^O eq 'VMS') {
+ my @dist_dirs = File::Spec->splitdir(VMS::Filespec::vmsify($dist_dir.'/'));
+ $dist_dir = $dist_dirs[0];
+}
+
+is $mb->dist_dir, $dist_dir;
# The 'cleanup' file doesn't exist yet
ok grep {$_ eq 'before_script'} $mb->cleanup;
@@ -159,12 +168,15 @@
ok $scripts->{script};
# Check that a shebang line is rewritten
- my $blib_script = File::Spec->catdir( qw( blib script script ) );
+ my $blib_script = File::Spec->catfile( qw( blib script script ) );
ok -e $blib_script;
+ SKIP: {
+ skip("We do not rewrite shebang on VMS", 1) if $^O eq 'VMS';
my $fh = IO::File->new($blib_script);
my $first_line = <$fh>;
isnt $first_line, "#!perl -w\n", "should rewrite the shebang line";
+ }
}
{
