Merge branch 'blead' into miniperl-make-ext

3 files changed, 39 insertions, 13 deletions

diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm
index 954d228ffd..984ef799b6 100644
--- a/lib/File/Copy.pm
+++ b/lib/File/Copy.pm
@@ -55,7 +55,7 @@ if ($^O eq 'MacOS') {
 my $use_vms_feature = 0;
 BEGIN {
     if ($^O eq 'VMS') {
-        if (eval 'require VMS::Feature') {
+        if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
             $use_vms_feature = 1;
         }
     }
diff --git a/pod/perldsc.pod b/pod/perldsc.pod
index 623e367910..db415343c1 100644
--- a/pod/perldsc.pod
+++ b/pod/perldsc.pod
@@ -568,7 +568,7 @@ X<array of hashes> X<AoH>
  }
 
 =head1 HASHES OF HASHES
-X<hass of hashes> X<HoH>
+X<hash of hashes> X<HoH>
 
 =head2 Declaration of a HASH OF HASHES
 
diff --git a/vms/vms.c b/vms/vms.c
index 52e2be8dcc..ec7507ddd7 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -3043,12 +3043,12 @@ pipe_exit_routine()
       /* We need to use the Perl context of the thread that created */
       /* the pipe. */
       pTHX;
-      if (info->err)
-          aTHX = info->err->thx;
-      else if (info->out)
-          aTHX = info->out->thx;
-      else if (info->in)
-          aTHX = info->in->thx;
+      if (open_pipes->err)
+          aTHX = open_pipes->err->thx;
+      else if (open_pipes->out)
+          aTHX = open_pipes->out->thx;
+      else if (open_pipes->in)
+          aTHX = open_pipes->in->thx;
 #endif
       if ((sts = my_pclose(open_pipes->fp)) == -1) retsts = vaxc$errno;
       else if (!(sts & 1)) retsts = sts;
@@ -9999,12 +9999,13 @@ static unsigned long int
 setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
                    struct dsc$descriptor_s **pvmscmd)
 {
-  char vmsspec[NAM$C_MAXRSS+1], resspec[NAM$C_MAXRSS+1];
+  char * vmsspec;
+  char * resspec;
   char image_name[NAM$C_MAXRSS+1];
   char image_argv[NAM$C_MAXRSS+1];
   $DESCRIPTOR(defdsc,".EXE");
   $DESCRIPTOR(defdsc2,".");
-  $DESCRIPTOR(resdsc,resspec);
+  struct dsc$descriptor_s resdsc;
   struct dsc$descriptor_s *vmscmd;
   struct dsc$descriptor_s imgdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
   unsigned long int cxt = 0, flags = 1, retsts = SS$_NORMAL;
@@ -10016,6 +10017,15 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
   vmscmd = PerlMem_malloc(sizeof(struct dsc$descriptor_s));
   if (vmscmd == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 
+  /* vmsspec is a DCL command buffer, not just a filename */
+  vmsspec = PerlMem_malloc(MAX_DCL_LINE_LENGTH + 1);
+  if (vmsspec == NULL)
+      _ckvmssts_noperl(SS$_INSFMEM);
+
+  resspec = PerlMem_malloc(VMS_MAXRSS);
+  if (resspec == NULL)
+      _ckvmssts_noperl(SS$_INSFMEM);
+
   /* Make a copy for modification */
   cmdlen = strlen(incmd);
   cmd = PerlMem_malloc(cmdlen+1);
@@ -10025,6 +10035,11 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
   image_name[0] = 0;
   image_argv[0] = 0;
 
+  resdsc.dsc$a_pointer = resspec;
+  resdsc.dsc$b_dtype  = DSC$K_DTYPE_T;
+  resdsc.dsc$b_class  = DSC$K_CLASS_S;
+  resdsc.dsc$w_length = VMS_MAXRSS - 1;
+
   vmscmd->dsc$a_pointer = NULL;
   vmscmd->dsc$b_dtype  = DSC$K_DTYPE_T;
   vmscmd->dsc$b_class  = DSC$K_CLASS_S;
@@ -10035,6 +10050,8 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
 
   if (strlen(cmd) > MAX_DCL_LINE_LENGTH) {
     PerlMem_free(cmd);
+    PerlMem_free(vmsspec);
+    PerlMem_free(resspec);
     return CLI$_BUFOVF;                /* continuation lines currently unsupported */
   }
 
@@ -10050,7 +10067,7 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
   if (*rest == '.' || *rest == '/') {
     char *cp2;
     for (cp2 = resspec;
-         *rest && !isspace(*rest) && cp2 - resspec < sizeof resspec;
+         *rest && !isspace(*rest) && cp2 - resspec < (VMS_MAXRSS - 1);
          rest++, cp2++) *cp2 = *rest;
     *cp2 = '\0';
     if (do_tovmsspec(resspec,cp,0,NULL)) { 
@@ -10070,7 +10087,7 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
 
       if (*rest) {
         for (cp2 = vmsspec + strlen(vmsspec);
-             *rest && cp2 - vmsspec < sizeof vmsspec;
+             *rest && cp2 - vmsspec < MAX_DCL_LINE_LENGTH;
              rest++, cp2++) *cp2 = *rest;
         *cp2 = '\0';
       }
@@ -10231,7 +10248,12 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
 	}
         fclose(fp);
       }
-      if (check_img && isdcl) return RMS$_FNF;
+      if (check_img && isdcl) {
+          PerlMem_free(cmd);
+          PerlMem_free(resspec);
+          PerlMem_free(vmsspec);
+          return RMS$_FNF;
+      }
 
       if (cando_by_name(S_IXUSR,0,resspec)) {
         vmscmd->dsc$a_pointer = PerlMem_malloc(MAX_DCL_LINE_LENGTH);
@@ -10275,6 +10297,8 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
 	}
         vmscmd->dsc$w_length = strlen(vmscmd->dsc$a_pointer);
         PerlMem_free(cmd);
+        PerlMem_free(vmsspec);
+        PerlMem_free(resspec);
         return (vmscmd->dsc$w_length > MAX_DCL_LINE_LENGTH ? CLI$_BUFOVF : retsts);
       }
       else
@@ -10289,6 +10313,8 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
   vmscmd->dsc$a_pointer[vmscmd->dsc$w_length] = 0;
 
   PerlMem_free(cmd);
+  PerlMem_free(resspec);
+  PerlMem_free(vmsspec);
 
   /* check if it's a symbol (for quoting purposes) */
   if (suggest_quote && !*suggest_quote) {