Handle the rare but legal angle bracket in unixify.
[p5sagit/p5-mst-13.2.git] / vms / vms.c
index c4bc369..9e94935 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -219,6 +219,17 @@ return 0;
 #  define RTL_USES_UTC 1
 #endif
 
+#if !defined(__VAX) && __CRTL_VER >= 80200000
+#ifdef lstat
+#undef lstat
+#endif
+#else
+#ifdef lstat
+#undef lstat
+#endif
+#define lstat(_x, _y) stat(_x, _y)
+#endif
+
 /* Routine to create a decterm for use with the Perl debugger */
 /* No headers, this information was found in the Programming Concepts Manual */
 
@@ -1818,6 +1829,11 @@ Perl_my_setenv(pTHX_ const char *lnm, const char *eqv)
 /*  vmssetuserlnm
  *  sets a user-mode logical in the process logical name table
  *  used for redirection of sys$error
+ *
+ *  Fix-me: The pTHX is not needed for this routine, however doio.c
+ *          is calling it with one instead of using a macro.
+ *          A macro needs to be added to vmsish.h and doio.c updated to use it.
+ *
  */
 void
 Perl_vmssetuserlnm(pTHX_ const char *name, const char *eqv)
@@ -2064,8 +2080,6 @@ mp_do_kill_file(pTHX_ const char *name, int dirflag)
 }  /* end of kill_file() */
 /*}}}*/
 
-int vms_fid_to_name(char * outname, int outlen,
-                    const char * name, int lstat_flag, mode_t * mode);
 
 /*{{{int do_rmdir(char *name)*/
 int
@@ -2075,23 +2089,48 @@ Perl_do_rmdir(pTHX_ const char *name)
     int retval;
     Stat_t st;
 
-    dirfile = PerlMem_malloc(VMS_MAXRSS + 1);
-    if (dirfile == NULL)
-       _ckvmssts(SS$_INSFMEM);
+    /* lstat returns a VMS fileified specification of the name */
+    /* that is looked up, and also lets verifies that this is a directory */
 
-    /* Force to a directory specification */
-    if (do_fileify_dirspec(name, dirfile, 0, NULL) == NULL) {
-       PerlMem_free(dirfile);
-       return -1;
+    retval = flex_lstat(name, &st);
+    if (retval != 0) {
+        char * ret_spec;
+
+        /* Due to a historical feature, flex_stat/lstat can not see some */
+        /* Unix format file names that the rest of the CRTL can see */
+        /* Fixing that feature will cause some perl tests to fail */
+        /* So try this one more time. */
+
+        retval = lstat(name, &st.crtl_stat);
+        if (retval != 0)
+            return -1;
+
+        /* force it to a file spec for the kill file to work. */
+        ret_spec = do_fileify_dirspec(name, st.st_devnam, 0, NULL);
+        if (ret_spec == NULL) {
+            errno = EIO;
+            return -1;
+        }
     }
-    if (Perl_flex_lstat(aTHX_ dirfile, &st) || !S_ISDIR(st.st_mode)) {
+
+    if (!S_ISDIR(st.st_mode)) {
        errno = ENOTDIR;
        retval = -1;
     }
-    else
+    else {
+        dirfile = st.st_devnam;
+
+        /* It may be possible for flex_stat to find a file and vmsify() to */
+        /* fail with ODS-2 specifications.  mp_do_kill_file can not deal */
+        /* with that case, so fail it */
+        if (dirfile[0] == 0) {
+            errno = EIO;
+            return -1;
+        }
+
        retval = mp_do_kill_file(aTHX_ dirfile, 1);
+    }
 
-    PerlMem_free(dirfile);
     return retval;
 
 }  /* end of do_rmdir */
@@ -2109,21 +2148,66 @@ Perl_do_rmdir(pTHX_ const char *name)
 int
 Perl_kill_file(pTHX_ const char *name)
 {
-    char rspec[NAM$C_MAXRSS+1];
-    char *tspec;
+    char * vmsfile;
     Stat_t st;
     int rmsts;
 
-   /* Remove() is allowed to delete directories, according to the X/Open
-    * specifications.
-    * This may need special handling to work with the ACL hacks.
+    /* Convert the filename to VMS format and see if it is a directory */
+    /* flex_lstat returns a vmsified file specification */
+    rmsts = flex_lstat(name, &st);
+    if (rmsts != 0) {
+
+        /* Due to a historical feature, flex_stat/lstat can not see some */
+        /* Unix format file names that the rest of the CRTL can see when */
+        /* ODS-2 file specifications are in use. */
+        /* Fixing that feature will cause some perl tests to fail */
+        /* [.lib.ExtUtils.t]Manifest.t is one of them */
+        st.st_mode = 0;
+        vmsfile = (char *) name; /* cast ok */
+
+    } else {
+        vmsfile = st.st_devnam;
+        if (vmsfile[0] == 0) {
+            /* It may be possible for flex_stat to find a file and vmsify() */
+            /* to fail with ODS-2 specifications.  mp_do_kill_file can not */
+            /* deal with that case, so fail it */
+            errno = EIO;
+            return -1;
+        }
+    }
+
+    /* Remove() is allowed to delete directories, according to the X/Open
+     * specifications.
+     * This may need special handling to work with the ACL hacks.
      */
-   if ((flex_lstat(name, &st) == 0) && S_ISDIR(st.st_mode)) {
-       rmsts = Perl_do_rmdir(aTHX_ name);
-       return rmsts;
+    if (S_ISDIR(st.st_mode)) {
+        rmsts = mp_do_kill_file(aTHX_ vmsfile, 1);
+        return rmsts;
     }
 
-   rmsts = mp_do_kill_file(aTHX_ name, 0);
+    rmsts = mp_do_kill_file(aTHX_ vmsfile, 0);
+
+    /* Need to delete all versions ? */
+    if ((rmsts == 0) && (vms_unlink_all_versions == 1)) {
+        int i = 0;
+
+        /* Just use lstat() here as do not need st_dev */
+        /* and we know that the file is in VMS format or that */
+        /* because of a historical bug, flex_stat can not see the file */
+        while (lstat(vmsfile, (stat_t *)&st) == 0) {
+            rmsts = mp_do_kill_file(aTHX_ vmsfile, 0);
+            if (rmsts != 0)
+                break;
+            i++;
+
+            /* Make sure that we do not loop forever */
+            if (i > 32767) {
+                errno = EIO;
+                rmsts = -1;
+                break;
+            }
+        }
+    }
 
     return rmsts;
 
@@ -2179,13 +2263,19 @@ Perl_my_chdir(pTHX_ const char *dir)
    * null file name/type.  However, it's commonplace under Unix,
    * so we'll allow it for a gain in portability.
    *
-   * - Preview- '/' will be valid soon on VMS
+   *  '/' is valid when SYS$POSIX_ROOT or POSIX compliant pathnames are active.
    */
   if ((dirlen > 1) && (dir1[dirlen-1] == '/')) {
-    char *newdir = savepvn(dir1,dirlen-1);
-    int ret = chdir(newdir);
-    Safefree(newdir);
-    return ret;
+      char *newdir;
+      int ret;
+      newdir = PerlMem_malloc(dirlen);
+      if (newdir ==NULL)
+          _ckvmssts_noperl(SS$_INSFMEM);
+      strncpy(newdir, dir1, dirlen-1);
+      newdir[dirlen-1] = '\0';
+      ret = chdir(newdir);
+      PerlMem_free(newdir);
+      return ret;
   }
   else return chdir(dir1);
 }  /* end of my_chdir */
@@ -2196,6 +2286,9 @@ Perl_my_chdir(pTHX_ const char *dir)
 int
 Perl_my_chmod(pTHX_ const char *file_spec, mode_t mode)
 {
+  Stat_t st;
+  int ret = -1;
+  char * changefile;
   STRLEN speclen = strlen(file_spec);
 
   /* zero length string sometimes gives ACCVIO */
@@ -2208,41 +2301,26 @@ Perl_my_chmod(pTHX_ const char *file_spec, mode_t mode)
    * Tests are showing that chmod() on VMS 8.3 is only accepting directories
    * in VMS file.dir notation.
    */
-  if ((speclen > 1) && (file_spec[speclen-1] == '/')) {
-    char *vms_src, *vms_dir, *rslt;
-    int ret = -1;
-    errno = EIO;
-
-    /* First convert this to a VMS format specification */
-    vms_src = PerlMem_malloc(VMS_MAXRSS);
-    if (vms_src == NULL)
-       _ckvmssts_noperl(SS$_INSFMEM);
-
-    rslt = do_tovmsspec(file_spec, vms_src, 0, NULL);
-    if (rslt == NULL) {
-       /* If we fail, then not a file specification */
-       PerlMem_free(vms_src);
-       errno = EIO;
-       return -1;
-    }
+  changefile = (char *) file_spec; /* cast ok */
+  ret = flex_lstat(file_spec, &st);
+  if (ret != 0) {
 
-    /* Now make it a directory spec so chmod is happy */
-    vms_dir = PerlMem_malloc(VMS_MAXRSS + 1);
-    if (vms_dir == NULL)
-       _ckvmssts_noperl(SS$_INSFMEM);
-    rslt = do_fileify_dirspec(vms_src, vms_dir, 0, NULL);
-    PerlMem_free(vms_src);
+        /* Due to a historical feature, flex_stat/lstat can not see some */
+        /* Unix format file names that the rest of the CRTL can see when */
+        /* ODS-2 file specifications are in use. */
+        /* Fixing that feature will cause some perl tests to fail */
+        /* [.lib.ExtUtils.t]Manifest.t is one of them */
+        st.st_mode = 0;
 
-    /* Now do it */
-    if (rslt != NULL) {
-       ret = chmod(vms_dir, mode);
-    } else {
-       errno = EIO;
-    }
-    PerlMem_free(vms_dir);
-    return ret;
+  } else {
+      /* It may be possible to get here with nothing in st_devname */
+      /* chmod still may work though */
+      if (st.st_devnam[0] != 0) {
+          changefile = st.st_devnam;
+      }
   }
-  else return chmod(file_spec, mode);
+  ret = chmod(changefile, mode);
+  return ret;
 }  /* end of my_chmod */
 /*}}}*/
 
@@ -4222,6 +4300,12 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
     if (*in_mode == 'r') {
         PerlIO * xterm_fd;
 
+#if defined(PERL_IMPLICIT_CONTEXT)
+        /* Can not fork an xterm with a NULL context */
+        /* This probably could never happen */
+        xterm_fd = NULL;
+        if (aTHX != NULL)
+#endif
        xterm_fd = create_forked_xterm(aTHX_ cmd, in_mode);
        if (xterm_fd != NULL)
            return xterm_fd;
@@ -4997,12 +5081,6 @@ static int rms_erase(const char * vmsname)
   rms_set_fna(myfab, mynam, (char *)vmsname, strlen(vmsname)); /* cast ok */
   rms_bind_fab_nam(myfab, mynam);
 
-  /* Are we removing all versions? */
-  if (vms_unlink_all_versions == 1) {
-    const char * defspec = ";*";
-    rms_set_dna(myfab, mynam, (char *)defspec, strlen(defspec)); /* cast ok */
-  }
-
 #ifdef NAML$M_OPEN_SPECIAL
   rms_set_nam_nop(mynam, NAML$M_OPEN_SPECIAL);
 #endif
@@ -5199,6 +5277,11 @@ Stat_t dst_st;
        /* No source file or other problem */
        return src_sts;
     }
+    if (src_st.st_devnam[0] == 0)  {
+        /* This may be possible so fail if it is seen. */
+        errno = EIO;
+        return -1;
+    }
 
     dst_sts = flex_lstat(dst, &dst_st);
     if (dst_sts == 0) {
@@ -5244,7 +5327,28 @@ Stat_t dst_st;
 
        if (!S_ISDIR(dst_st.st_mode) || S_ISDIR(src_st.st_mode)) {
            int d_sts;
-           d_sts = mp_do_kill_file(aTHX_ dst, S_ISDIR(dst_st.st_mode));
+           d_sts = mp_do_kill_file(aTHX_ dst_st.st_devnam,
+                                    S_ISDIR(dst_st.st_mode));
+
+           /* Need to delete all versions ? */
+           if ((d_sts == 0) && (vms_unlink_all_versions == 1)) {
+                int i = 0;
+
+                while (lstat(dst_st.st_devnam, &dst_st.crtl_stat) == 0) {
+                    d_sts = mp_do_kill_file(aTHX_ dst_st.st_devnam, 0);
+                    if (d_sts != 0)
+                        break;
+                    i++;
+
+                    /* Make sure that we do not loop forever */
+                    if (i > 32767) {
+                        errno = EIO;
+                        d_sts = -1;
+                        break;
+                    }
+                }
+           }
+
            if (d_sts != 0)
                return d_sts;
 
@@ -5265,7 +5369,6 @@ Stat_t dst_st;
        /* if the source is a directory, then need to fileify */
        /*  and dest must be a directory or non-existant. */
 
-       char * vms_src;
        char * vms_dst;
        int sts;
        char * ret_str;
@@ -5277,18 +5380,6 @@ Stat_t dst_st;
         * on if one or more of them are directories.
         */
 
-       vms_src = PerlMem_malloc(VMS_MAXRSS);
-       if (vms_src == NULL)
-           _ckvmssts_noperl(SS$_INSFMEM);
-
-       /* Source is always a VMS format file */
-       ret_str = do_tovmsspec(src, vms_src, 0, NULL);
-       if (ret_str == NULL) {
-           PerlMem_free(vms_src);
-           errno = EIO;
-           return -1;
-       }
-
        vms_dst = PerlMem_malloc(VMS_MAXRSS);
        if (vms_dst == NULL)
            _ckvmssts_noperl(SS$_INSFMEM);
@@ -5301,24 +5392,11 @@ Stat_t dst_st;
            if (vms_dir_file == NULL)
                _ckvmssts_noperl(SS$_INSFMEM);
 
-           /* The source must be a file specification */
-           ret_str = int_fileify_dirspec(vms_src, vms_dir_file, NULL);
-           if (ret_str == NULL) {
-               PerlMem_free(vms_src);
-               PerlMem_free(vms_dst);
-               PerlMem_free(vms_dir_file);
-               errno = EIO;
-               return -1;
-           }
-           PerlMem_free(vms_src);
-           vms_src = vms_dir_file;
-
            /* If the dest is a directory, we must remove it
            if (dst_sts == 0) {
                int d_sts;
-               d_sts = mp_do_kill_file(aTHX_ dst, 1);
+               d_sts = mp_do_kill_file(aTHX_ dst_st.st_devnam, 1);
                if (d_sts != 0) {
-                   PerlMem_free(vms_src);
                    PerlMem_free(vms_dst);
                    errno = EIO;
                    return sts;
@@ -5330,7 +5408,6 @@ Stat_t dst_st;
           /* The dest must be a VMS file specification */
           ret_str = int_tovmsspec(dst, vms_dst, 0, NULL);
           if (ret_str == NULL) {
-               PerlMem_free(vms_src);
                PerlMem_free(vms_dst);
                errno = EIO;
                return -1;
@@ -5343,7 +5420,6 @@ Stat_t dst_st;
 
            ret_str = do_fileify_dirspec(vms_dst, vms_dir_file, 0, NULL);
            if (ret_str == NULL) {
-               PerlMem_free(vms_src);
                PerlMem_free(vms_dst);
                PerlMem_free(vms_dir_file);
                errno = EIO;
@@ -5359,26 +5435,42 @@ Stat_t dst_st;
                /* VMS pathify a dir target */
                ret_str = int_tovmspath(dst, vms_dst, NULL);
                if (ret_str == NULL) {
-                   PerlMem_free(vms_src);
                    PerlMem_free(vms_dst);
                    errno = EIO;
                    return -1;
                }
            } else {
+                char * v_spec, * r_spec, * d_spec, * n_spec;
+                char * e_spec, * vs_spec;
+                int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
 
                /* fileify a target VMS file specification */
                ret_str = int_tovmsspec(dst, vms_dst, 0, NULL);
                if (ret_str == NULL) {
-                   PerlMem_free(vms_src);
                    PerlMem_free(vms_dst);
                    errno = EIO;
                    return -1;
                }
+
+               sts = vms_split_path(vms_dst, &v_spec, &v_len, &r_spec, &r_len,
+                             &d_spec, &d_len, &n_spec, &n_len, &e_spec,
+                             &e_len, &vs_spec, &vs_len);
+               if (sts == 0) {
+                    if (e_len == 0) {
+                        /* Get rid of the version */
+                        if (vs_len != 0) {
+                            *vs_spec = '\0';
+                        }
+                        /* Need to specify a '.' so that the extension */
+                        /* is not inherited */
+                        strcat(vms_dst,".");
+                    }
+               }
            }
        }
 
-       old_file_dsc.dsc$a_pointer = vms_src;
-       old_file_dsc.dsc$w_length = strlen(vms_src);
+       old_file_dsc.dsc$a_pointer = src_st.st_devnam;
+       old_file_dsc.dsc$w_length = strlen(src_st.st_devnam);
        old_file_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
        old_file_dsc.dsc$b_class = DSC$K_CLASS_S;
 
@@ -5406,7 +5498,6 @@ Stat_t dst_st;
           sts = vms_rename_with_acl(aTHX_ &old_file_dsc, &new_file_dsc, flags);
        }
 
-       PerlMem_free(vms_src);
        PerlMem_free(vms_dst);
        if (!$VMS_STATUS_SUCCESS(sts)) {
            errno = EIO;
@@ -5419,10 +5510,25 @@ Stat_t dst_st;
        /* Now get rid of any previous versions of the source file that
         * might still exist
         */
-       int save_errno;
-       save_errno = errno;
-       src_sts = mp_do_kill_file(aTHX_ src, S_ISDIR(src_st.st_mode));
-       errno = save_errno;
+       int i = 0;
+       dSAVEDERRNO;
+       SAVE_ERRNO;
+       src_sts = mp_do_kill_file(aTHX_ src_st.st_devnam,
+                                  S_ISDIR(src_st.st_mode));
+       while (lstat(src_st.st_devnam, &src_st.crtl_stat) == 0) {
+            src_sts = mp_do_kill_file(aTHX_ src_st.st_devnam,
+                                      S_ISDIR(src_st.st_mode));
+            if (src_sts != 0)
+                break;
+            i++;
+
+            /* Make sure that we do not loop forever */
+            if (i > 32767) {
+                src_sts = -1;
+                break;
+            }
+       }
+       RESTORE_ERRNO;
     }
 
     /* We deleted the destination, so must force the error to be EIO */
@@ -5519,6 +5625,8 @@ int_rmsexpand
           if ((opts & PERL_RMSEXPAND_M_VMS) == 0)
 #if !defined(__VAX) && defined(NAML$C_MAXRSS)
               opts |= PERL_RMSEXPAND_M_LONG;
+#else
+              NOOP;
 #endif
           else
               isunix = 0;
@@ -5644,6 +5752,7 @@ int_expanded:
    /* Is a long or a short name expected */
   /*------------------------------------*/
   spec_buf = NULL;
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
   if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
     if (rms_nam_rsll(mynam)) {
        spec_buf = outbufl;
@@ -5655,6 +5764,7 @@ int_expanded:
     }
   }
   else {
+#endif
     if (rms_nam_rsl(mynam)) {
        spec_buf = outbuf;
        speclen = rms_nam_rsl(mynam);
@@ -5663,7 +5773,9 @@ int_expanded:
        spec_buf = esa; /* Not esal */
        speclen = rms_nam_esl(mynam);
     }
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
   }
+#endif
   spec_buf[speclen] = '\0';
 
   /* Trim off null fields added by $PARSE
@@ -6338,13 +6450,17 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl)
       }
 
       /* Make sure we are using the right buffer */
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
       if (esal != NULL) {
        my_esa = esal;
        my_esa_len = rms_nam_esll(dirnam);
       } else {
+#endif
        my_esa = esa;
         my_esa_len = rms_nam_esl(dirnam);
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
       }
+#endif
       my_esa[my_esa_len] = '\0';
       if (!rms_is_nam_fnb(dirnam, (NAM$M_EXP_DEV | NAM$M_EXP_DIR))) {
         cp1 = strchr(my_esa,']');
@@ -7230,7 +7346,7 @@ static char *int_tounixspec(const char *spec, char *rslt, int * utf8_fl)
     }
     if (*cp2 == ':') {
       *(cp1++) = '/';
-      if (*(cp2+1) == '[') cp2++;
+      if (*(cp2+1) == '[' || *(cp2+1) == '<') cp2++;
     }
     else if (*cp2 == ']' || *cp2 == '>') {
       if (*(cp1-1) != '/') *(cp1++) = '/'; /* Don't double after ellipsis */
@@ -8115,7 +8231,7 @@ int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
         * special device files.
          */
 
-       if ((add_6zero == 0) && (*nextslash == '/') &&
+       if (!islnm && (add_6zero == 0) && (*nextslash == '/') &&
            (&nextslash[1] == unixend)) {
          /* No real directory present */
          add_6zero = 1;
@@ -8375,7 +8491,7 @@ int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
     vmsptr2 = vmsptr - 1;
     if ((vmslen > 1) &&
        (*vmsptr2 != ']') && (*vmsptr2 != '*') && (*vmsptr2 != '%') &&
-       (*vmsptr2 != ')') && (*lastdot != '.')) {
+       (*vmsptr2 != ')') && (*lastdot != '.') && (*vmsptr2 != ':')) {
        *vmsptr++ = '.';
         vmslen++;
     }
@@ -8561,7 +8677,7 @@ static char *int_tovmsspec
       }
   }
 
-/* If POSIX mode active, handle the conversion */
+/* If EFS charset mode active, handle the conversion */
 #if __CRTL_VER >= 80200000 && !defined(__VAX)
   if (decc_efs_charset) {
     posix_to_vmsspec_hardway(rslt, rslt_len, path, dir_flag, utf8_flag);
@@ -9302,7 +9418,7 @@ mp_getredirection(pTHX_ int *ac, char ***av)
        /* Input from a pipe, reopen it in binary mode to disable       */
        /* carriage control processing.                                 */
 
-       fgetname(stdin, mbxname);
+       fgetname(stdin, mbxname, 1);
        mbxnam.dsc$a_pointer = mbxname;
        mbxnam.dsc$w_length = strlen(mbxnam.dsc$a_pointer);     
        lib$getdvi(&dvi_item, 0, &mbxnam, &bufsize, 0, 0);
@@ -9680,6 +9796,7 @@ vms_image_init(int *argcp, char ***argvp)
     Perl_csighandler_init();
 #endif
 
+#if __CRTL_VER >= 70300000 && !defined(__VAX)
     /* This was moved from the pre-image init handler because on threaded */
     /* Perl it was always returning 0 for the default value. */
     status = simple_trnlnm("SYS$POSIX_ROOT", eqv, LNM$C_NAMLENGTH);
@@ -9709,7 +9826,7 @@ vms_image_init(int *argcp, char ***argvp)
            }
        }
     }
-
+#endif
 
   _ckvmssts_noperl(sys$getjpiw(0,NULL,NULL,jpilist,iosb,NULL,NULL));
   _ckvmssts_noperl(iosb[0]);
@@ -10356,18 +10473,14 @@ Perl_readdir(pTHX_ DIR *dd)
         /* In Unix report mode, remove the ".dir;1" from the name */
         /* if it is a real directory. */
         if (decc_filename_unix_report || decc_efs_charset) {
-            if ((e_len == 4) && (vs_len == 2) && (vs_spec[1] == '1')) {
-                if ((toupper(e_spec[1]) == 'D') &&
-                    (toupper(e_spec[2]) == 'I') &&
-                    (toupper(e_spec[3]) == 'R')) {
-                    Stat_t statbuf;
-                    int ret_sts;
-
-                    ret_sts = stat(buff, &statbuf.crtl_stat);
-                    if ((ret_sts == 0) && S_ISDIR(statbuf.st_mode)) {
-                        e_len = 0;
-                        e_spec[0] = 0;
-                    }
+            if (is_dir_ext(e_spec, e_len, vs_spec, vs_len)) {
+                Stat_t statbuf;
+                int ret_sts;
+
+                ret_sts = flex_lstat(buff, &statbuf);
+                if ((ret_sts == 0) && S_ISDIR(statbuf.st_mode)) {
+                    e_len = 0;
+                    e_spec[0] = 0;
                 }
             }
         }
@@ -11233,6 +11346,34 @@ Perl_my_flush(pTHX_ FILE *fp)
 }
 /*}}}*/
 
+/* fgetname() is not returning the correct file specifications when
+ * decc_filename_unix_report mode is active.  So we have to have it
+ * aways return filenames in VMS mode and convert it ourselves.
+ */
+
+/*{{{ char * my_fgetname(FILE *fp, buf)*/
+char *
+Perl_my_fgetname(FILE *fp, char * buf) {
+    char * retname;
+    char * vms_name;
+
+    retname = fgetname(fp, buf, 1);
+
+    /* If we are in VMS mode, then we are done */
+    if (!decc_filename_unix_report || (retname == NULL)) {
+       return retname;
+    }
+
+    /* Convert this to Unix format */
+    vms_name = PerlMem_malloc(VMS_MAXRSS + 1);
+    strcpy(vms_name, retname);
+    retname = int_tounixspec(vms_name, buf, NULL);
+    PerlMem_free(vms_name);
+
+    return retname;
+}
+/*}}}*/
+
 /*
  * Here are replacements for the following Unix routines in the VMS environment:
  *      getpwuid    Get information for a particular UIC or UID
@@ -12409,6 +12550,8 @@ is_null_device(name)
 static int
 Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag);
 
+#define flex_stat_int(a,b,c)           Perl_flex_stat_int(aTHX_ a,b,c)
+
 static I32
 Perl_cando_by_name_int
    (pTHX_ I32 bit, bool effective, const char *fname, int opts)
@@ -12470,7 +12613,7 @@ Perl_cando_by_name_int
   if (vmsname[retlen-1] == ']' 
       || vmsname[retlen-1] == '>' 
       || vmsname[retlen-1] == ':'
-      || (!Perl_flex_stat_int(NULL, vmsname, &st, 1) &&
+      || (!flex_stat_int(vmsname, &st, 1) &&
           S_ISDIR(st.st_mode))) {
 
       if (!int_fileify_dirspec(vmsname, fileified, NULL)) {
@@ -12657,19 +12800,6 @@ Perl_flex_fstat(pTHX_ int fd, Stat_t *statbufp)
 }  /* end of flex_fstat() */
 /*}}}*/
 
-#if !defined(__VAX) && __CRTL_VER >= 80200000
-#ifdef lstat
-#undef lstat
-#endif
-#else
-#ifdef lstat
-#undef lstat
-#endif
-#define lstat(_x, _y) stat(_x, _y)
-#endif
-
-#define flex_stat_int(a,b,c)           Perl_flex_stat_int(aTHX_ a,b,c)
-
 static int
 Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
 {
@@ -12736,7 +12866,7 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
      */ 
     ret_spec = int_tovmspath(fspec, temp_fspec, NULL);
     if (ret_spec != NULL) {
-        ret_spec = int_fileify_dirspec(temp_fspec, fileified, NULL);
+        ret_spec = int_fileify_dirspec(temp_fspec, fileified, NULL); 
         if (ret_spec != NULL) {
             if (lstat_flag == 0)
                 retval = stat(fileified, &statbufp->crtl_stat);
@@ -13940,7 +14070,7 @@ int Perl_my_symlink(pTHX_ const char *contents, const char *link_name) {
       /* As symbolic links can hold things other than files, we will only do */
       /* the conversion in in ODS-2 mode */
 
-      Newx(utarget, VMS_MAXRSS + 1, char);
+      utarget = PerlMem_malloc(VMS_MAXRSS + 1);
       if (int_tounixspec(contents, utarget, NULL) == NULL) {
 
           /* This should not fail, as an untranslatable filename */
@@ -13948,7 +14078,7 @@ int Perl_my_symlink(pTHX_ const char *contents, const char *link_name) {
           utarget = (char *)contents;
       }
       sts = symlink(utarget, link_name);
-      Safefree(utarget);
+      PerlMem_free(utarget);
       return sts;
   }
 
@@ -14158,14 +14288,14 @@ struct statbuf_t {
         int vms_sts;
 
        dvidsc.dsc$a_pointer=statbuf.st_dev;
-       dvidsc.dsc$w_length=strlen(statbuf.st_dev);
+        dvidsc.dsc$w_length=strlen(statbuf.st_dev);
 
        specdsc.dsc$a_pointer = outname;
        specdsc.dsc$w_length = outlen-1;
 
-       vms_sts = lib$fid_to_name
+        vms_sts = lib$fid_to_name
            (&dvidsc, statbuf.st_ino, &specdsc, &specdsc.dsc$w_length);
-       if ($VMS_STATUS_SUCCESS(vms_sts)) {
+        if ($VMS_STATUS_SUCCESS(vms_sts)) {
            outname[specdsc.dsc$w_length] = 0;
 
             /* Return the mode */
@@ -14236,6 +14366,20 @@ mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf,
                    int file_len = v_len + r_len + d_len + n_len + e_len;
                    vms_spec[file_len] = 0;
 
+                   /* Trim off the .DIR if this is a directory */
+                   if (is_dir_ext(e_spec, e_len, vs_spec, vs_len)) {
+                        if (S_ISDIR(my_mode)) {
+                            e_len = 0;
+                            e_spec[0] = 0;
+                        }
+                   }
+
+                   /* Drop NULL extensions on UNIX file specification */
+                   if ((e_len == 1) && decc_readdir_dropdotnotype) {
+                       e_len = 0;
+                       e_spec[0] = '\0';
+                   }
+
                    /* The result is expected to be in UNIX format */
                    rslt = int_tounixspec(vms_spec, outbuf, utf8_fl);