This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Declaration nit in vms.c's Perl_my_fwrite.
[perl5.git] / vms / vms.c
diff --git a/vms/vms.c b/vms/vms.c
index 6c91af4..c3af096 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -219,6 +219,17 @@ return 0;
 #  define RTL_USES_UTC 1
 #endif
 
 #  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 */
 
 /* Routine to create a decterm for use with the Perl debugger */
 /* No headers, this information was found in the Programming Concepts Manual */
 
@@ -304,6 +315,7 @@ static char *int_tovmsspec
    (const char *path, char *buf, int dir_flag, int * utf8_flag);
 static char * int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl);
 static char * int_tounixspec(const char *spec, char *buf, int * utf8_fl);
    (const char *path, char *buf, int dir_flag, int * utf8_flag);
 static char * int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl);
 static char * int_tounixspec(const char *spec, char *buf, int * utf8_fl);
+static char * int_tovmspath(const char *path, char *buf, int * utf8_fl);
 
 /* see system service docs for $TRNLNM -- NOT the same as LNM$_MAX_INDEX */
 #define PERL_LNM_MAX_ALLOWED_INDEX 127
 
 /* see system service docs for $TRNLNM -- NOT the same as LNM$_MAX_INDEX */
 #define PERL_LNM_MAX_ALLOWED_INDEX 127
@@ -1046,7 +1058,7 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
 #if defined(PERL_IMPLICIT_CONTEXT)
             if (aTHX == NULL) {
                 fprintf(stderr,
 #if defined(PERL_IMPLICIT_CONTEXT)
             if (aTHX == NULL) {
                 fprintf(stderr,
-                    "%%PERL-W-VMS_INIT Can't read CRTL environ\n");
+                    "Can't read CRTL environ\n");
             } else
 #endif
                 Perl_warn(aTHX_ "Can't read CRTL environ\n");
             } else
 #endif
                 Perl_warn(aTHX_ "Can't read CRTL environ\n");
@@ -1086,7 +1098,7 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
 #if defined(PERL_IMPLICIT_CONTEXT)
               if (aTHX == NULL) {
                   fprintf(stderr,
 #if defined(PERL_IMPLICIT_CONTEXT)
               if (aTHX == NULL) {
                   fprintf(stderr,
-                     "%Perl-VMS-Init, Value of CLI symbol \"%s\" too long",lnm);
+                     "Value of CLI symbol \"%s\" too long",lnm);
               } else
 #endif
                if (ckWARN(WARN_MISC)) {
               } else
 #endif
                if (ckWARN(WARN_MISC)) {
@@ -1817,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
 /*  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)
  */
 void
 Perl_vmssetuserlnm(pTHX_ const char *name, const char *eqv)
@@ -2072,23 +2089,48 @@ Perl_do_rmdir(pTHX_ const char *name)
     int retval;
     Stat_t st;
 
     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;
     }
        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);
        retval = mp_do_kill_file(aTHX_ dirfile, 1);
+    }
 
 
-    PerlMem_free(dirfile);
     return retval;
 
 }  /* end of do_rmdir */
     return retval;
 
 }  /* end of do_rmdir */
@@ -2106,21 +2148,66 @@ Perl_do_rmdir(pTHX_ const char *name)
 int
 Perl_kill_file(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;
 
     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;
 
 
     return rmsts;
 
@@ -2176,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.
    *
    * 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] == '/')) {
    */
   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 */
   }
   else return chdir(dir1);
 }  /* end of my_chdir */
@@ -2193,6 +2286,9 @@ Perl_my_chdir(pTHX_ const char *dir)
 int
 Perl_my_chmod(pTHX_ const char *file_spec, mode_t mode)
 {
 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 */
   STRLEN speclen = strlen(file_spec);
 
   /* zero length string sometimes gives ACCVIO */
@@ -2205,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.
    */
    * 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);
+  changefile = (char *) file_spec; /* cast ok */
+  ret = flex_lstat(file_spec, &st);
+  if (ret != 0) {
 
 
-    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;
-    }
+        /* 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 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);
-
-    /* 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 */
 /*}}}*/
 
 }  /* end of my_chmod */
 /*}}}*/
 
@@ -3899,14 +3980,14 @@ vmspipe_tempfile(pTHX)
     fsync(fileno(fp));
 
     fgetname(fp, file, 1);
     fsync(fileno(fp));
 
     fgetname(fp, file, 1);
-    fstat(fileno(fp), (struct stat *)&s0);
+    fstat(fileno(fp), &s0.crtl_stat);
     fclose(fp);
 
     if (decc_filename_unix_only)
        int_tounixspec(file, file, NULL);
     fp = fopen(file,"r","shr=get");
     if (!fp) return 0;
     fclose(fp);
 
     if (decc_filename_unix_only)
        int_tounixspec(file, file, NULL);
     fp = fopen(file,"r","shr=get");
     if (!fp) return 0;
-    fstat(fileno(fp), (struct stat *)&s1);
+    fstat(fileno(fp), &s1.crtl_stat);
 
     cmp_result = VMS_INO_T_COMPARE(s0.crtl_stat.st_ino, s1.crtl_stat.st_ino);
     if ((cmp_result != 0) && (s0.st_ctime != s1.st_ctime))  {
 
     cmp_result = VMS_INO_T_COMPARE(s0.crtl_stat.st_ino, s1.crtl_stat.st_ino);
     if ((cmp_result != 0) && (s0.st_ctime != s1.st_ctime))  {
@@ -4219,6 +4300,12 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
     if (*in_mode == 'r') {
         PerlIO * xterm_fd;
 
     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;
        xterm_fd = create_forked_xterm(aTHX_ cmd, in_mode);
        if (xterm_fd != NULL)
            return xterm_fd;
@@ -4994,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);
 
   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
 #ifdef NAML$M_OPEN_SPECIAL
   rms_set_nam_nop(mynam, NAML$M_OPEN_SPECIAL);
 #endif
@@ -5196,6 +5277,11 @@ Stat_t dst_st;
        /* No source file or other problem */
        return src_sts;
     }
        /* 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) {
 
     dst_sts = flex_lstat(dst, &dst_st);
     if (dst_sts == 0) {
@@ -5241,7 +5327,28 @@ Stat_t dst_st;
 
        if (!S_ISDIR(dst_st.st_mode) || S_ISDIR(src_st.st_mode)) {
            int d_sts;
 
        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;
 
            if (d_sts != 0)
                return d_sts;
 
@@ -5262,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. */
 
        /* 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;
        char * vms_dst;
        int sts;
        char * ret_str;
@@ -5274,18 +5380,6 @@ Stat_t dst_st;
         * on if one or more of them are directories.
         */
 
         * 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);
        vms_dst = PerlMem_malloc(VMS_MAXRSS);
        if (vms_dst == NULL)
            _ckvmssts_noperl(SS$_INSFMEM);
@@ -5298,24 +5392,11 @@ Stat_t dst_st;
            if (vms_dir_file == NULL)
                _ckvmssts_noperl(SS$_INSFMEM);
 
            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;
            /* 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) {
                if (d_sts != 0) {
-                   PerlMem_free(vms_src);
                    PerlMem_free(vms_dst);
                    errno = EIO;
                    return sts;
                    PerlMem_free(vms_dst);
                    errno = EIO;
                    return sts;
@@ -5327,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) {
           /* 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;
                PerlMem_free(vms_dst);
                errno = EIO;
                return -1;
@@ -5340,7 +5420,6 @@ Stat_t dst_st;
 
            ret_str = do_fileify_dirspec(vms_dst, vms_dir_file, 0, NULL);
            if (ret_str == NULL) {
 
            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;
                PerlMem_free(vms_dst);
                PerlMem_free(vms_dir_file);
                errno = EIO;
@@ -5354,28 +5433,44 @@ Stat_t dst_st;
 
            if ((dst_sts == 0) && S_ISDIR(dst_st.st_mode)) {
                /* VMS pathify a dir target */
 
            if ((dst_sts == 0) && S_ISDIR(dst_st.st_mode)) {
                /* VMS pathify a dir target */
-               ret_str = do_tovmspath(dst, vms_dst, 0, NULL);
+               ret_str = int_tovmspath(dst, vms_dst, NULL);
                if (ret_str == NULL) {
                if (ret_str == NULL) {
-                   PerlMem_free(vms_src);
                    PerlMem_free(vms_dst);
                    errno = EIO;
                    return -1;
                }
            } else {
                    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) {
 
                /* 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;
                }
                    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;
 
        old_file_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
        old_file_dsc.dsc$b_class = DSC$K_CLASS_S;
 
@@ -5403,7 +5498,6 @@ Stat_t dst_st;
           sts = vms_rename_with_acl(aTHX_ &old_file_dsc, &new_file_dsc, flags);
        }
 
           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;
        PerlMem_free(vms_dst);
        if (!$VMS_STATUS_SUCCESS(sts)) {
            errno = EIO;
@@ -5416,10 +5510,25 @@ Stat_t dst_st;
        /* Now get rid of any previous versions of the source file that
         * might still exist
         */
        /* 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 */
     }
 
     /* We deleted the destination, so must force the error to be EIO */
@@ -5516,6 +5625,8 @@ int_rmsexpand
           if ((opts & PERL_RMSEXPAND_M_VMS) == 0)
 #if !defined(__VAX) && defined(NAML$C_MAXRSS)
               opts |= PERL_RMSEXPAND_M_LONG;
           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;
 #endif
           else
               isunix = 0;
@@ -5641,6 +5752,7 @@ int_expanded:
    /* Is a long or a short name expected */
   /*------------------------------------*/
   spec_buf = NULL;
    /* 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;
   if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
     if (rms_nam_rsll(mynam)) {
        spec_buf = outbufl;
@@ -5652,6 +5764,7 @@ int_expanded:
     }
   }
   else {
     }
   }
   else {
+#endif
     if (rms_nam_rsl(mynam)) {
        spec_buf = outbuf;
        speclen = rms_nam_rsl(mynam);
     if (rms_nam_rsl(mynam)) {
        spec_buf = outbuf;
        speclen = rms_nam_rsl(mynam);
@@ -5660,7 +5773,9 @@ int_expanded:
        spec_buf = esa; /* Not esal */
        speclen = rms_nam_esl(mynam);
     }
        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
   spec_buf[speclen] = '\0';
 
   /* Trim off null fields added by $PARSE
@@ -6335,13 +6450,17 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl)
       }
 
       /* Make sure we are using the right buffer */
       }
 
       /* 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 {
       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);
        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,']');
       my_esa[my_esa_len] = '\0';
       if (!rms_is_nam_fnb(dirnam, (NAM$M_EXP_DEV | NAM$M_EXP_DIR))) {
         cp1 = strchr(my_esa,']');
@@ -7227,7 +7346,7 @@ static char *int_tounixspec(const char *spec, char *rslt, int * utf8_fl)
     }
     if (*cp2 == ':') {
       *(cp1++) = '/';
     }
     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 */
     }
     else if (*cp2 == ']' || *cp2 == '>') {
       if (*(cp1-1) != '/') *(cp1++) = '/'; /* Don't double after ellipsis */
@@ -8112,7 +8231,7 @@ int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
         * special device files.
          */
 
         * special device files.
          */
 
-       if ((add_6zero == 0) && (*nextslash == '/') &&
+       if (!islnm && (add_6zero == 0) && (*nextslash == '/') &&
            (&nextslash[1] == unixend)) {
          /* No real directory present */
          add_6zero = 1;
            (&nextslash[1] == unixend)) {
          /* No real directory present */
          add_6zero = 1;
@@ -8372,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 = vmsptr - 1;
     if ((vmslen > 1) &&
        (*vmsptr2 != ']') && (*vmsptr2 != '*') && (*vmsptr2 != '%') &&
-       (*vmsptr2 != ')') && (*lastdot != '.')) {
+       (*vmsptr2 != ')') && (*lastdot != '.') && (*vmsptr2 != ':')) {
        *vmsptr++ = '.';
         vmslen++;
     }
        *vmsptr++ = '.';
         vmslen++;
     }
@@ -8558,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);
 #if __CRTL_VER >= 80200000 && !defined(__VAX)
   if (decc_efs_charset) {
     posix_to_vmsspec_hardway(rslt, rslt_len, path, dir_flag, utf8_flag);
@@ -8935,6 +9054,33 @@ char *Perl_tovmsspec_utf8(pTHX_ const char *path, char *buf, int * utf8_fl)
 char *Perl_tovmsspec_utf8_ts(pTHX_ const char *path, char *buf, int * utf8_fl)
   { return do_tovmsspec(path,buf,1,utf8_fl); }
 
 char *Perl_tovmsspec_utf8_ts(pTHX_ const char *path, char *buf, int * utf8_fl)
   { return do_tovmsspec(path,buf,1,utf8_fl); }
 
+/*{{{ char *int_tovmspath(char *path, char *buf, const int *)*/
+/* Internal routine for use with out an explict context present */
+static char * int_tovmspath(const char *path, char *buf, int * utf8_fl) {
+
+    char * ret_spec, *pathified;
+
+    if (path == NULL)
+        return NULL;
+
+    pathified = PerlMem_malloc(VMS_MAXRSS);
+    if (pathified == NULL)
+        _ckvmssts_noperl(SS$_INSFMEM);
+
+    ret_spec = int_pathify_dirspec(path, pathified);
+
+    if (ret_spec == NULL) {
+        PerlMem_free(pathified);
+        return NULL;
+    }
+
+    ret_spec = int_tovmsspec(pathified, buf, 0, utf8_fl);
+    
+    PerlMem_free(pathified);
+    return ret_spec;
+
+}
+
 /*{{{ char *tovmspath[_ts](char *path, char *buf, const int *)*/
 static char *mp_do_tovmspath(pTHX_ const char *path, char *buf, int ts, int * utf8_fl) {
   static char __tovmspath_retbuf[VMS_MAXRSS];
 /*{{{ char *tovmspath[_ts](char *path, char *buf, const int *)*/
 static char *mp_do_tovmspath(pTHX_ const char *path, char *buf, int ts, int * utf8_fl) {
   static char __tovmspath_retbuf[VMS_MAXRSS];
@@ -9272,7 +9418,7 @@ mp_getredirection(pTHX_ int *ac, char ***av)
        /* Input from a pipe, reopen it in binary mode to disable       */
        /* carriage control processing.                                 */
 
        /* 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);
        mbxnam.dsc$a_pointer = mbxname;
        mbxnam.dsc$w_length = strlen(mbxnam.dsc$a_pointer);     
        lib$getdvi(&dvi_item, 0, &mbxnam, &bufsize, 0, 0);
@@ -9650,6 +9796,7 @@ vms_image_init(int *argcp, char ***argvp)
     Perl_csighandler_init();
 #endif
 
     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);
     /* 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);
@@ -9679,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]);
 
   _ckvmssts_noperl(sys$getjpiw(0,NULL,NULL,jpilist,iosb,NULL,NULL));
   _ckvmssts_noperl(iosb[0]);
@@ -10106,7 +10253,7 @@ Perl_opendir(pTHX_ const char *name)
     Stat_t sb;
 
     Newx(dir, VMS_MAXRSS, char);
     Stat_t sb;
 
     Newx(dir, VMS_MAXRSS, char);
-    if (do_tovmspath(name,dir,0,NULL) == NULL) {
+    if (int_tovmspath(name, dir, NULL) == NULL) {
       Safefree(dir);
       return NULL;
     }
       Safefree(dir);
       return NULL;
     }
@@ -10326,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) {
         /* 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, (stat_t *)&statbuf);
-                    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;
                 }
             }
         }
                 }
             }
         }
@@ -11106,7 +11249,7 @@ FILE *my_fdopen(int fd, const char *mode)
       memset(sockflags+sockflagsize,0,fdoff + 2 - sockflagsize);
       sockflagsize = fdoff + 2;
     }
       memset(sockflags+sockflagsize,0,fdoff + 2 - sockflagsize);
       sockflagsize = fdoff + 2;
     }
-    if (fstat(fd, (struct stat *)&sbuf) == 0 && S_ISSOCK(sbuf.st_mode))
+    if (fstat(fd, &sbuf.crtl_stat) == 0 && S_ISSOCK(sbuf.st_mode))
       sockflags[fdoff] |= 1 << (fd % sizeof(unsigned int));
   }
   return fp;
       sockflags[fdoff] |= 1 << (fd % sizeof(unsigned int));
   }
   return fp;
@@ -11146,7 +11289,8 @@ int my_fclose(FILE *fp) {
 int
 my_fwrite(const void *src, size_t itmsz, size_t nitm, FILE *dest)
 {
 int
 my_fwrite(const void *src, size_t itmsz, size_t nitm, FILE *dest)
 {
-  register char *cp, *end, *cpd, *data;
+  register char *cp, *end, *cpd;
+  char *data;
   register unsigned int fd = fileno(dest);
   register unsigned int fdoff = fd / sizeof(unsigned int);
   int retval;
   register unsigned int fd = fileno(dest);
   register unsigned int fdoff = fd / sizeof(unsigned int);
   int retval;
@@ -11203,6 +11347,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
 /*
  * Here are replacements for the following Unix routines in the VMS environment:
  *      getpwuid    Get information for a particular UIC or UID
@@ -12376,6 +12548,10 @@ is_null_device(name)
   return (*name++ == ':') && (*name != ':');
 }
 
   return (*name++ == ':') && (*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
 
 static I32
 Perl_cando_by_name_int
@@ -12431,15 +12607,15 @@ Perl_cando_by_name_int
   }
 
   /* sys$check_access needs a file spec, not a directory spec.
   }
 
   /* sys$check_access needs a file spec, not a directory spec.
-   * Don't use flex_stat here, as that depends on thread context
-   * having been initialized, and we may get here during startup.
+   * flex_stat now will handle a null thread context during startup.
    */
 
   retlen = namdsc.dsc$w_length = strlen(vmsname);
   if (vmsname[retlen-1] == ']' 
       || vmsname[retlen-1] == '>' 
       || vmsname[retlen-1] == ':'
    */
 
   retlen = namdsc.dsc$w_length = strlen(vmsname);
   if (vmsname[retlen-1] == ']' 
       || vmsname[retlen-1] == '>' 
       || vmsname[retlen-1] == ':'
-      || (!stat(vmsname, (stat_t *)&st) && S_ISDIR(st.st_mode))) {
+      || (!flex_stat_int(vmsname, &st, 1) &&
+          S_ISDIR(st.st_mode))) {
 
       if (!int_fileify_dirspec(vmsname, fileified, NULL)) {
         PerlMem_free(fileified);
 
       if (!int_fileify_dirspec(vmsname, fileified, NULL)) {
         PerlMem_free(fileified);
@@ -12571,7 +12747,7 @@ Perl_cando_by_name(pTHX_ I32 bit, bool effective, const char *fname)
 int
 Perl_flex_fstat(pTHX_ int fd, Stat_t *statbufp)
 {
 int
 Perl_flex_fstat(pTHX_ int fd, Stat_t *statbufp)
 {
-  if (!fstat(fd,(stat_t *) statbufp)) {
+  if (!fstat(fd, &statbufp->crtl_stat)) {
     char *cptr;
     char *vms_filename;
     vms_filename = PerlMem_malloc(VMS_MAXRSS);
     char *cptr;
     char *vms_filename;
     vms_filename = PerlMem_malloc(VMS_MAXRSS);
@@ -12625,34 +12801,24 @@ Perl_flex_fstat(pTHX_ int fd, Stat_t *statbufp)
 }  /* end of flex_fstat() */
 /*}}}*/
 
 }  /* 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)
 {
 static int
 Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
 {
-    char fileified[VMS_MAXRSS];
-    char temp_fspec[VMS_MAXRSS];
-    char *save_spec;
+    char *fileified;
+    char *temp_fspec;
+    const char *save_spec;
+    char *ret_spec;
     int retval = -1;
     int retval = -1;
+    int efs_hack = 0;
     dSAVEDERRNO;
 
     dSAVEDERRNO;
 
-    if (!fspec) return retval;
-    SAVE_ERRNO;
-    strcpy(temp_fspec, fspec);
+    if (!fspec) {
+        errno = EINVAL;
+        return retval;
+    }
 
     if (decc_bug_devnull != 0) {
 
     if (decc_bug_devnull != 0) {
-      if (is_null_device(temp_fspec)) { /* Fake a stat() for the null device */
+      if (is_null_device(fspec)) { /* Fake a stat() for the null device */
        memset(statbufp,0,sizeof *statbufp);
         VMS_DEVICE_ENCODE(statbufp->st_dev, "_NLA0:", 0);
        statbufp->st_mode = S_IFBLK | S_IREAD | S_IWRITE | S_IEXEC;
        memset(statbufp,0,sizeof *statbufp);
         VMS_DEVICE_ENCODE(statbufp->st_dev, "_NLA0:", 0);
        statbufp->st_mode = S_IFBLK | S_IREAD | S_IWRITE | S_IEXEC;
@@ -12676,58 +12842,86 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
      */
 
 
      */
 
 
-#if __CRTL_VER >= 70300000 && !defined(__VAX)
-  /* The CRTL stat() falls down hard on multi-dot filenames in unix format unless
-   * DECC$EFS_CHARSET is in effect, so temporarily enable it if it isn't already.
-   */
-  if (!decc_efs_charset)
-    decc$feature_set_value(decc$feature_get_index("DECC$EFS_CHARSET"),1,1); 
-#endif
+    fileified = PerlMem_malloc(VMS_MAXRSS);
+    if (fileified == NULL)
+        _ckvmssts_noperl(SS$_INSFMEM);
+     
+    temp_fspec = PerlMem_malloc(VMS_MAXRSS);
+    if (temp_fspec == NULL)
+        _ckvmssts_noperl(SS$_INSFMEM);
+
+    strcpy(temp_fspec, fspec);
+
+    SAVE_ERRNO;
 
 #if __CRTL_VER >= 80200000 && !defined(__VAX)
   if (decc_posix_compliant_pathnames == 0) {
 #endif
 
 #if __CRTL_VER >= 80200000 && !defined(__VAX)
   if (decc_posix_compliant_pathnames == 0) {
 #endif
-    if (do_fileify_dirspec(temp_fspec,fileified,0,NULL) != NULL) {
-      if (lstat_flag == 0)
-       retval = stat(fileified,(stat_t *) statbufp);
-      else
-       retval = lstat(fileified,(stat_t *) statbufp);
-      save_spec = fileified;
+
+    /* We may be able to optimize this, but in order for fileify_dirspec to
+     * always return a usuable answer, we have to call vmspath first to
+     * make sure that it is in VMS directory format, as stat/lstat on 8.3
+     * can not handle directories in unix format that it does not have read
+     * access to.  Vmspath handles the case where a bare name which could be
+     * a logical name gets passed.
+     */ 
+    ret_spec = int_tovmspath(fspec, temp_fspec, NULL);
+    if (ret_spec != NULL) {
+        ret_spec = int_fileify_dirspec(temp_fspec, fileified, NULL); 
+        if (ret_spec != NULL) {
+            if (lstat_flag == 0)
+                retval = stat(fileified, &statbufp->crtl_stat);
+            else
+                retval = lstat(fileified, &statbufp->crtl_stat);
+            save_spec = fileified;
+        }
     }
     }
-    if (retval) {
-      if (lstat_flag == 0)
-       retval = stat(temp_fspec,(stat_t *) statbufp);
-      else
-       retval = lstat(temp_fspec,(stat_t *) statbufp);
-      save_spec = temp_fspec;
+
+    if (retval && vms_bug_stat_filename) {
+
+        /* We should try again as a vmsified file specification */
+        /* However Perl traditionally has not done this, which  */
+        /* causes problems with existing tests */
+
+        ret_spec = int_tovmsspec(fspec, temp_fspec, 0, NULL);
+        if (ret_spec != NULL) {
+            if (lstat_flag == 0)
+                retval = stat(temp_fspec, &statbufp->crtl_stat);
+            else
+                retval = lstat(temp_fspec, &statbufp->crtl_stat);
+            save_spec = temp_fspec;
+        }
     }
     }
-/*
- * In debugging, on 8.3 Alpha, I found a case where stat was returning a
- * file not found error for a directory named foo:[bar.t] or /foo/bar/t
- * and lstat was working correctly for the same file.
- * The only syntax that was working for stat was "foo:[bar]t.dir".
- *
- * Other directories with the same syntax worked fine.
- * So work around the problem when it shows up here.
- */
+
     if (retval) {
     if (retval) {
-        int save_errno = errno;
-       if (do_tovmsspec(fspec, temp_fspec, 0, NULL) != NULL) {
-           if (do_fileify_dirspec(temp_fspec, fileified, 0, NULL) != NULL) {
-               retval = stat(fileified, (stat_t *) statbufp);
-               save_spec = fileified;
-           }
-       }
-       /* Restore the errno value if third stat does not succeed */
-       if (retval != 0)
-           errno = save_errno;
+        /* Last chance - allow multiple dots with out EFS CHARSET */
+        /* The CRTL stat() falls down hard on multi-dot filenames in unix
+         * format unless * DECC$EFS_CHARSET is in effect, so temporarily
+         * enable it if it isn't already.
+         */
+#if __CRTL_VER >= 70300000 && !defined(__VAX)
+        if (!decc_efs_charset && (decc_efs_charset_index > 0))
+            decc$feature_set_value(decc_efs_charset_index, 1, 1); 
+#endif
+        if (lstat_flag == 0)
+           retval = stat(fspec, &statbufp->crtl_stat);
+        else
+           retval = lstat(fspec, &statbufp->crtl_stat);
+        save_spec = fspec;
+#if __CRTL_VER >= 70300000 && !defined(__VAX)
+        if (!decc_efs_charset && (decc_efs_charset_index > 0)) {
+            decc$feature_set_value(decc_efs_charset_index, 1, 0); 
+            efs_hack = 1;
+        }
+#endif
     }
     }
+
 #if __CRTL_VER >= 80200000 && !defined(__VAX)
   } else {
     if (lstat_flag == 0)
 #if __CRTL_VER >= 80200000 && !defined(__VAX)
   } else {
     if (lstat_flag == 0)
-      retval = stat(temp_fspec,(stat_t *) statbufp);
+      retval = stat(temp_fspec, &statbufp->crtl_stat);
     else
     else
-      retval = lstat(temp_fspec,(stat_t *) statbufp);
+      retval = lstat(temp_fspec, &statbufp->crtl_stat);
       save_spec = temp_fspec;
   }
 #endif
       save_spec = temp_fspec;
   }
 #endif
@@ -12746,7 +12940,22 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
       if (lstat_flag)
        rmsex_flags |= PERL_RMSEXPAND_M_SYMLINK;
 
       if (lstat_flag)
        rmsex_flags |= PERL_RMSEXPAND_M_SYMLINK;
 
+#if __CRTL_VER >= 70300000 && !defined(__VAX)
+      /* If we used the efs_hack above, we must also use it here for */
+      /* perl_cando to work */
+      if (efs_hack && (decc_efs_charset_index > 0)) {
+          decc$feature_set_value(decc_efs_charset_index, 1, 1);
+      }
+#endif
       cptr = int_rmsexpand_tovms(save_spec, statbufp->st_devnam, rmsex_flags);
       cptr = int_rmsexpand_tovms(save_spec, statbufp->st_devnam, rmsex_flags);
+#if __CRTL_VER >= 70300000 && !defined(__VAX)
+      if (efs_hack && (decc_efs_charset_index > 0)) {
+          decc$feature_set_value(decc_efs_charset, 1, 0);
+      }
+#endif
+
+      /* Fix me: If this is NULL then stat found a file, and we could */
+      /* not convert the specification to VMS - Should never happen */
       if (cptr == NULL)
        statbufp->st_devnam[0] = 0;
 
       if (cptr == NULL)
        statbufp->st_devnam[0] = 0;
 
@@ -13362,7 +13571,7 @@ rmscopy_fromperl(pTHX_ CV *cv)
   if (SvTYPE(mysv) == SVt_PVGV) {
     if (!(io = GvIOp(mysv)) || !PerlIO_getname(IoIFP(io),inspec)) {
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
   if (SvTYPE(mysv) == SVt_PVGV) {
     if (!(io = GvIOp(mysv)) || !PerlIO_getname(IoIFP(io),inspec)) {
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
-      ST(0) = &PL_sv_no;
+      ST(0) = sv_2mortal(newSViv(0));
       Safefree(inspec);
       XSRETURN(1);
     }
       Safefree(inspec);
       XSRETURN(1);
     }
@@ -13371,7 +13580,7 @@ rmscopy_fromperl(pTHX_ CV *cv)
   else {
     if (mysv != ST(0) || !(inp = SvPV(mysv,n_a)) || !*inp) {
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
   else {
     if (mysv != ST(0) || !(inp = SvPV(mysv,n_a)) || !*inp) {
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
-      ST(0) = &PL_sv_no;
+      ST(0) = sv_2mortal(newSViv(0));
       Safefree(inspec);
       XSRETURN(1);
     }
       Safefree(inspec);
       XSRETURN(1);
     }
@@ -13381,7 +13590,7 @@ rmscopy_fromperl(pTHX_ CV *cv)
   if (SvTYPE(mysv) == SVt_PVGV) {
     if (!(io = GvIOp(mysv)) || !PerlIO_getname(IoIFP(io),outspec)) {
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
   if (SvTYPE(mysv) == SVt_PVGV) {
     if (!(io = GvIOp(mysv)) || !PerlIO_getname(IoIFP(io),outspec)) {
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
-      ST(0) = &PL_sv_no;
+      ST(0) = sv_2mortal(newSViv(0));
       Safefree(inspec);
       Safefree(outspec);
       XSRETURN(1);
       Safefree(inspec);
       Safefree(outspec);
       XSRETURN(1);
@@ -13391,7 +13600,7 @@ rmscopy_fromperl(pTHX_ CV *cv)
   else {
     if (mysv != ST(1) || !(outp = SvPV(mysv,n_a)) || !*outp) {
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
   else {
     if (mysv != ST(1) || !(outp = SvPV(mysv,n_a)) || !*outp) {
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
-      ST(0) = &PL_sv_no;
+      ST(0) = sv_2mortal(newSViv(0));
       Safefree(inspec);
       Safefree(outspec);
       XSRETURN(1);
       Safefree(inspec);
       Safefree(outspec);
       XSRETURN(1);
@@ -13399,7 +13608,7 @@ rmscopy_fromperl(pTHX_ CV *cv)
   }
   date_flag = (items == 3) ? SvIV(ST(2)) : 0;
 
   }
   date_flag = (items == 3) ? SvIV(ST(2)) : 0;
 
-  ST(0) = boolSV(rmscopy(inp,outp,date_flag));
+  ST(0) = sv_2mortal(newSViv(rmscopy(inp,outp,date_flag)));
   Safefree(inspec);
   Safefree(outspec);
   XSRETURN(1);
   Safefree(inspec);
   Safefree(outspec);
   XSRETURN(1);
@@ -13862,7 +14071,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 */
 
       /* 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 */
       if (int_tounixspec(contents, utarget, NULL) == NULL) {
 
           /* This should not fail, as an untranslatable filename */
@@ -13870,7 +14079,7 @@ int Perl_my_symlink(pTHX_ const char *contents, const char *link_name) {
           utarget = (char *)contents;
       }
       sts = symlink(utarget, link_name);
           utarget = (char *)contents;
       }
       sts = symlink(utarget, link_name);
-      Safefree(utarget);
+      PerlMem_free(utarget);
       return sts;
   }
 
       return sts;
   }
 
@@ -13966,6 +14175,11 @@ char *realpath(const char *file_name, char * resolved_name, ...);
 
 /* Hack, use old stat() as fastest way of getting ino_t and device */
 int decc$stat(const char *name, void * statbuf);
 
 /* Hack, use old stat() as fastest way of getting ino_t and device */
 int decc$stat(const char *name, void * statbuf);
+#if !defined(__VAX) && __CRTL_VER >= 80200000
+int decc$lstat(const char *name, void * statbuf);
+#else
+#define decc$lstat decc$stat
+#endif
 
 
 /* Realpath is fragile.  In 8.3 it does not work if the feature
 
 
 /* Realpath is fragile.  In 8.3 it does not work if the feature
@@ -13976,31 +14190,119 @@ int decc$stat(const char *name, void * statbuf);
  * fall back to looking up the filename by the device name and FID.
  */
 
  * fall back to looking up the filename by the device name and FID.
  */
 
-int vms_fid_to_name(char * outname, int outlen, const char * name)
+int vms_fid_to_name(char * outname, int outlen,
+                    const char * name, int lstat_flag, mode_t * mode)
 {
 {
+#pragma message save
+#pragma message disable MISALGNDSTRCT
+#pragma message disable MISALGNDMEM
+#pragma member_alignment save
+#pragma nomember_alignment
 struct statbuf_t {
     char          * st_dev;
     unsigned short st_ino[3];
 struct statbuf_t {
     char          * st_dev;
     unsigned short st_ino[3];
-    unsigned short padw;
+    unsigned short old_st_mode;
     unsigned long  padl[30];  /* plenty of room */
 } statbuf;
     unsigned long  padl[30];  /* plenty of room */
 } statbuf;
-int sts;
-struct dsc$descriptor_s dvidsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
-struct dsc$descriptor_s specdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+#pragma message restore
+#pragma member_alignment restore
+
+    int sts;
+    struct dsc$descriptor_s dvidsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+    struct dsc$descriptor_s specdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+    char *fileified;
+    char *temp_fspec;
+    char *ret_spec;
+
+    /* Need to follow the mostly the same rules as flex_stat_int, or we may get
+     * unexpected answers
+     */
+
+    fileified = PerlMem_malloc(VMS_MAXRSS);
+    if (fileified == NULL)
+        _ckvmssts_noperl(SS$_INSFMEM);
+     
+    temp_fspec = PerlMem_malloc(VMS_MAXRSS);
+    if (temp_fspec == NULL)
+        _ckvmssts_noperl(SS$_INSFMEM);
+
+    sts = -1;
+    /* First need to try as a directory */
+    ret_spec = int_tovmspath(name, temp_fspec, NULL);
+    if (ret_spec != NULL) {
+        ret_spec = int_fileify_dirspec(temp_fspec, fileified, NULL); 
+        if (ret_spec != NULL) {
+            if (lstat_flag == 0)
+                sts = decc$stat(fileified, &statbuf);
+            else
+                sts = decc$lstat(fileified, &statbuf);
+        }
+    }
+
+    /* Then as a VMS file spec */
+    if (sts != 0) {
+        ret_spec = int_tovmsspec(name, temp_fspec, 0, NULL);
+        if (ret_spec != NULL) {
+            if (lstat_flag == 0) {
+                sts = decc$stat(temp_fspec, &statbuf);
+            } else {
+                sts = decc$lstat(temp_fspec, &statbuf);
+            }
+        }
+    }
+
+    if (sts) {
+        /* Next try - allow multiple dots with out EFS CHARSET */
+        /* The CRTL stat() falls down hard on multi-dot filenames in unix
+         * format unless * DECC$EFS_CHARSET is in effect, so temporarily
+         * enable it if it isn't already.
+         */
+#if __CRTL_VER >= 70300000 && !defined(__VAX)
+        if (!decc_efs_charset && (decc_efs_charset_index > 0))
+            decc$feature_set_value(decc_efs_charset_index, 1, 1); 
+#endif
+        ret_spec = int_tovmspath(name, temp_fspec, NULL);
+        if (lstat_flag == 0) {
+            sts = decc$stat(name, &statbuf);
+        } else {
+            sts = decc$lstat(name, &statbuf);
+        }
+#if __CRTL_VER >= 70300000 && !defined(__VAX)
+        if (!decc_efs_charset && (decc_efs_charset_index > 0))
+            decc$feature_set_value(decc_efs_charset_index, 1, 0); 
+#endif
+    }
+
+
+    /* and then because the Perl Unix to VMS conversion is not perfect */
+    /* Specifically the CRTL removes spaces and possibly other illegal ODS-2 */
+    /* characters from filenames so we need to try it as-is */
+    if (sts) {
+        if (lstat_flag == 0) {
+            sts = decc$stat(name, &statbuf);
+        } else {
+            sts = decc$lstat(name, &statbuf);
+        }
+    }
 
 
-    sts = decc$stat(name, &statbuf);
     if (sts == 0) {
     if (sts == 0) {
+        int vms_sts;
 
        dvidsc.dsc$a_pointer=statbuf.st_dev;
 
        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;
 
 
        specdsc.dsc$a_pointer = outname;
        specdsc.dsc$w_length = outlen-1;
 
-       sts = lib$fid_to_name
+        vms_sts = lib$fid_to_name
            (&dvidsc, statbuf.st_ino, &specdsc, &specdsc.dsc$w_length);
            (&dvidsc, statbuf.st_ino, &specdsc, &specdsc.dsc$w_length);
-       if ($VMS_STATUS_SUCCESS(sts)) {
+        if ($VMS_STATUS_SUCCESS(vms_sts)) {
            outname[specdsc.dsc$w_length] = 0;
            outname[specdsc.dsc$w_length] = 0;
+
+            /* Return the mode */
+            if (mode) {
+                *mode = statbuf.old_st_mode;
+            }
            return 0;
        }
     }
            return 0;
        }
     }
@@ -14030,12 +14332,13 @@ mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf,
         char * v_spec, * r_spec, * d_spec, * n_spec, * e_spec, * vs_spec;
         int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
         int file_len;
         char * v_spec, * r_spec, * d_spec, * n_spec, * e_spec, * vs_spec;
         int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
         int file_len;
+        mode_t my_mode;
 
        /* Fall back to fid_to_name */
 
         Newx(vms_spec, VMS_MAXRSS + 1, char);
 
 
        /* Fall back to fid_to_name */
 
         Newx(vms_spec, VMS_MAXRSS + 1, char);
 
-       sts = vms_fid_to_name(vms_spec, VMS_MAXRSS + 1, filespec);
+       sts = vms_fid_to_name(vms_spec, VMS_MAXRSS + 1, filespec, 0, &my_mode);
        if (sts == 0) {
 
 
        if (sts == 0) {
 
 
@@ -14064,6 +14367,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;
 
                    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);
 
                    /* The result is expected to be in UNIX format */
                    rslt = int_tounixspec(vms_spec, outbuf, utf8_fl);
 
@@ -14154,7 +14471,7 @@ mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf,
                    /* Need realpath for the directory */
                    sts = vms_fid_to_name(vms_dir_name,
                                          VMS_MAXRSS + 1,
                    /* Need realpath for the directory */
                    sts = vms_fid_to_name(vms_dir_name,
                                          VMS_MAXRSS + 1,
-                                         dir_name);
+                                         dir_name, 0, NULL);
 
                    if (sts == 0) {
                        /* Now need to pathify it.
 
                    if (sts == 0) {
                        /* Now need to pathify it.
@@ -14187,7 +14504,7 @@ mp_do_vms_realname(pTHX_ const char *filespec, char *outbuf,
 
     /* Fall back to fid_to_name */
 
 
     /* Fall back to fid_to_name */
 
-    sts = vms_fid_to_name(outbuf, VMS_MAXRSS + 1, filespec);
+    sts = vms_fid_to_name(outbuf, VMS_MAXRSS + 1, filespec, 0, NULL);
     if (sts != 0) {
        return NULL;
     }
     if (sts != 0) {
        return NULL;
     }
Unnamed repository; edit this file 'description' to name the repository.