Bump $threads::VERSION as the documentation has changed. Tweak the
[p5sagit/p5-mst-13.2.git] / vms / vms.c
index 2bcf087..1bbc960 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -222,6 +222,7 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
           retsts = SS$_NOLOGNAM;
           for (i = 0; environ[i]; i++) { 
             if ((eq = strchr(environ[i],'=')) && 
+                lnmdsc.dsc$w_length == (eq - environ[i]) &&
                 !strncmp(environ[i],uplnm,eq - environ[i])) {
               eq++;
               for (eqvlen = 0; eq[eqvlen]; eqvlen++) eqv[eqvlen] = eq[eqvlen];
@@ -714,6 +715,11 @@ Perl_vmssetenv(pTHX_ char *lnm, char *eqv, struct dsc$descriptor_s **tabvec)
     $DESCRIPTOR(crtlenv,"CRTL_ENV");  $DESCRIPTOR(clisym,"CLISYM");
     $DESCRIPTOR(local,"_LOCAL");
 
+    if (!lnm) {
+        set_errno(EINVAL); set_vaxc_errno(SS$_IVLOGNAM);
+        return SS$_IVLOGNAM;
+    }
+
     for (cp1 = lnm, cp2 = uplnm; *cp1; cp1++, cp2++) {
       *cp2 = _toupper(*cp1);
       if (cp1 - lnm > LNM$C_NAMLENGTH) {
@@ -728,8 +734,9 @@ Perl_vmssetenv(pTHX_ char *lnm, char *eqv, struct dsc$descriptor_s **tabvec)
       for (curtab = 0; tabvec[curtab]; curtab++) {
         if (!ivenv && !str$case_blind_compare(tabvec[curtab],&crtlenv)) {
         int i;
-          for (i = 0; environ[i]; i++) { /* Iff it's an environ elt, reset */
+          for (i = 0; environ[i]; i++) { /* If it's an environ elt, reset */
             if ((cp1 = strchr(environ[i],'=')) && 
+                lnmdsc.dsc$w_length == (cp1 - environ[i]) &&
                 !strncmp(environ[i],lnm,cp1 - environ[i])) {
 #ifdef HAS_SETENV
               return setenv(lnm,"",1) ? vaxc$errno : 0;
@@ -2269,7 +2276,7 @@ vmspipe_tempfile(pTHX)
     }
     if (!fp) return 0;  /* we're hosed */
 
-    fprintf(fp,"$! 'f$verify(0)\n");
+    fprintf(fp,"$! 'f$verify(0)'\n");
     fprintf(fp,"$!  ---  protect against nonstandard definitions ---\n");
     fprintf(fp,"$ perl_cfile  = f$environment(\"procedure\")\n");
     fprintf(fp,"$ perl_define = \"define/nolog\"\n");
@@ -2287,16 +2294,8 @@ vmspipe_tempfile(pTHX)
     fprintf(fp,"$c=c+perl_popen_cmd2\n"); 
     fprintf(fp,"$x=perl_popen_cmd3\n"); 
     fprintf(fp,"$c=c+x\n"); 
-    fprintf(fp,"$!  --- get rid of global symbols\n");
-    fprintf(fp,"$ perl_del/symbol/global perl_popen_in\n");
-    fprintf(fp,"$ perl_del/symbol/global perl_popen_err\n");
-    fprintf(fp,"$ perl_del/symbol/global perl_popen_out\n");
-    fprintf(fp,"$ perl_del/symbol/global perl_popen_cmd0\n");
-    fprintf(fp,"$ perl_del/symbol/global perl_popen_cmd1\n");
-    fprintf(fp,"$ perl_del/symbol/global perl_popen_cmd2\n");
-    fprintf(fp,"$ perl_del/symbol/global perl_popen_cmd3\n");
     fprintf(fp,"$ perl_on\n");
-    fprintf(fp,"$ 'c\n");
+    fprintf(fp,"$ 'c'\n");
     fprintf(fp,"$ perl_status = $STATUS\n");
     fprintf(fp,"$ perl_del  'perl_cfile'\n");
     fprintf(fp,"$ perl_exit 'perl_status'\n");
@@ -2328,7 +2327,11 @@ safe_popen(pTHX_ char *cmd, char *in_mode, int *psts)
 {
     static int handler_set_up = FALSE;
     unsigned long int sts, flags = CLI$M_NOWAIT;
-    unsigned int table = LIB$K_CLI_GLOBAL_SYM;
+    /* The use of a GLOBAL table (as was done previously) rendered
+     * Perl's qx() or `` unusable from a C<$ SET SYMBOL/SCOPE=NOGLOBAL> DCL
+     * environment.  Hence we've switched to LOCAL symbol table.
+     */
+    unsigned int table = LIB$K_CLI_LOCAL_SYM;
     int j, wait = 0;
     char *p, mode[10], symbol[MAX_DCL_SYMBOL+1], *vmspipe;
     char in[512], out[512], err[512], mbx[512];