John E. Malmberg wrote:
Craig A. Berry wrote:
At 4:17 PM -0500 5/25/08, John E. Malmberg wrote:
Please review these patches for improving module build on VMS.
These were being discussed before the 5.10 release, but not included.
Thanks, I'll have a look. A few initial comments mixed in below.
Revised patch attached.
Also, I left the makefile name as generated by the tests. Sometimes
it was generated as 'Makefile' and sometimes as 'descrip.mms'.
I am thinking that if the makefile is being generated for
is_vms_mms(), then the name should be forced to 'descrip.mms' for
consistency, as I do not think gnu make can deal with MMS/MMK syntax.
With these patches, all but the ppm.t tests will pass on VMS.
The xs.t test passes, but the extra output is messing up the test
analysis, so for now, I have left it being skipped.
The ppm.t test still has the issue where it is creating a tarball
that it then can not detar, and I will try to look at that in a
little bit.
--- /rsync_root/perl/lib/Module/Build/base.pm Thu Oct 25 04:50:40
2007
+++ lib/Module/Build/base.pm Sun May 25 00:50:07 2008
@@ -2304,7 +2304,7 @@
foreach my $file (keys %$files) {
my $result = $self->copy_if_modified($file, $script_dir,
'flatten') or next;
- $self->fix_shebang_line($result) unless $self->is_vmsish;
+ $self->fix_shebang_line($result) unless $self->is_vms_mms;
So if we're using GNU make rather than MMS or MMK we have a shebang
line in Perl? Not sure how that's possible.
Ok, this needs a bit of thought. DCL ignores shebang lines, only perl
and the GNV utilities will honor shebangs, so why are we fixing the
shebang line. So why skip fixing the shebang line if is_vmsish in the
first place?
Looking at where this code is used in the tests indicates that it is
being used on perl scripts. I do not know why setting the shebang is
suppressed for VMS, but under GNV it will be needed. So resolving this
will be a todo item if and when we start running module build under GNV.
My thoughts at the time are that when we are running gnu make, it will
be under the GNV system, so Unix rules will apply.
@@ -3179,10 +3184,18 @@
\bblibdirs$
^MANIFEST\.SKIP$
+# Avoid VMS specific MakeMaker generated files
+\bDescript.MMS$
+\bDESCRIPT.MMS$
+\bdescript.mms$
It's "descrip" not "descript".
Yep. Easy fix. I will try to deal with that tomorrow. I remember last
time that you mentioned some other files that also should be ignored.
Typo fixed.
# Avoid Devel::Cover generated files
\bcover_db
--- /rsync_root/perl/lib/Module/Build/Compat.pm Thu Oct 25
04:50:40 2007
+++ lib/Module/Build/Compat.pm Sat May 24 22:11:04 2008
@@ -171,7 +171,15 @@
die "Malformed argument '$arg'");
# Do tilde-expansion if it looks like a tilde prefixed path
- ( $val ) = glob( $val ) if $val =~ /^~/;
+ if ($val =~ /^~/) {
+ my $class = 'Module::Build';
+ if ($class->is_vmsish) {
+ # VMS does not glob a ~ yet
+ ( $val ) = $class->_detildefy($val)
+ } else {
+ ( $val ) = glob( $val );
+ }
+ }
It may be ok to use _detildefy everywhere -- we'd have to test it on
something non-VMS. Most likely the following will get you the class,
which is currently just being thrown away:
--- Compat.pm;-0 Thu Oct 25 04:50:40 2007
+++ Compat.pm Sun May 25 18:23:27 2008
@@ -162,7 +162,7 @@ sub subclass_dir {
}
sub makefile_to_build_args {
- shift;
+ my $self = shift;
my @out;
foreach my $arg (@_) {
next if $arg eq '';
[end]
You could then use $self where you have $class (haven't tested that,
but that's how nearly all these methods work).
I think that for some reason that this will not work because in the
other places the class is passed as an additional argument, and not as
the first argument.
I did not change this. Maybe Ken will find time to look at this.
if (exists $makefile_to_build{$key}) {
my $trans = $makefile_to_build{$key};
@@ -216,10 +224,24 @@
my $class = $args{build_class};
my $perl = $class->find_perl_interpreter;
+
+ # VMS MMS/MMK usually needs to use MCR to run the Perl image
+ $perl = 'MCR ' . $perl if $class->is_vms_mms;
+
This doesn't seem necessary to me since it's going to be spawning a
subprocess to run Perl; the subprocess-handling code already prepends
MCR when needed.
It is needed because this is a line being inserted in the makefile or
descrip.mms file, not a command being spawned by perl.
}
--- /rsync_root/perl/lib/Module/Build/t/compat.t Thu Feb 21
08:04:41 2008
+++ lib/Module/Build/t/compat.t Sun May 25 14:32:41 2008
@@ -21,6 +21,7 @@
}
ok 1, "Loaded";
+my $vms_mms = ($^O eq 'VMS') && ($Config{make} =~ /MMS|K/i);
Um, anything with a K in it is considered MMK? I don't think that's
what you wanted. See
http://perldoc.perl.org/perlrequick.html#Grouping-things-and-hierarchical-matching
Ok, I will lookup the proper regex tomorrow to group the S and K as
alternatives.
Fixed.
-John
[EMAIL PROTECTED]
Personal Opinion Only
--- /rsync_root/perl/lib/Module/Build/Base.pm Thu Oct 25 04:50:40 2007
+++ lib/Module/Build/Base.pm Mon May 26 14:08:52 2008
@@ -2304,7 +2304,8 @@
foreach my $file (keys %$files) {
my $result = $self->copy_if_modified($file, $script_dir, 'flatten') or
next;
- $self->fix_shebang_line($result) unless $self->is_vmsish;
+print STDERR "$result in process_script_files\n";
+ $self->fix_shebang_line($result) unless $self->is_vms_mms;
$self->make_executable($result);
}
}
@@ -2392,7 +2393,7 @@
sub localize_file_path {
my ($self, $path) = @_;
- $path =~ s/\.\z// if $self->is_vmsish;
+ $path =~ s/\.\z// if $self->is_vms_mms;
return File::Spec->catfile( split m{/}, $path );
}
@@ -2674,10 +2675,15 @@
my ($name, $path) = File::Basename::fileparse($pods->{$pod},
file_qr('\.(?:pm|plx?|pod)$'));
+ if ($self->is_vmsish) {
+ #path can show up empty on VMS.
+ $path = File::Spec->curdir if ($path eq '');
+ }
my @dirs = File::Spec->splitdir( File::Spec->canonpath( $path ) );
+
pop( @dirs ) if $dirs[-1] eq File::Spec->curdir;
- my $fulldir = File::Spec->catfile($htmldir, @rootdirs, @dirs);
+ my $fulldir = File::Spec->catdir($htmldir, @rootdirs, @dirs);
my $outfile = File::Spec->catfile($fulldir, "${name}.html");
my $infile = File::Spec->abs2rel($pod);
@@ -2879,7 +2885,7 @@
File::Spec->abs2rel( File::Spec->rel2abs( $file ),
File::Spec->rel2abs( $dir ) );
my $to_file =
- File::Spec->catdir( $ppm, 'blib',
+ File::Spec->catfile( $ppm, 'blib',
exists( $types{$type} ) ? $types{$type} : $type,
$rel_file );
$self->copy_if_modified( from => $file, to => $to_file );
@@ -3179,10 +3185,18 @@
\bblibdirs$
^MANIFEST\.SKIP$
+# Avoid VMS specific MakeMaker generated files
+\bDescrip.MMS$
+\bDESCRIP.MMS$
+\bdescrip.mms$
+
# Avoid Module::Build generated and utility files.
\bBuild$
\bBuild.bat$
\b_build
+\bBuild.com$
+\bBUILD.COM$
+\bbuild.com$
# Avoid Devel::Cover generated files
\bcover_db
--- /rsync_root/perl/lib/Module/Build/Compat.pm Thu Oct 25 04:50:40 2007
+++ lib/Module/Build/Compat.pm Sat May 24 22:11:04 2008
@@ -171,7 +171,15 @@
die "Malformed argument '$arg'");
# Do tilde-expansion if it looks like a tilde prefixed path
- ( $val ) = glob( $val ) if $val =~ /^~/;
+ if ($val =~ /^~/) {
+ my $class = 'Module::Build';
+ if ($class->is_vmsish) {
+ # VMS does not glob a ~ yet
+ ( $val ) = $class->_detildefy($val)
+ } else {
+ ( $val ) = glob( $val );
+ }
+ }
if (exists $makefile_to_build{$key}) {
my $trans = $makefile_to_build{$key};
@@ -216,10 +224,24 @@
my $class = $args{build_class};
my $perl = $class->find_perl_interpreter;
+
+ # VMS MMS/MMK usually needs to use MCR to run the Perl image
+ $perl = 'MCR ' . $perl if $class->is_vms_mms;
+
my $noop = ($class->is_windowsish ? 'rem>nul' :
- $class->is_vmsish ? 'Continue' :
+ $class->is_vms_mms ? 'Continue' :
'true');
- my $Build = 'Build --makefile_env_macros 1';
+
+ # VMS MMS/MMK has different file type.
+ my $filetype = $class->is_vms_mms ? '.COM' : '';
+
+ my $Build = 'Build' . $filetype . ' --makefile_env_macros 1';
+
+ my $unlink_makefile = "unlink -e shift $args{makefile}";
+
+ # VMS MMK/MMS has multiple file versions
+ $unlink_makefile = "\"1 while unlink \'$args{makefile}\'\""
+ if $class->is_vms_mms;
# Start with a couple special actions
my $maketext = <<"EOF";
@@ -227,7 +249,7 @@
$perl $Build
realclean : force_do_it
$perl $Build realclean
- $perl -e unlink -e shift $args{makefile}
+ $perl -e $unlink_makefile
force_do_it :
@ $noop
@@ -241,7 +263,10 @@
EOF
}
- $maketext .= "\n.EXPORT : " . join(' ', keys %makefile_to_build) . "\n\n";
+ # VMS MMS/MMK doe not support .EXPORT
+
+ $maketext .= "\n.EXPORT : " . join(' ', keys %makefile_to_build) . "\n\n"
+ unless $class->is_vms_mms;
return $maketext;
}
--- /rsync_root/perl/lib/Module/Build/t/compat.t Thu Feb 21 08:04:41 2008
+++ lib/Module/Build/t/compat.t Mon May 26 12:59:00 2008
@@ -21,6 +21,7 @@
}
ok 1, "Loaded";
+my $vms_mms = ($^O eq 'VMS') && ($Config{make} =~ /MM[S|K]/i);
#########################
@@ -171,11 +172,23 @@
like $output, qr/(?:# ok \d+\s+)+/, 'Should be verbose';
# Make sure various Makefile arguments are supported
- $output = stdout_of( sub { $ran_ok = $mb->do_system(@make, 'test',
'TEST_VERBOSE=0') } );
+ my $arg = 'TEST_VERBOSE=0';
+ if ($vms_mms) {
+ $arg = '/macro=(' . $arg . ')';
+ }
+ $output = stdout_of( sub { $ran_ok = $mb->do_system(@make, 'test', $arg) });
+
ok $ran_ok, "make test without verbose ran ok";
$output =~ s/^/# /gm; # Don't confuse our own test output
+ my $regex2 = '(?:[\d.]+\s*m?s\s*)?(?:# \[[\d:]+\]\s*)?';
+ my $regex = qr/(?:# .+basic\.+ok\s+$regex2)# All tests /;
+
+ # VMS spreads the output over multiple liines.
+ if ($^O eq 'VMS') {
+ $regex = qr/(?:# .+basic\.+(?:\s.*)?ok\s+$regex2)# All tests /s;
+ }
like $output,
- qr/(?:# .+basic\.+ok\s+(?:[\d.]+\s*m?s\s*)?(?:# \[[\d:]+\]\s*)?)# All
tests/,
+ $regex,
'Should be non-verbose';
$mb->delete_filetree($libdir);
@@ -270,13 +283,24 @@
$label .= " (postargs: $postargs)";
}
ok $result, $label;
- ok -e 'Makefile', "Makefile exists";
-
+
+ my $makefile = 'Makefile';
+ if ($vms_mms) {
+ # VMS MMS/MMK can have either Makefile or descrip.mms as the created file.
+ my $make_test = -e $makefile;
+ unless ($make_test) {
+ $makefile = 'descrip.mms';
+ $make_test = -e $makefile;
+ }
+ ok $make_test, "$makefile exists - Looking for Makefile or descrip.mms";
+ } else {
+ ok -e 'Makefile', "Makefile exists";
+ }
if ($cleanup) {
$output = stdout_of( sub {
$build->do_system(@make, 'realclean');
});
- ok ! -e 'Makefile', "Makefile cleaned up";
+ ok ! -e $makefile, "$makefile cleaned up";
}
else {
pass '(skipping cleanup)'; # keep test count constant
@@ -287,10 +311,19 @@
my %requires = %{ $_[0] };
delete $requires{perl}; # until EU::MM supports this
SKIP: {
- skip 'Makefile not found', 1 unless -e 'Makefile';
- my $prereq_pm = find_makefile_prereq_pm();
+ my $makefile = 'Makefile';
+ if ($vms_mms) {
+ # VMS MMS/MMK can have either Makefile or descrip.mms as the created
file.
+ my $make_test = -e $makefile;
+ unless ($make_test) {
+ $makefile = 'descrip.mms';
+ $make_test = -e $makefile;
+ }
+ }
+ skip 'Makefile not found', 1 unless -e $makefile;
+ my $prereq_pm = find_makefile_prereq_pm($makefile);
is_deeply $prereq_pm, \%requires,
- "Makefile has correct PREREQ_PM line";
+ "$makefile has correct PREREQ_PM line";
}
}
@@ -313,8 +346,9 @@
# Following subroutine adapted from code in CPAN.pm
# by Andreas Koenig and A. Speer.
sub find_makefile_prereq_pm {
- my $fh = IO::File->new( 'Makefile', 'r' )
- or die "Can't read Makefile: $!";
+ my $makefile = shift;
+ my $fh = IO::File->new( $makefile, 'r' )
+ or die "Can't read $makefile: $!";
my $req = {};
local($/) = "\n";
while (<$fh>) {
--- /rsync_root/perl/lib/Module/Build/t/lib/MBTest.pm Fri Oct 26 19:01:41 2007
+++ lib/Module/Build/t/lib/MBTest.pm Sat May 24 18:07:44 2008
@@ -131,6 +131,10 @@
sub find_in_path {
my $thing = shift;
+
+ # VMS does not use path, and it is very complex to check to
+ # see if a command will work before just trying it.
+ return $thing if ($^O eq 'VMS');
my @path = split $Config{path_sep}, $ENV{PATH};
my @exe_ext = exe_exts();
--- /rsync_root/perl/lib/Module/Build.pm Thu Feb 21 08:04:41 2008
+++ lib/Module/Build.pm Mon May 26 12:46:14 2008
@@ -10,6 +10,7 @@
use File::Spec ();
use File::Path ();
use File::Basename ();
+use Config;
use Module::Build::Base;
@@ -99,6 +100,17 @@
sub is_vmsish { return ((os_type() || '') eq 'VMS') }
sub is_windowsish { return ((os_type() || '') eq 'Windows') }
sub is_unixish { return ((os_type() || '') eq 'Unix') }
+
+# VMS has both Unix like make and its Module Management System
+# or MMS and usually the difference in the desired
+# behavior for module build is really dependent on which one
+# is in use. MMK is a freeware clone of MMS.
+
+# TODO: When perl is launched from GNV utilities, it will be
+# assuming that a Unix make will be used.
+# For now default to what Perl was build with.
+
+sub is_vms_mms { return (is_vmsish && ($Config{make} =~ /MM[S|K]/i)) }
1;
--- /rsync_root/perl/lib/Module/Build/t/tilde.t Fri Nov 16 17:46:01 2007
+++ lib/Module/Build/t/tilde.t Sat Nov 3 01:52:24 2007
@@ -39,7 +39,12 @@
SKIP: {
my $home = $ENV{HOME} ? $ENV{HOME} : undef;
- skip "Needs case and syntax tweaks for VMS", 14 if $^O eq 'VMS';
+
+ if ($^O eq 'VMS') {
+ # Convert the path to UNIX format, trim off the trailing slash
+ $home = VMS::Filespec::unixify($home);
+ $home =~ s#/$##;
+ }
unless (defined $home) {
my @info = eval { getpwuid $> };
skip "No home directory for tilde-expansion tests", 14 if $@;
@@ -83,12 +88,20 @@
# Again, with named users
SKIP: {
- skip "Needs case and syntax tweaks for VMS", 1 if $^O eq 'VMS';
my @info = eval { getpwuid $> };
skip "No home directory for tilde-expansion tests", 1 if $@;
my ($me, $home) = @info[0,7];
+
+ my $expected = "$home/foo";
+
+ if ($^O eq 'VMS') {
+ # Convert the path to UNIX format and trim off the trailing slash
+ $home = VMS::Filespec::unixify($home);
+ $home =~ s#/$##;
+ $expected = $home . '/../[^/]+' . '/foo';
+ }
- is( run_sample( $p => "~$me/foo")->$p(), "$home/foo" );
+ like( run_sample( $p => "~$me/foo")->$p(), qr($expected)i );
}
--- /rsync_root/perl/lib/Module/Build/Platform/VMS.pm Thu Oct 25 04:50:40 2007
+++ lib/Module/Build/Platform/VMS.pm Sun May 25 00:08:06 2008
@@ -136,7 +136,9 @@
? 1
: 0;
- map { $_ = q(").$_.q(") if !/^\"/ && length($_) > 0 }
+ # Do not quote qualifiers that begin with '/' or already
+ # quoted arguments.
+ map { $_ = q(").$_.q(") if !/^[\"|\/]/ && length($_) > 0 }
($got_arrayref ? @{$args[0]}
: @args
);
@@ -304,6 +306,7 @@
# Trivial case of just ~ by it self
if ($spec eq '') {
+ $home =~ s#/$##;
return $home;
}
@@ -334,8 +337,8 @@
my @backup = File::Spec::Unix->splitdir(File::Spec::Unix->updir);
$newdirs = File::Spec::Unix->catdir(@hdirs, @backup, @dirs);
-
}
+ $newdirs =~ s#/$##;
# Now put the two cases back together
$arg = File::Spec::Unix->catpath($hvol, $newdirs, $file);
