consolidated VMS patches (from Craig A. Berry
Gurusamy Sarathy [Wed, 1 Mar 2000 06:44:42 +0000 (06:44 +0000)]
<craig.berry@metamorgs.com>); Glob.pm patch modified to use
$DEFAULT_FLAGS, and iff no flags were supplied

p4raw-id: //depot/perl@5397

24 files changed:
configure.com
ext/File/Glob/Glob.pm
ext/File/Glob/bsd_glob.c
installperl
lib/ExtUtils/MM_VMS.pm
lib/File/Find.pm
lib/Pod/Checker.pm
lib/Pod/Parser.pm
t/io/open.t
t/io/openpid.t
t/lib/glob-basic.t
t/op/goto.t
t/op/runlevel.t
t/op/split.t
t/pod/testp2pt.pl
t/pragma/strict.t
t/pragma/subs.t
t/pragma/warn/8signal
t/pragma/warn/pp_sys
t/pragma/warnings.t
vms/descrip_mms.template
vms/subconfigure.com
vms/test.com
vms/vms.c

index deb4d11..c34389e 100644 (file)
@@ -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"
index f703a0b..3c3ea6c 100644 (file)
@@ -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
index c422d60..62bfe4f 100644 (file)
@@ -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) {
index 387f4b3..dd6d663 100755 (executable)
@@ -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.
index 5f54b10..57a8146 100644 (file)
@@ -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";
        }
index 71cc0e6..a5e750e 100644 (file)
@@ -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");
index 281bd11..6611a05 100644 (file)
@@ -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}}) {
index a00f0ee..1abd690 100644 (file)
@@ -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)
index 1e94091..531fc85 100755 (executable)
@@ -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');
index fc71e7a..80c6bde 100755 (executable)
@@ -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;         
index ac3abf5..2336fc0 100755 (executable)
@@ -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')
 {
index 73fc79a..96bb8dd 100755 (executable)
@@ -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";}
index 1d923cf..e988ad9 100755 (executable)
@@ -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`;
index 48e64e1..8b9f4ad 100755 (executable)
@@ -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";
 
index 234a527..22bbaf8 100644 (file)
@@ -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');
index 2b8c587..c4d6416 100755 (executable)
@@ -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 = $?;
index c8eb2c0..fe84f5e 100755 (executable)
@@ -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`;
index 0be2d13..80e6033 100644 (file)
@@ -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.
index 5808536..cab1b60 100644 (file)
@@ -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;
index 41324e6..71fb0df 100644 (file)
@@ -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//) {
index a2b57fa..6f93a9b 100644 (file)
@@ -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)
index 585ab64..ef81968 100644 (file)
@@ -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
index 039d844..b1d270d 100644 (file)
@@ -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
index 7327b75..338db26 100644 (file)
--- 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);