summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--configure.com133
-rw-r--r--ext/File/Glob/Glob.pm4
-rw-r--r--ext/File/Glob/bsd_glob.c15
-rwxr-xr-xinstallperl2
-rw-r--r--lib/ExtUtils/MM_VMS.pm4
-rw-r--r--lib/File/Find.pm5
-rw-r--r--lib/Pod/Checker.pm3
-rw-r--r--lib/Pod/Parser.pm3
-rwxr-xr-xt/io/open.t8
-rwxr-xr-xt/io/openpid.t3
-rwxr-xr-xt/lib/glob-basic.t6
-rwxr-xr-xt/op/goto.t2
-rwxr-xr-xt/op/runlevel.t2
-rwxr-xr-xt/op/split.t2
-rw-r--r--t/pod/testp2pt.pl3
-rwxr-xr-xt/pragma/strict.t4
-rwxr-xr-xt/pragma/subs.t2
-rw-r--r--t/pragma/warn/8signal2
-rw-r--r--t/pragma/warn/pp_sys10
-rw-r--r--t/pragma/warnings.t4
-rw-r--r--vms/descrip_mms.template9
-rw-r--r--vms/subconfigure.com13
-rw-r--r--vms/test.com6
-rw-r--r--vms/vms.c2
24 files changed, 154 insertions, 93 deletions
diff --git a/configure.com b/configure.com
index deb4d119e2..c34389ee4f 100644
--- a/configure.com
+++ b/configure.com
@@ -45,7 +45,8 @@ $ use_debugging_perl = "y"
$ use_ieee_math = "n"
$ be_case_sensitive = "n"
$ use_vmsdebug_perl = "n"
-$ use_64bitint = "n"
+$ use64bitall = "n"
+$ use64bitint = "n"
$ C_Compiler_Replace = "CC="
$ Thread_Live_Dangerously = "MT="
$ use_two_pot_malloc = "N"
@@ -55,8 +56,8 @@ $ d_secintgenv = "N"
$ cc_flags = ""
$ use_multiplicity = "N"
$ vms_default_directory_name = F$ENVIRONMENT("DEFAULT")
-$ max_allowed_dir_depth = 3 ! e.g. [A.B.PERL5_00n] not [A.B.C.PERL5_00n]
-$! max_allowed_dir_depth = 2 ! e.g. [FOO.PERL5_00n] not [FOO.BAR.PERL5_00n]
+$ max_allowed_dir_depth = 3 ! e.g. [A.B.PERL5_xxx] not [A.B.C.PERL5_xxx]
+$! max_allowed_dir_depth = 2 ! e.g. [A.PERL5_xxx] not [A.B.PERL5_xxx]
$!
$ vms_filcnt = F$GETJPI ("","FILCNT")
$!
@@ -360,6 +361,7 @@ $! maybe someday
$!
$!: set package name
$ package = "perl5"
+$ packageup = F$EDIT((package - "5"),"UPCASE")
$!
$!: Eunice requires " " instead of "", can you believe it
$ echo ""
@@ -929,44 +931,44 @@ $!: set up shell script to do ~ expansion !sfn
$!: expand filename !sfn
$!: now set up to get a file name !sfn
$!
+$ prefix = F$ENVIRONMENT("DEFAULT") - ".UU]" + "]"
+$ prefix = F$PARSE(prefix,,,,"NO_CONCEAL") - "][" - ".;"
+$ prefixbase = prefix - "]"
+$ prefix = prefixbase + ".]"
+$!: determine root of directory hierarchy where package will be installed.
+$ dflt = prefix
+$ IF .NOT.silent
+$ THEN
+$ echo ""
+$ echo "By default, ''package' will be installed in ''dflt', pod"
+$ echo "pages under ''prefixbase'LIB.POD], etc..., i.e. with ''dflt' as prefix for"
+$ echo "all installation directories."
+$ echo "On ''osname' the ''prefix' is used to DEFINE the ''packageup'_ROOT prior to installation"
+$ echo "as well as during subsequent use of ''package' via ''packageup'_SETUP.COM."
+$ ENDIF
+$ rp = "Installation prefix to use (for ''packageup'_ROOT)? [ ''dflt' ] "
+$ GOSUB myread
+$ IF ans.NES.""
+$ THEN
+$ prefix = ans
+$ IF F$LOCATE(".]",ans) .EQ. F$LENGTH(ans) THEN prefix = prefix - "]" + ".]"
+$ ELSE
+$ prefix = dflt
+$ ENDIF
+$!
+$! Check here for pre-existing PERL_ROOT.
+$! -> ask if removal desired.
+$! Check here for writability of requested PERL_ROOT if it is not the default (cwd).
+$! -> recommend letting PERL_ROOT be PERL_SRC if requested PERL_ROOT is not writable.
+$!
$ vms_skip_install = "true"
$ dflt = "y"
$! echo ""
-$ rp = "%Config-I-VMS, Do you wish to skip the """"where install"""" questions? [''dflt'] "
+$ rp = "%Config-I-VMS, Do you wish to skip the remaining """"where install"""" questions? [''dflt'] "
$ GOSUB myread
$ IF (.NOT.ans).AND.(ans.NES."") THEN vms_skip_install = "false"
-$ prefix = F$ENVIRONMENT("DEFAULT") - ".UU]" + "]"
-$ prefix = f$parse(prefix,,,,"NO_CONCEAL") - "][" - ".;"
-$ prefix = prefix - "]" + ".]"
$ IF (.NOT.vms_skip_install)
$ THEN
-$!: determine root of directory hierarchy where package will be installed.
-$ dflt = "default"
-$ IF .NOT.silent
-$ THEN
-$ echo ""
-$ echo "By default, ''package' will be installed in ''dflt'/bin, manual"
-$ echo "pages under ''dflt'/man, etc..., i.e. with ''dflt' as prefix for"
-$ echo "all installation directories. Typically set to /usr/local, but you"
-$ echo "may choose /usr if you wish to install ''package' among your system
-$ ENDIF
-$ IF .NOT.silent
-$ THEN TYPE SYS$INPUT:
-binaries. If you wish to have binaries under /bin but manual pages
-under /usr/local/man, that's ok: you will be prompted separately
-for each of the installation directories, the prefix being only used
-to set the defaults.
-$ ENDIF
-$ dflt = prefix
-$ rp = "Installation prefix to use? [ ''dflt' ] "
-$ GOSUB myread
-$ IF ans.NES.""
-$ THEN
-$ prefix = ans
-$ IF F$LOCATE(".]",ans) .EQ. F$LENGTH(ans) THEN prefix = prefix - "]" + ".]"
-$ ELSE
-$ prefix = dflt
-$ ENDIF
$!
$!: set the prefixit variable, to compute a suitable default value
$!
@@ -988,7 +990,7 @@ $ THEN privlib = ans
$ ELSE privlib = dflt
$ ENDIF
$!
-$ ENDIF !%Config-I-VMS, skip "where install" questions
+$ ENDIF !%Config-I-VMS, skip remaining "where install" questions
$!
$!: set the base revision
$ baserev="5"
@@ -1744,25 +1746,51 @@ $ use_multiplicity="N"
$ ENDIF
$!
$! Ask if they want to build with 64-bit support
-$ if (Archname.eqs."VMS_AXP").and.("''f$extract(1,3, f$getsyi(""version""))'".ges."7.1")
+$ IF (Archname.eqs."VMS_AXP").and.("''f$extract(1,3, f$getsyi(""version""))'".ges."7.1")
$ THEN
+$ dflt = use64bitint
$ echo ""
-$ echo "This version of perl has experimental support for building with
-$ echo "64 bit integers and 128 bit floating point variables. This gives
-$ echo "a much larger range for perl's mathematical operations. (Note that
-$ echo "does *not* enable 64-bit fileops at the moment, as Dec C doesn't
-$ echo "do that yet)"
-$ dflt = use_64bitint
-$ rp = "Build with 64 bit integers and 128 bit floating point variable? [''dflt'] "
+$ echo "You can have native 64-bit long integers.
+$ echo ""
+$ echo "Perl can be built to take advantage of 64-bit integer types
+$ echo "on some systems, which provide a much larger range for perl's
+$ echo "mathematical operations. (Note that does *not* enable 64-bit
+$ echo "fileops at the moment, as Dec C doesn't do that yet)."
+$ echo "Choosing this option will most probably introduce binary incompatibilities.
+$ echo ""
+$ echo "If this doesn't make any sense to you, just accept the default ''dflt'.
+$ rp = "Try to use 64-bit integers, if available? [''dflt'] "
$ GOSUB myread
-$ if ans.eqs."" then ans = dflt
-$ if (f$extract(0, 1, "''ans'").eqs."Y").or.(f$extract(0, 1, "''ans'").eqs."y")
+$ IF ans .EQS. "" THEN ans = dflt
+$ IF (f$extract(0, 1, f$edit(ans,"COLLAPSE,UPCASE")) .EQS. "Y")
$ THEN
-$ use_64bitint="Y"
+$ use64bitint="Y"
$ ELSE
-$ use_64bitint="N"
+$ use64bitint="N"
$ ENDIF
-$ ENDIF
+$ IF (use64bitint)
+$ THEN
+$ dflt = use64bitall
+$ echo ""
+$ echo "Since you chose 64-bitness you may want to try maximal 64-bitness.
+$ echo "What you have chosen is minimal 64-bitness which means just enough
+$ echo "to get 64-bit integers. The maximal means using as much 64-bitness
+$ echo "as is possible on the platform. This in turn means even more binary
+$ echo "incompatibilities. On the other hand, your platform may not have
+$ echo "any more maximal 64-bitness than what you already have chosen.
+$ echo ""
+$ echo "If this doesn't make any sense to you, just accept the default ''dflt'.
+$ rp = "Try to use full 64-bit support, if available? [''dflt'] "
+$ GOSUB myread
+$ IF ans .EQS. "" THEN ans = dflt
+$ IF (f$extract(0, 1, f$edit(ans,"COLLAPSE,UPCASE")) .EQS. "Y")
+$ THEN
+$ use64bitall="Y"
+$ ELSE
+$ use64bitall="N"
+$ ENDIF
+$ ENDIF
+$ ENDIF ! AXP && >= 7.1
$!
$! Ask about threads, if appropriate
$ if (Using_Dec_C.eqs."Yes")
@@ -1839,9 +1867,8 @@ $ echo "is really PERL_FOO. There are some packages that use an
$ echo "embedded perl interpreter that instead require case-sensitive
$ echo "linker symbols.
$ echo ""
-$ echo "If you have no idea what the heck this means, and don't have
+$ echo "If you have no idea what this means, and don't have
$ echo "any program requiring anything, choose the default.
-$ echo ""
$ dflt = be_case_sensitive
$ rp = "Case-sensitive symbols [''dflt'] "
$ gosub myread
@@ -1853,7 +1880,6 @@ $ echo ""
$ echo "Perl normally uses G_FLOAT format floating point numbers
$ echo "internally, as do most things on VMS. You can, however, build
$ echo "with IEEE floating point numbers instead if you need to.
-$ echo ""
$ dflt = use_ieee_math
$ rp = "Use IEEE math [''dflt'] "
$ gosub myread
@@ -1865,9 +1891,8 @@ $ echo ""
$ echo "You can, if you need to, pass extra flags on to the C
$ echo "compiler. In general you should only do this if you really,
$ echo "really know what you're doing.
-$ echo ""
$ dflt = user_c_flags
-$ rp = "Flags [''dflt'] "
+$ rp = "Extra C flags [''dflt'] "
$ gosub myread
$ if ans.eqs."" then ans="''dflt'"
$ user_c_flags = "''ans'"
@@ -1961,7 +1986,7 @@ $ echo "break badly"
$ echo "
$ echo "Which modules do you want to build into perl?"
$! dflt = "Fcntl Errno File::Glob IO Opcode Byteloader Devel::Peek Devel::DProf Data::Dumper attrs re VMS::Stdio VMS::DCLsym B SDBM_File"
-$ dflt = "re Fcntl Errno File::Glob IO Opcode Devel::Peek Devel::DProf Data::Dumper attrs VMS::Stdio VMS::DCLsym B SDBM_File Thread"
+$ dflt = "re Fcntl Errno File::Glob IO Opcode Devel::Peek Devel::DProf Data::Dumper attrs VMS::Stdio VMS::DCLsym B SDBM_File Thread Sys::Hostname"
$ if Using_Dec_C.eqs."Yes"
$ THEN
$ dflt = dflt + " POSIX"
diff --git a/ext/File/Glob/Glob.pm b/ext/File/Glob/Glob.pm
index f703a0b183..3c3ea6c1f2 100644
--- a/ext/File/Glob/Glob.pm
+++ b/ext/File/Glob/Glob.pm
@@ -109,7 +109,9 @@ if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) {
# Autoload methods go after =cut, and are processed by the autosplit program.
sub glob {
- return doglob(@_);
+ my ($pat,$flags) = @_;
+ $flags = $DEFAULT_FLAGS if @_ < 2;
+ return doglob($pat,$flags);
}
## borrowed heavily from gsar's File::DosGlob
diff --git a/ext/File/Glob/bsd_glob.c b/ext/File/Glob/bsd_glob.c
index c422d608bd..62bfe4f80c 100644
--- a/ext/File/Glob/bsd_glob.c
+++ b/ext/File/Glob/bsd_glob.c
@@ -658,6 +658,21 @@ glob3(Char *pathbuf, Char *pathend, Char *pattern,
*pathend = BG_EOS;
errno = 0;
+#ifdef VMS
+ {
+ Char *q = pathend;
+ if (q - pathbuf > 5) {
+ q -= 5;
+ if (q[0] == '.' && tolower(q[1]) == 'd' && tolower(q[2]) == 'i'
+ && tolower(q[3]) == 'r' && q[4] == '/')
+ {
+ q[0] = '/';
+ q[1] = BG_EOS;
+ pathend = q+1;
+ }
+ }
+ }
+#endif
if ((dirp = g_opendir(pathbuf, pglob)) == NULL) {
/* TODO: don't call for ENOENT or ENOTDIR? */
if (pglob->gl_errfunc) {
diff --git a/installperl b/installperl
index 387f4b3560..dd6d66394d 100755
--- a/installperl
+++ b/installperl
@@ -631,7 +631,7 @@ sub installlib {
sub copy_if_diff {
my($from,$to)=@_;
return 1 if (($^O eq 'VMS') && (-d $from));
- -f $from || die "$0: $from not found";
+ -f $from || warn "$0: $from not found";
$packlist->{$to} = { type => 'file' };
if (compare($from, $to) || $nonono) {
safe_unlink($to); # In case we don't have write permissions.
diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm
index 5f54b10083..57a8146dae 100644
--- a/lib/ExtUtils/MM_VMS.pm
+++ b/lib/ExtUtils/MM_VMS.pm
@@ -278,14 +278,14 @@ sub find_perl {
print "Checking $name\n" if ($trace >= 2);
# If it looks like a potential command, try it without the MCR
if ($name =~ /^[\w\-\$]+$/ &&
- `$name -e "require $ver; print ""VER_OK\n"""` =~ /VER_OK/) {
+ `$name -e "require $ver; print ""VER_OK\\n"""` =~ /VER_OK/) {
print "Using PERL=$name\n" if $trace;
return $name;
}
next unless $vmsfile = $self->maybe_command($name);
$vmsfile =~ s/;[\d\-]*$//; # Clip off version number; we can use a newer version as well
print "Executing $vmsfile\n" if ($trace >= 2);
- if (`MCR $vmsfile -e "require $ver; print ""VER_OK\n"""` =~ /VER_OK/) {
+ if (`MCR $vmsfile -e "require $ver; print ""VER_OK\\n"""` =~ /VER_OK/) {
print "Using PERL=MCR $vmsfile\n" if $trace;
return "MCR $vmsfile";
}
diff --git a/lib/File/Find.pm b/lib/File/Find.pm
index 71cc0e6d90..a5e750e395 100644
--- a/lib/File/Find.pm
+++ b/lib/File/Find.pm
@@ -511,8 +511,9 @@ sub _find_dir($$$) {
while ( defined ($SE = pop @Stack) ) {
($Level, $p_dir, $dir_rel, $nlink) = @$SE;
if ($CdLvl > $Level && !$no_chdir) {
- die "Can't cd to $dir_name" . '../' x ($CdLvl-$Level)
- unless chdir '../' x ($CdLvl-$Level);
+ my $tmp = join('/',('..') x ($CdLvl-$Level));
+ die "Can't cd to $dir_name" . $tmp
+ unless chdir ($tmp);
$CdLvl = $Level;
}
$dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
diff --git a/lib/Pod/Checker.pm b/lib/Pod/Checker.pm
index 281bd11be7..6611a05d6e 100644
--- a/lib/Pod/Checker.pm
+++ b/lib/Pod/Checker.pm
@@ -307,6 +307,7 @@ use strict;
use Carp;
use Exporter;
use Pod::Parser;
+require VMS::Filespec if $^O eq 'VMS';
use vars qw(@ISA @EXPORT);
@ISA = qw(Pod::Parser);
@@ -546,6 +547,7 @@ The error level, should be 'WARNING' or 'ERROR'.
sub poderror {
my $self = shift;
my %opts = (ref $_[0]) ? %{shift()} : ();
+ $opts{-file} = VMS::Filespec::unixify($opts{-file}) if (exists($opts{-file}) && $^O eq 'VMS');
## Retrieve options
chomp( my $msg = ($opts{-msg} || "")."@_" );
@@ -670,6 +672,7 @@ sub end_pod {
## print the number of errors found
my $self = shift;
my $infile = $self->input_file();
+ $infile = VMS::Filespec::unixify($infile) if $^O eq 'VMS';
my $out_fh = $self->output_handle();
if(@{$self->{_list_stack}}) {
diff --git a/lib/Pod/Parser.pm b/lib/Pod/Parser.pm
index a00f0ee83b..1abd690971 100644
--- a/lib/Pod/Parser.pm
+++ b/lib/Pod/Parser.pm
@@ -196,6 +196,7 @@ use strict;
use Pod::InputObjects;
use Carp;
use Exporter;
+require VMS::Filespec if $^O eq 'VMS';
@ISA = qw(Exporter);
## These "variables" are used as local "glob aliases" for performance
@@ -832,6 +833,7 @@ sub parse_text {
my $errorsub = (@seq_stack > 1) ? $self->errorsub() : undef;
while (@seq_stack > 1) {
($cmd, $file, $line) = ($seq->name, $seq->file_line);
+ $file = VMS::Filespec::unixify($file) if $^O eq 'VMS';
$ldelim = $seq->ldelim;
($rdelim = $ldelim) =~ tr/</>/;
$rdelim =~ s/^(\S+)(\s*)$/$2$1/;
@@ -1065,6 +1067,7 @@ sub parse_from_filehandle {
if (length($1) > 1 and ! $self->{_CUTTING}) {
my $errorsub = $self->errorsub();
my $file = $self->input_file();
+ $file = VMS::Filespec::unixify($file) if $^O eq 'VMS';
my $errmsg = "*** WARNING: line containing nothing but whitespace".
" in paragraph at line $nlines in file $file\n";
(ref $errorsub) and &{$errorsub}($errmsg)
diff --git a/t/io/open.t b/t/io/open.t
index 1e9409171c..531fc85ce3 100755
--- a/t/io/open.t
+++ b/t/io/open.t
@@ -95,7 +95,7 @@ sub ok { print "ok $test\n"; $test++ }
# 24..26
if ($Is_VMS) {
- for (24..26) { print "ok $_ # skipped: not Unix fork\n"; }
+ for (24..26) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
}
else {
print "# \$!='$!'\nnot " unless open(my $f, '-|', <<'EOC');
@@ -111,7 +111,7 @@ EOC
# 27..30
if ($Is_VMS) {
- for (27..30) { print "ok $_ # skipped: not Unix fork\n"; }
+ for (27..30) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
}
else {
print "# \$!='$!'\nnot " unless open(my $f, '|-', <<'EOC');
@@ -219,7 +219,7 @@ ok;
# 56..58
if ($Is_VMS) {
- for (56..58) { print "ok $_ # skipped: not Unix fork\n"; }
+ for (56..58) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
}
else {
print "# \$!='$!'\nnot " unless open(local $f, '-|', <<'EOC');
@@ -235,7 +235,7 @@ EOC
# 59..62
if ($Is_VMS) {
- for (59..62) { print "ok $_ # skipped: not Unix fork\n"; }
+ for (59..62) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
}
else {
print "# \$!='$!'\nnot " unless open(local $f, '|-', <<'EOC');
diff --git a/t/io/openpid.t b/t/io/openpid.t
index fc71e7a769..80c6bde5d1 100755
--- a/t/io/openpid.t
+++ b/t/io/openpid.t
@@ -78,9 +78,8 @@ print "ok 8\n";
# send one expected line of text to child process and then wait for it
autoflush FH4 1;
print FH4 "ok 9\n";
+print "ok 9 # skip VMS\n" if $^O eq 'VMS';
print "# waiting for process $pid4 to exit\n";
-#VMS: Send an EOF to convince the subprocess to exit as well
-if ($^O eq 'VMS') { require VMS::Stdio; VMS::Stdio::writeof(FH4); }
$reap_pid = waitpid $pid4, 0;
print "# reaped pid $reap_pid != $pid4\nnot "
unless $reap_pid == $pid4;
diff --git a/t/lib/glob-basic.t b/t/lib/glob-basic.t
index ac3abf56e4..2336fc0d9b 100755
--- a/t/lib/glob-basic.t
+++ b/t/lib/glob-basic.t
@@ -38,7 +38,7 @@ print "ok 2\n";
# look up the user's home directory
# should return a list with one item, and not set ERROR
-if ($^O ne 'MSWin32') {
+if ($^O ne 'MSWin32' || $^O ne 'VMS') {
eval {
($name, $home) = (getpwuid($>))[0,7];
1;
@@ -72,7 +72,7 @@ print "ok 5\n";
# check bad protections
# should return an empty list, and set ERROR
-if ($^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'os2' or not $>) {
+if ($^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'os2' or $^O eq 'VMS' or not $>) {
print "ok 6 # skipped\n";
}
else {
@@ -99,7 +99,7 @@ print "ok 7\n";
GLOB_BRACE | GLOB_NOMAGIC
);
unless (@a == 3
- and $a[0] eq 'TEST'
+ and $a[0] eq ($^O eq 'VMS'? 'test.' : 'TEST')
and $a[1] eq 'a'
and $a[2] eq 'b')
{
diff --git a/t/op/goto.t b/t/op/goto.t
index 73fc79af32..96bb8ddb55 100755
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -30,7 +30,7 @@ print "#2\t:$foo: == 4\n";
if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";}
$PERL = ($^O eq 'MSWin32') ? '.\perl' : './perl';
-$CMD = qq[$PERL -e "goto foo;" ] . ($^O eq 'VMS' ? '' : ' 2>&1');
+$CMD = qq[$PERL -e "goto foo;" 2>&1 ];
$x = `$CMD`;
if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}
diff --git a/t/op/runlevel.t b/t/op/runlevel.t
index 1d923cf1b5..e988ad9362 100755
--- a/t/op/runlevel.t
+++ b/t/op/runlevel.t
@@ -32,7 +32,7 @@ for (@prgs){
print TEST "$prog\n";
close TEST;
my $results = $Is_VMS ?
- `MCR $^X "-I[-.lib]" $switch $tmpfile` :
+ `MCR $^X "-I[-.lib]" $switch $tmpfile 2>&1` :
$Is_MSWin32 ?
`.\\perl -I../lib $switch $tmpfile 2>&1` :
`./perl $switch $tmpfile 2>&1`;
diff --git a/t/op/split.t b/t/op/split.t
index 48e64e117d..8b9f4ad2f9 100755
--- a/t/op/split.t
+++ b/t/op/split.t
@@ -48,7 +48,7 @@ print $_ eq '1:2:3:4:5:6:::' ? "ok 10\n" : "not ok 10 $_\n";
# Does assignment to a list imply split to one more field than that?
if ($^O eq 'MSWin32') { $foo = `.\\perl -D1024 -e "(\$a,\$b) = split;" 2>&1` }
-elsif ($^O eq 'VMS') { $foo = `./perl "-D1024" -e "(\$a,\$b) = split;"` }
+elsif ($^O eq 'VMS') { $foo = `./perl "-D1024" -e "(\$a,\$b) = split;" 2>&1` }
else { $foo = `./perl -D1024 -e '(\$a,\$b) = split;' 2>&1` }
print $foo =~ /DEBUGGING/ || $foo =~ /SV = (VOID|IV\(3\))/ ? "ok 11\n" : "not ok 11\n";
diff --git a/t/pod/testp2pt.pl b/t/pod/testp2pt.pl
index 234a5271c4..22bbaf8247 100644
--- a/t/pod/testp2pt.pl
+++ b/t/pod/testp2pt.pl
@@ -32,6 +32,7 @@ BEGIN {
require Pod::PlainText;
@ISA = qw( Pod::PlainText );
}
+ require VMS::Filespec if $^O eq 'VMS';
}
## Hardcode settings for TERMCAP and COLUMNS so we can try to get
@@ -41,6 +42,8 @@ BEGIN {
sub catfile(@) { File::Spec->catfile(@_); }
my $INSTDIR = abs_path(dirname $0);
+$INSTDIR = VMS::Filespec::unixpath($INSTDIR) if $^O eq 'VMS';
+$INSTDIR =~ s#/$## if $^O eq 'VMS';
$INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'xtra');
$INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'pod');
$INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 't');
diff --git a/t/pragma/strict.t b/t/pragma/strict.t
index 2b8c58735f..c4d64164e6 100755
--- a/t/pragma/strict.t
+++ b/t/pragma/strict.t
@@ -65,9 +65,7 @@ for (@prgs){
open TEST, ">$tmpfile";
print TEST $prog,"\n";
close TEST;
- my $results = $Is_VMS ?
- `MCR $^X $switch $tmpfile` :
- $Is_MSWin32 ?
+ my $results = $Is_MSWin32 ?
`.\\perl -I../lib $switch $tmpfile 2>&1` :
`./perl $switch $tmpfile 2>&1`;
my $status = $?;
diff --git a/t/pragma/subs.t b/t/pragma/subs.t
index c8eb2c087f..fe84f5ef76 100755
--- a/t/pragma/subs.t
+++ b/t/pragma/subs.t
@@ -46,7 +46,7 @@ for (@prgs){
print TEST $prog,"\n";
close TEST;
my $results = $Is_VMS ?
- `MCR $^X $switch $tmpfile` :
+ `./perl $switch $tmpfile 2>&1` :
$Is_MSWin32 ?
`.\\perl -I../lib $switch $tmpfile 2>&1` :
`./perl $switch $tmpfile 2>&1`;
diff --git a/t/pragma/warn/8signal b/t/pragma/warn/8signal
index 0be2d13cc0..80e60330a6 100644
--- a/t/pragma/warn/8signal
+++ b/t/pragma/warn/8signal
@@ -13,6 +13,6 @@ use warnings FATAL => qw(deprecated) ;
1 if 1 EQ 2 ;
print "The End.\n" ;
EXPECT
-Use of EQ is deprecated at - line 8.
WARN -- Use of EQ is deprecated at - line 6.
DIE -- Use of EQ is deprecated at - line 8.
+Use of EQ is deprecated at - line 8.
diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys
index 5808536752..cab1b60298 100644
--- a/t/pragma/warn/pp_sys
+++ b/t/pragma/warn/pp_sys
@@ -195,6 +195,16 @@ syswrite() on closed filehandle main::STDIN at - line 6.
(Are you trying to call syswrite() on dirhandle main::STDIN?)
########
# pp_sys.c [pp_flock]
+use Config;
+BEGIN {
+ if ( $^O eq 'VMS' and ! $Config{d_flock}) {
+ print <<EOM ;
+SKIPPED
+# flock not present
+EOM
+ exit ;
+ }
+}
use warnings 'closed' ;
close STDIN;
flock STDIN, 8;
diff --git a/t/pragma/warnings.t b/t/pragma/warnings.t
index 41324e68cc..71fb0df972 100644
--- a/t/pragma/warnings.t
+++ b/t/pragma/warnings.t
@@ -76,7 +76,7 @@ for (@prgs){
print TEST $prog,"\n";
close TEST;
my $results = $Is_VMS ?
- `MCR $^X $switch $tmpfile` :
+ `./perl "-I../lib" $switch $tmpfile 2>&1` :
$Is_MSWin32 ?
`.\\perl -I../lib $switch $tmpfile 2>&1` :
`./perl -I../lib $switch $tmpfile 2>&1`;
@@ -91,7 +91,7 @@ for (@prgs){
# allow all tests to run when there are leaks
$results =~ s/Scalars leaked: \d+\n//g;
$expected =~ s/\n+$//;
- my $prefix = ($results =~ s/^PREFIX\n//) ;
+ my $prefix = ($results =~ s#^PREFIX(\n|$)##) ;
# any special options? (OPTIONS foo bar zap)
my $option_regex = 0;
if ($expected =~ s/^OPTIONS? (.+)\n//) {
diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template
index a2b57fa669..6f93a9b051 100644
--- a/vms/descrip_mms.template
+++ b/vms/descrip_mms.template
@@ -293,7 +293,7 @@ obj = $(obj0) $(obj1) $(obj2) $(obj3) $(obj4)
h0 = $(SOCKH) $(THREADH) av.h cc_runtime.h config.h cop.h cv.h embed.h
h1 = embedvar.h extern.h form.h gv.h handy.h hv.h intern.h intrpvar.h
h2 = iperlsys.h mg.h nostdio.h objxsub.h op.h opcode.h opnames.h
-h3 = patchlevel.h perl.h perlio.h perlsdio.h perlvars.h perly.h pp.h
+h3 = patchlevel.h perl.h perlapi.h perlio.h perlsdio.h perlvars.h perly.h pp.h
h4 = pp_proto.h proto.h regexp.h scope.h sv.h thrdvar.h thread.h utf8.h
h5 = util.h vmsish.h warnings.h xsub.h
h6 = regcomp.h regcomp.h
@@ -308,14 +308,14 @@ ac3 = $(ARCHCORE)form.h $(ARCHCORE)gv.h $(ARCHCORE)handy.h $(ARCHCORE)hv.h
ac4 = $(ARCHCORE)intern.h $(ARCHCORE)intrpvar.h $(ARCHCORE)iperlsys.h
ac5 = $(ARCHCORE)keywords.h $(ARCHCORE)mg.h $(ARCHCORE)nostdio.h
ac6 = $(ARCHCORE)op.h $(ARCHCORE)opcode.h $(ARCHCORE)patchlevel.h
-ac7 = $(ARCHCORE)perl.h $(ARCHCORE)perlio.h $(ARCHCORE)perlsdio.h
+ac7 = $(ARCHCORE)perl.h $(ARCHCORE)perlapi.h $(ARCHCORE)perlio.h $(ARCHCORE)perlsdio.h
ac8 = $(ARCHCORE)perlvars.h $(ARCHCORE)perly.h $(ARCHCORE)pp.h
ac9 = $(ARCHCORE)pp_proto.h $(ARCHCORE)proto.h $(ARCHCORE)regcomp.h
ac10 = $(ARCHCORE)regexp.h $(ARCHCORE)regnodes.h $(ARCHCORE)scope.h
ac11 = $(ARCHCORE)sv.h $(ARCHCORE)thrdvar.h $(ARCHCORE)opnames.h
ac12 = $(ARCHCORE)thread.h $(ARCHCORE)utf8.h $(ARCHCORE)util.h
ac13 = $(ARCHCORE)vmsish.h $(ARCHCORE)warnings.h $(ARCHCORE)xsub.h
-ac14 = $(ARCHCORE)perlshr_attr.opt $(ARCHCORE)perlshr_bld.opt
+ac14 = $(ARCHCORE)perlshr_attr.opt $(ARCHCORE)$(DBG)perlshr_bld.opt
ac = $(ac0) $(ac1) $(ac2) $(ac3) $(ac4) $(ac5) $(ac6) $(ac7) $(ac8) $(ac9) $(ac10) $(ac11) $(ac12) $(ac13) $(ac14)
CRTL = []crtl.opt
@@ -1031,6 +1031,9 @@ $(ARCHCORE)patchlevel.h : patchlevel.h
$(ARCHCORE)perl.h : perl.h
@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)perlapi.h : perlapi.h
+ @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
$(ARCHCORE)perlio.h : perlio.h
@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
diff --git a/vms/subconfigure.com b/vms/subconfigure.com
index 585ab643d3..ef81968ac3 100644
--- a/vms/subconfigure.com
+++ b/vms/subconfigure.com
@@ -137,7 +137,7 @@ $ perl_d_sendmsg = "undef"
$ perl_d_recvmsg = "undef"
$ perl_d_msghdr_s = "undef"
$ perl_d_cmsghdr_s = "undef"
-$ IF use_64bitint .eqs. "Y"
+$ IF (use64bitint)
$ THEN
$ perl_use64bitint = "define"
$ perl_uselargefiles = "define"
@@ -149,8 +149,7 @@ $ perl_uselargefiles = "undef"
$ perl_uselongdouble = "undef"
$ perl_usemorebits = "undef"
$ ENDIF
-$ use_64bitall = use_64bitint ! until configure.com question is reworded?
-$ IF use_64bitall .eqs. "Y"
+$ IF (use64bitall)
$ THEN
$ perl_use64bitall = "define"
$ ELSE
@@ -448,7 +447,7 @@ $ perl_pager="most"
$!
$! Are we 64 bit?
$!
-$ if (use_64bitint .eqs. "Y")
+$ if (use64bitint)
$ THEN
$ perl_d_PRIfldbl = "define"
$ perl_d_PRIgldbl = "define"
@@ -4112,7 +4111,7 @@ $ WC "uselargefiles='" + perl_uselargefiles + "'"
$ WC "uselongdouble='" + perl_uselongdouble + "'"
$ WC "usemorebits='" + perl_usemorebits + "'"
$ WC "d_quad='" + perl_d_quad + "'"
-$ if (use_64bitint .eqs. "Y")
+$ IF (use64bitint)
$ THEN
$ WC "quadtype='" + perl_quadtype + "'"
$ WC "uquadtype='" + perl_uquadtype + "'"
@@ -4232,12 +4231,12 @@ $ WRITE CONFIG "#define ALWAYS_DEFTYPES"
$ ELSE
$ WRITE CONFIG "#undef ALWAYS_DEFTYPES"
$ ENDIF
-$ if use_64bitint.eqs."Y"
+$ IF (use64bitint)
$ THEN
$ WRITE CONFIG "#define USE_64_BIT_INT"
$ WRITE CONFIG "#define USE_LONG_DOUBLE"
$ ENDIF
-$ if use_64bitall.eqs."Y"
+$ IF (use64bitall)
$ THEN
$ WRITE CONFIG "#define USE_64_BIT_ALL"
$ ENDIF
diff --git a/vms/test.com b/vms/test.com
index 039d844ea9..b1d270ddcd 100644
--- a/vms/test.com
+++ b/vms/test.com
@@ -45,7 +45,7 @@ $ Delete/Log/NoConfirm Perl.;*
$ Copy/Log/NoConfirm [-]'ndbg'Perl'exe' []Perl.
$
$! Make the environment look a little friendlier to tests which assume Unix
-$ cat = "Type"
+$ cat == "Type"
$ Macro/NoDebug/NoList/Object=Echo.Obj Sys$Input
.title echo
.psect data,wrt,noexe
@@ -88,7 +88,7 @@ $ Macro/NoDebug/NoList/Object=Echo.Obj Sys$Input
.end echo
$ Link/NoMap/NoTrace/Exe=Echo.Exe Echo.Obj;
$ Delete/Log/NoConfirm Echo.Obj;*
-$ echo = "$" + F$Parse("Echo.Exe")
+$ echo == "$" + F$Parse("Echo.Exe")
$
$! And do it
$ Show Process/Accounting
@@ -112,7 +112,7 @@ use Config;
@libexcl=('db-btree.t','db-hash.t','db-recno.t',
'gdbm.t','io_dup.t', 'io_pipe.t', 'io_poll.t', 'io_sel.t',
'io_sock.t', 'io_unix.t',
- 'ndbm.t','odbm.t','open2.t','open3.t', 'ph.t', 'posix.t');
+ 'ndbm.t','odbm.t','open2.t','open3.t', 'ph.t', 'posix.t', 'dprof.t');
# Note: POSIX is not part of basic build, but can be built
# separately if you're using DECC
diff --git a/vms/vms.c b/vms/vms.c
index 7327b75b6f..338db26249 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -4273,7 +4273,7 @@ int my_utime(char *file, struct utimbuf *utimes)
/* If input was UTC; convert to local for sys svc */
if (!VMSISH_TIME) unixtime = _toloc(unixtime);
# endif
- unixtime >> 1; secscale << 1;
+ unixtime >>= 1; secscale <<= 1;
retsts = lib$emul(&secscale, &unixtime, &lowbit, bintime);
if (!(retsts & 1)) {
set_errno(EVMSERR);
View Lorry Controller Status