VMS patches to 5.003_05

5 files changed, 126 insertions, 57 deletions

diff --git a/vms/config.vms b/vms/config.vms
index 59407ceca4..b9e51c7c25 100644
--- a/vms/config.vms
+++ b/vms/config.vms
@@ -76,7 +76,7 @@
  * when Perl is built.  Please do not change it by hand; make
  * any changes to FndVers.Com instead.
  */
-#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00304"  /**/
+#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00305"  /**/
 #define ARCHLIB ARCHLIB_EXP	/*config-skip*/
 
 /* CPPSTDIN:
@@ -220,18 +220,6 @@
  */
 #undef HAS_UNAME		/**/
 
-/* HAS_GETPGRP:
- *	This symbol, if defined, indicates that the getpgrp routine is
- *	available to get the current process group.
- */
-#undef HAS_GETPGRP		/**/
-
-/* HAS_GETPGRP2:
- *	This symbol, if defined, indicates that the getpgrp2() (as in DG/UX)
- *	routine is available to get the current process group.
- */
-#undef HAS_GETPGRP2		/**/
-
 /* HAS_GETPRIORITY:
  *	This symbol, if defined, indicates that the getpriority routine is
  *	available to get a process's priority.
@@ -389,18 +377,6 @@
  */
 #undef HAS_SETLOCALE	/**/
 
-/* HAS_SETPGID:
- *	This symbol, if defined, indicates that the setpgid routine is
- *	available to set process group ID.
- */
-#undef HAS_SETPGID	/**/
-
-/* HAS_SETPGRP2:
- *	This symbol, if defined, indicates that the setpgrp2() (as in DG/UX)
- *	routine is available to set the current process group.
- */
-#undef HAS_SETPGRP2		/**/
-
 /* HAS_SETPRIORITY:
  *	This symbol, if defined, indicates that the setpriority routine is
  *	available to set a process's priority.
@@ -499,36 +475,40 @@
  *	to determine the number of bytes in the buffer.  USE_STDIO_BASE
  *	will never be defined unless USE_STDIO_PTR is.
  */
-/* VMS:
- * Regular FILE * are pretty close to meeting these criteria, but socket
- * I/O uses a summy FILE *, and Perl doesn't distinguish between socket
- * and non-socket filehandles.
+/* STDIO_PTR_LVALUE:
+ *	This symbol is defined if the FILE_ptr macro can be used as an
+ *	lvalue.
+ */
+/* STDIO_CNT_LVALUE:
+ *	This symbol is defined if the FILE_cnt macro can be used as an
+ *	lvalue.
  */
-#define USE_STDIO_PTR 	/**/
-#define USE_STDIO_BASE 	/**/
+#ifdef __DECC
+#  define USE_STDIO_PTR		/*config-skip*/
+#  define USE_STDIO_BASE	/*config-skip*/
+#  define STDIO_PTR_LVALUE	/*config-skip*/
+#  define STDIO_CNT_LVALUE	/*config-skip*/
+#else
+#  undef USE_STDIO_PTR		/*config-skip*/
+#  undef USE_STDIO_BASE		/*config-skip*/
+#  undef STDIO_PTR_LVALUE	/*config-skip*/
+#  undef STDIO_CNT_LVALUE	/*config-skip*/
+#endif
 
 /* FILE_ptr:
  *	This macro is used to access the _ptr field (or equivalent) of the
  *	FILE structure pointed to by its argument. This macro will always be
  *	defined if USE_STDIO_PTR is defined.
  */
-/* STDIO_PTR_LVALUE:
- *	This symbol is defined if the FILE_ptr macro can be used as an
- *	lvalue.
- */
 /* FILE_cnt:
  *	This macro is used to access the _cnt field (or equivalent) of the
  *	FILE structure pointed to by its argument. This macro will always be
  *	defined if USE_STDIO_PTR is defined.
  */
-/* STDIO_CNT_LVALUE:
- *	This symbol is defined if the FILE_cnt macro can be used as an
- *	lvalue.
- */
-#define FILE_ptr(fp)	((*fp)->_ptr)
-#define STDIO_PTR_LVALUE
-#define FILE_cnt(fp)	((*fp)->_cnt)
-#define STDIO_CNT_LVALUE
+#ifdef USE_STDIO_PTR
+#  define FILE_ptr(fp)	((*fp)->_ptr)
+#  define FILE_cnt(fp)	((*fp)->_cnt)
+#endif
 
 /* FILE_filbuf:
  *	This macro is used to access the internal stdio _filbuf function
@@ -551,8 +531,10 @@
  *	structure pointed to its argument. This macro will always be defined
  *	if USE_STDIO_BASE is defined.
  */
-#define FILE_base(fp)	((*fp)->_base)
-#define FILE_bufsiz(fp)	((*fp)->_cnt + (*fp)->_ptr - (*fp)->_base)
+#ifdef USE_STDIO_BASE
+#  define FILE_base(fp)	((*fp)->_base)
+#  define FILE_bufsiz(fp)	((*fp)->_cnt + (*fp)->_ptr - (*fp)->_base)
+#endif
 
 /* USE_STRUCT_COPY:
  *	This symbol, if defined, indicates that this C compiler knows how
@@ -1536,14 +1518,32 @@
  *	This symbol, if defined, indicates that the setpgrp routine is
  *	available to set the current process group.
  */
+/* USE_BSD_SETPGRP:
+ *	This symbol, if defined, indicates that setpgrp needs two
+ *	arguments whereas USG one needs none.  See also HAS_SETPGID
+ *	for a POSIX interface.
+ */
 /* USE_BSDPGRP:
  *	This symbol, if defined, indicates that the BSD notion of process
  *	group is to be used. For instance, you have to say setpgrp(pid, pgrp)
  *	instead of the USG setpgrp().
  */
 #undef HAS_SETPGRP		/**/
+#undef USE_BSD_SETPGRP	/**/
 #undef USE_BSDPGRP		/**/
 
+/* HAS_SETPGID:
+ *	This symbol, if defined, indicates that the setpgid routine is
+ *	available to set process group ID.
+ */
+#undef HAS_SETPGID	/**/
+
+/* HAS_SETPGRP2:
+ *	This symbol, if defined, indicates that the setpgrp2() (as in DG/UX)
+ *	routine is available to set the current process group.
+ */
+#undef HAS_SETPGRP2		/**/
+
 /* HAS_SYSCONF:
  *	This symbol, if defined, indicates that sysconf() is available
  *	to determine system related limits and options.
@@ -1567,6 +1567,30 @@
  */
 #define Gconvert(x,n,t,b) my_gconvert(x,n,t,b)
 
+/* HAS_GETPGID:
+ *	This symbol, if defined, indicates to the C program that 
+ *	the getpgid(pid) function is available to get the
+ *	process group id.
+ */
+#undef HAS_GETPGID		/**/
+
+/* HAS_GETPGRP:
+ *	This symbol, if defined, indicates that the getpgrp routine is
+ *	available to get the current process group.
+ */
+/* USE_BSD_GETPGRP:
+ *	This symbol, if defined, indicates that getpgrp needs one
+ *	arguments whereas USG one needs none.
+ */
+#undef HAS_GETPGRP		/**/
+#undef USE_BSD_GETPGRP	/**/
+
+/* HAS_GETPGRP2:
+ *	This symbol, if defined, indicates that the getpgrp2() (as in DG/UX)
+ *	routine is available to get the current process group.
+ */
+#undef HAS_GETPGRP2		/**/
+
 /* USE_SFIO:
  *	This symbol, if defined, indicates that sfio should
  *	be used.
diff --git a/vms/descrip.mms b/vms/descrip.mms
index ad26b1d33d..b628c2c265 100644
--- a/vms/descrip.mms
+++ b/vms/descrip.mms
@@ -65,7 +65,7 @@ OBJVAL = $(MMS$TARGET_NAME)$(O)
 .endif
 
 # Updated by fndvers.com -- do not edit by hand
-PERL_VERSION = 5_00304#
+PERL_VERSION = 5_00305#
 
 
 ARCHDIR =  [.lib.$(ARCH).$(PERL_VERSION)]
diff --git a/vms/genconfig.pl b/vms/genconfig.pl
index a1df9c1362..17ff2041fa 100644
--- a/vms/genconfig.pl
+++ b/vms/genconfig.pl
@@ -6,16 +6,18 @@
 # that went into your perl binary.  In addition, values which change from run
 # to run may be supplied on the command line as key=val pairs.
 #
-# Rev. 23-Apr-1996  Charles Bailey  bailey@genetics.upenn.edu
+# Rev.  2-Oct-1996  Charles Bailey  bailey@genetics.upenn.edu
 #
 
 #==== Locations of installed Perl components
 $prefix='perl_root';
 $builddir="$prefix:[000000]";
 $installbin="$prefix:[000000]";
+$installscript="$prefix:[000000]";
 $installman1dir="$prefix:[man.man1]";
 $installman3dir="$prefix:[man.man3]";
 $installprivlib="$prefix:[lib]";
+$installsitelib="$prefix:[lib.site_perl]";
 
 unshift(@INC,'lib');  # In case someone didn't define Perl_Root
                       # before the build
@@ -50,6 +52,8 @@ $archsufx = `Write Sys\$Output F\$GetSyi("HW_MODEL")` > 1024 ? 'AXP' : 'VAX';
 ($vers = $]) =~ tr/./_/;
 $installarchlib = VMS::Filespec::vmspath($installprivlib);
 $installarchlib =~ s#\]#.VMS_$archsufx.$vers\]#;
+$installsitearch = VMS::Filespec::vmspath($installsitelib);
+$installsitearch =~ s#\]#.VMS_$archsufx\]#;
 ($osvers = `Write Sys\$Output F\$GetSyi("VERSION")`) =~ s/^V?(\S+)\s*\n?$/$1/;
 
 print OUT <<EndOfIntro;
@@ -91,10 +95,13 @@ osvers='$osvers'
 prefix='$prefix'
 builddir='$builddir'
 installbin='$installbin'
+installscript='$installscript'
 installman1dir='$installman1dir'
 installman3dir='$installman3dir'
 installprivlib='$installprivlib'
 installarchlib='$installarchlib'
+installsitelib='$installsitelib'
+installsitearch='$installsitearch'
 EndOfIntro
 
 foreach (@ARGV) {
@@ -146,6 +153,19 @@ foreach (@ARGV) {
     print OUT "d_select=",$dosock ? "'define'\n" : "'undef'\n";
     print OUT "i_niin=",$dosock ? "'define'\n" : "'undef'\n";
     print OUT "i_neterrno=",$dosock ? "'define'\n" : "'undef'\n";
+
+    if ($cctype eq 'decc') {
+      print OUT "d_stdstdio='define'\n";
+      print OUT "d_stdio_ptr_lval='define'\n";
+      print OUT "d_stdio_cnt_lval='define'\n";
+      print OUT "d_stdiobase='define'\n";
+    }
+    else {
+      print OUT "d_stdstdio='undef'\n";
+      print OUT "d_stdio_ptr_lval='undef'\n";
+      print OUT "d_stdio_cnt_lval='undef'\n";
+      print OUT "d_stdiobase='undef'\n";
+    }
     next;
   }
   elsif ($key eq 'exe_ext') { 
diff --git a/vms/perlvms.pod b/vms/perlvms.pod
index 7d441cb4e2..f15bd77cfe 100644
--- a/vms/perlvms.pod
+++ b/vms/perlvms.pod
@@ -261,6 +261,15 @@ to pass uppercase switches to Perl, you need to enclose
 them in double-quotes on the command line, since the CRTL
 downcases all unquoted strings.
 
+=item -i
+
+If the C<-i> switch is present but no extension for a backup
+copy is given, then inplace editing creates a new version of
+a file; the existing copy is not deleted.  (Note that if
+an extension is given, an existing file is renamed to the backup
+file, as is the case under other operating systems, so it does
+not remain as a previous version under the original filename.)
+
 =item -S
 
 If the C<-S> switch is present I<and> the script name does
@@ -634,12 +643,19 @@ replace the logical name just deleted.  It is not possible
 at present to define a search list logical name via %ENV.
 
 At present, the first time you iterate over %ENV using
-C<keys>, C<values>, or C<each>, you will incur a time
-penalty as all logical names are read, in order to fully
-populate %ENV.  Subsequent iterations will not reread
-logical names, so they won't be as slow, but they also
-won't reflect any changes to logical name tables caused
-by other programs.
+C<keys>, or C<values>,  you will incur a time penalty as all
+logical names are read, in order to fully populate %ENV.
+Subsequent iterations will not reread logical names, so they
+won't be as slow, but they also won't reflect any changes
+to logical name tables caused by other programs.  The C<each>
+operator is special: it returns each element I<already> in
+%ENV, but doesn't go out and look for more.   Therefore, if
+you've previously used C<keys> or C<values>, you'll see all
+the logical names visible to your process, and if not, you'll
+see only the names you've looked up so far.  (This is a
+consequence of the way C<each> is implemented now, and it
+may change in the future, so it wouldn't be a good idea
+to rely on it too much.)
 
 In all operations on %ENV, the key string is treated as if it 
 were entirely uppercase, regardless of the case actually 
diff --git a/vms/vms.c b/vms/vms.c
index f59818245f..d76977fa38 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -121,6 +121,7 @@ my_getenv(char *lnm)
     static char __my_getenv_eqv[LNM$C_NAMLENGTH+1];
     char uplnm[LNM$C_NAMLENGTH], *cp1, *cp2;
     unsigned long int idx = 0;
+    int trnsuccess;
 
     for (cp1 = lnm, cp2= uplnm; *cp1; cp1++, cp2++) *cp2 = _toupper(*cp1);
     *cp2 = '\0';
@@ -133,9 +134,10 @@ my_getenv(char *lnm)
         *cp2 = '\0';
         idx = strtoul(cp2+1,NULL,0);
       }
-      if (my_trnlnm(uplnm,__my_getenv_eqv,idx)) {
-        return __my_getenv_eqv;
-      }
+      trnsuccess = my_trnlnm(uplnm,__my_getenv_eqv,idx);
+      /* If we had a translation index, we're only interested in lnms */
+      if (!trnsuccess && cp2 != NULL) return Nullch;
+      if (trnsuccess) return __my_getenv_eqv;
       else {
         unsigned long int retsts;
         struct dsc$descriptor_s symdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0},
@@ -204,7 +206,14 @@ prime_env_iter(void)
     for (end = ++start; *end && *end != '"'; end++) ;
     if (*end) *end = '\0';
     else end = Nullch;
-    if ((eqvlen = my_trnlnm(start,eqv,0)) == 0) _ckvmssts(vaxc$errno);
+    if ((eqvlen = my_trnlnm(start,eqv,0)) == 0) {
+      if (vaxc$errno == SS$_NOLOGNAM || vaxc$errno == SS$_IVLOGNAM) {
+        if (dowarn)
+          warn("Ill-formed logical name |%s| in prime_env_iter",start);
+        continue;
+      }
+      else _ckvmssts(vaxc$errno);
+    }
     else {
       eqvsv = newSVpv(eqv,eqvlen);
       hv_store(envhv,start,(end ? end - start : strlen(start)),eqvsv,0);