# 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))
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);
}
}
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') }
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 {
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
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");
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' );
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' ) {
$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 ) {
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;
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);
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}";
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;
+ }
}
}
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;
}
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);
}
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);
}
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);
}
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;
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 $@, '';
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');
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 {
%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')};
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";
}
---
$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;
$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', <<'---' );
$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
$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', <<'---' );
$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)
$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' }});
{
$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' }});
$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
$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->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }});
$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' );
$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' );
$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' );
$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' );
$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' );
$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' );
$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' );
$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' );
$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' );
} );
$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' );
} );
$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' );
$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' }});
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;
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";
+ }
}
{
projects / p5sagit/p5-mst-13.2.git / commitdiff