In perl.git, the branch maint-5.18 has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/f397717ad61dbc2f0de8d8bd25438708e86ab7ad?hp=4092fc05b917457b3c2acf180ca884a9e2237333>

- Log -----------------------------------------------------------------
commit f397717ad61dbc2f0de8d8bd25438708e86ab7ad
Author: Craig A. Berry <[email protected]>
Date:   Sat Sep 28 21:40:02 2013 -0500

    perldelta for 89c16a74d5f.

M       pod/perldelta.pod

commit 89c16a74d5ff959aaf64172ab9e73d6021e1059e
Author: Craig A. Berry <[email protected]>
Date:   Sat Sep 7 06:55:25 2013 -0500

    Fix processing of PERL_ENV_TABLES.
    
    In a35dcc95dd24524931e I "improved" string safety in vms/vms.c by
    converting to my_strlcpy and my_strlcat, but mangled the length
    argument to my_strlcat when adding the name of the logical name
    table specified in PERL_ENV_TABLES. This caused the command string
    to be truncated, so a command that, for example, should have been:
    
        $ Show Logical * /Table=LNM$JOB
        ...
    
    actually became:
    
        $ Show Logical * /Table=
        %DCL-W-VALREQ, missing qualifier or keyword value - supply all required 
values
    
    Plus it turns out the strings holding the names of the tables were
    being stored in dynamic string descriptors and were not
    NUL-terminated, but the strl* functions require NUL-terminated
    arguments.  So change those to static string descriptors and
    allocate the exact amount of storage needed including room for a
    NUL.
    
    This was a regression in 5.16.0, first reported a couple of days
    ago by Mark Daniel on comp.os.vms:
    
    Date: Fri, 06 Sep 2013 12:56:01 +0930
    From: Mark Daniel <mark.daniel [AT] wasd.vsm.com.au>
    Newsgroups: comp.os.vms
    Message-ID: <[email protected]>
    
    TODO: Figure out how and where to test this.

M       vms/vms.c
-----------------------------------------------------------------------

Summary of changes:
 pod/perldelta.pod |  7 ++++---
 vms/vms.c         | 11 ++++++-----
 2 files changed, 10 insertions(+), 8 deletions(-)

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 49bce71..2c0a243 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -308,9 +308,10 @@ L</Modules and Pragmata> section.
 
 =over 4
 
-=item XXX-some-platform
-
-XXX
+=item VMS
+ 
+The C<PERL_ENV_TABLES> feature to control the population of %ENV at perl
+start-up was broken in Perl 5.16.0 but has now been fixed.
 
 =back
 
diff --git a/vms/vms.c b/vms/vms.c
index 1c93728..7ccda31 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -1371,7 +1371,7 @@ prime_env_iter(void)
       my_strlcpy(cmd, "Show Logical *", sizeof(cmd));
       if (str$case_blind_compare(env_tables[i],&fildevdsc)) {
         my_strlcat(cmd," /Table=", sizeof(cmd));
-        cmddsc.dsc$w_length = my_strlcat(cmd, env_tables[i]->dsc$a_pointer, 
env_tables[i]->dsc$w_length + 1);
+        cmddsc.dsc$w_length = my_strlcat(cmd, env_tables[i]->dsc$a_pointer, 
sizeof(cmd));
       }
       else cmddsc.dsc$w_length = 14;  /* N.B. We test this below */
       flags = defflags | CLI$M_NOCLISYM;
@@ -9658,11 +9658,12 @@ vms_image_init(int *argcp, char ***argvp)
     }
     tabvec[tabidx] = (struct dsc$descriptor_s *) PerlMem_malloc(sizeof(struct 
dsc$descriptor_s));
     if (tabvec[tabidx] == NULL) _ckvmssts_noperl(SS$_INSFMEM);
-    tabvec[tabidx]->dsc$w_length  = 0;
+    tabvec[tabidx]->dsc$w_length  = len;
     tabvec[tabidx]->dsc$b_dtype   = DSC$K_DTYPE_T;
-    tabvec[tabidx]->dsc$b_class   = DSC$K_CLASS_D;
-    tabvec[tabidx]->dsc$a_pointer = NULL;
-    _ckvmssts_noperl(lib$scopy_r_dx(&len,eqv,tabvec[tabidx]));
+    tabvec[tabidx]->dsc$b_class   = DSC$K_CLASS_S;
+    tabvec[tabidx]->dsc$a_pointer = PerlMem_malloc(len + 1);
+    if (tabvec[tabidx]->dsc$a_pointer == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+    my_strlcpy(tabvec[tabidx]->dsc$a_pointer, eqv, len + 1);
   }
   if (tabidx) { tabvec[tabidx] = NULL; env_tables = tabvec; }
 

--
Perl5 Master Repository

Reply via email to