[inseparable changes from patch from perl5.003_25 to perl5.003_26]perl-5.003_26

 CORE LANGUAGE CHANGES

Subject: Make \r in script an error (per Larry)
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldiag.pod toke.c

 CORE PORTABILITY

Subject: VMS patches post _25
Date: Fri, 07 Feb 1997 01:56:12 -0500 (EST)
From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
Files: Porting/Glossary lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_VMS.pm lib/ExtUtils/xsubpp perl.c vms/Makefile vms/config.vms vms/descrip.mms vms/genconfig.pl vms/perlvms.pod vms/vms.c vms/vmsish.h x2p/a2p.c

    private-msgid: <01IF48W3P39W0050BD@hmivax.humgen.upenn.edu>

 LIBRARY AND EXTENSIONS

Subject: Make diagnostics module strip formatting directives
From: Chip Salzenberg <chip@perl.com>
Files: lib/diagnostics.pm pod/perldiag.pod

 OTHER CORE CHANGES

Subject: Fix (yet another) Tk closure problem
From: Chip Salzenberg <chip@perl.com>
Files: op.c perl.c pp_ctl.c

Subject: Fix value of C<foreach>
From: Chip Salzenberg <chip@perl.com>
Files: cop.h pp_ctl.c

Subject: Refine 'runaway string' heuristic
From: Chip Salzenberg <chip@perl.com>
Files: toke.c

Subject: Fix core dump on C<print "a", last> in eval
From: Chip Salzenberg <chip@perl.com>
Files: pp_ctl.c

7 files changed, 86 insertions, 23 deletions

diff --git a/vms/Makefile b/vms/Makefile
index d5194b41eb..d5e6553c59 100644
--- a/vms/Makefile
+++ b/vms/Makefile
@@ -32,7 +32,7 @@ ARCH = VMS_VAX
 OBJVAL = $@
 
 # Updated by fndvers.com -- do not edit by hand
-PERL_VERSION = 5_00325#
+PERL_VERSION = 5_00326#
 
 
 ARCHDIR =  [.lib.$(ARCH).$(PERL_VERSION)]
@@ -418,6 +418,13 @@ IO : [.lib]IO.pm [.lib.IO]File.pm [.lib.IO]Handle.pm [.lib.IO]Pipe.pm [.lib.IO]S
 	@ If f$$Search("a2p$(O)").nes."" Then Rename/NoLog a2p$(O),hash$(O),str$(O),util$(O),walk$(O) [.x2p]
 	Link $(LINKFLAGS) /Exe=$@ $(MMS$SOURCE_LIST) $(CRTLOPTS)
 
+# Accomodate buggy cpp in some version of DECC, which chokes on illegal
+# filespec "y.tab.c"
+[.x2p]a2p$(O) : [.x2p]a2p.c $(MINIPERL_EXE)
+	$(MINIPERL) -pe "s/^#line\s+(\d+)\s+\Q""y.tab.c""/#line $1 ""y_tab.c""/;" [.x2p]a2p.c >$*_vms.c
+	$(CC) $(CFLAGS) /Object=$@ $*_vms.c
+	Delete/Log/NoConfirm $*_vms.c;
+
 [.lib.pod]pod2html.com : [.pod]pod2html.PL $(ARCHDIR)Config.pm
 	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
 	$(MINIPERL) [.pod]pod2html.PL
diff --git a/vms/config.vms b/vms/config.vms
index 97d5c960b8..41f0fa56f8 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_00325"  /**/
+#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00326"  /**/
 #define ARCHLIB ARCHLIB_EXP	/*config-skip*/
 
 /* ARCHNAME:
@@ -1263,7 +1263,17 @@
  *	This symbol contains the size of an int, so that the C preprocessor
  *	can make decisions based on it.
  */
+/* LONGSIZE:
+ *	This symbol contains the value of sizeof(long) so that the C
+ *	preprocessor can make decisions based on it.
+ */
+/* SHORTSIZE:
+ *	This symbol contains the value of sizeof(short) so that the C
+ *	preprocessor can make decisions based on it.
+ */
 #define INTSIZE 4		/**/
+#define LONGSIZE 4		/**/
+#define SHORTSIZE 2		/**/
 
 /* Off_t:
  *	This symbol holds the type used to declare offsets in the kernel.
diff --git a/vms/descrip.mms b/vms/descrip.mms
index 36386ef846..c15db049e6 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_00325#
+PERL_VERSION = 5_00326#
 
 
 ARCHDIR =  [.lib.$(ARCH).$(PERL_VERSION)]
@@ -539,6 +539,13 @@ IO : [.lib]IO.pm [.lib.IO]File.pm [.lib.IO]Handle.pm [.lib.IO]Pipe.pm [.lib.IO]S
 	@ If F$Search("a2p$(O)").nes."" Then Rename/NoLog a2p$(O),hash$(O),str$(O),util$(O),walk$(O) [.x2p]
 	Link $(LINKFLAGS) /Exe=$(MMS$TARGET) $(MMS$SOURCE_LIST) $(CRTLOPTS)
 
+# Accomodate buggy cpp in some version of DECC, which chokes on illegal
+# filespec "y.tab.c"
+[.x2p]a2p$(O) : [.x2p]a2p.c $(MINIPERL_EXE)
+	$(MINIPERL) -pe "s/^#line\s+(\d+)\s+\Q""y.tab.c""/#line $1 ""y_tab.c""/;" $(MMS$SOURCE) >$(MMS$TARGET_NAME)_vms.c
+	$(CC) $(CFLAGS) /Object=$(MMS$TARGET) $(MMS$TARGET_NAME)_vms.c
+	Delete/Log/NoConfirm $(MMS$TARGET_NAME)_vms.c;
+
 [.lib.pod]pod2html.com : [.pod]pod2html.PL $(ARCHDIR)Config.pm
 	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
 	$(MINIPERL) $(MMS$SOURCE)
diff --git a/vms/genconfig.pl b/vms/genconfig.pl
index 3680147e47..22bf016b03 100644
--- a/vms/genconfig.pl
+++ b/vms/genconfig.pl
@@ -104,7 +104,7 @@ installsitelib='$installsitelib'
 installsitearch='$installsitearch'
 path_sep='|'
 startperl='\$ perl 'f\$env("procedure")' 'p1' 'p2' 'p3' 'p4' 'p5' 'p6' 'p7' 'p8' !
-$ exit++ + ++$status != 0 and $exit = $status = undef;
+\$ exit++ + ++\$status != 0 and \$exit = \$status = undef;'
 EndOfIntro
 
 foreach (@ARGV) {
diff --git a/vms/perlvms.pod b/vms/perlvms.pod
index e065b08baa..830ff613d5 100644
--- a/vms/perlvms.pod
+++ b/vms/perlvms.pod
@@ -300,7 +300,7 @@ As of the time this document was last revised, the following
 Perl functions were implemented in the VMS port of Perl 
 (functions marked with * are discussed in more detail below):
 
-    file tests*, abs, alarm, atan, binmode*, bless,
+    file tests*, abs, alarm, atan, backticks*, binmode*, bless,
     caller, chdir, chmod, chown, chomp, chop, chr,
     close, closedir, cos, crypt*, defined, delete,
     die, do, dump*, each, endpwent, eof, eval, exec*,
@@ -310,7 +310,7 @@ Perl functions were implemented in the VMS port of Perl
     last, lc, lcfirst, length, local, localtime, log, m//,
     map, mkdir, my, next, no, oct, open, opendir, ord, pack,
     pipe, pop, pos, print, printf, push, q//, qq//, qw//,
-    qx//, quotemeta, rand, read, readdir, redo, ref, rename,
+    qx//*, quotemeta, rand, read, readdir, redo, ref, rename,
     require, reset, return, reverse, rewinddir, rindex,
     rmdir, s///, scalar, seek, seekdir, select(internal),
     select (system call)*, setpwent, shift, sin, sleep,
@@ -375,6 +375,13 @@ only, and then manually check the appropriate bits, as defined by
 your C compiler's F<stat.h>, in the mode value it returns, if you
 need an approximation of the file's protections.
 
+=item backticks
+
+Backticks create a subprocess, and pass the enclosed string
+to it for execution as a DCL command.  Since the subprocess is
+created directly via C<lib$spawn()>, any valid DCL command string
+may be specified.
+
 =item binmode FILEHANDLE
 
 The C<binmode> operator will attempt to insure that no translation
@@ -509,6 +516,10 @@ supervisor-mode images like DCL.)
 Also, negative signal values don't do anything special under
 VMS; they're just converted to the corresponding positive value.
 
+=item qx//
+
+See the entry on C<backticks> above.
+
 =item select (system call)
 
 If Perl was not built with socket support, the system call
@@ -537,7 +548,12 @@ valid DCL command string may be specified.  If LIST consists
 of the empty string, C<system> spawns an interactive DCL subprocess,
 in the same fashion as typiing B<SPAWN> at the DCL prompt.
 Perl waits for the subprocess to complete before continuing
-execution in the current process.
+execution in the current process.  As described in L<perlfunc>,
+the return value of C<system> is a fake "status" which follows
+POSIX semantics; see the description of C<$?> in this document
+for more detail.  The actual VMS exit status of the subprocess
+is available in C<$^S> (as long as you haven't used another Perl
+function that resets C<$?> and C<$^S> in the meantime).
 
 =item time
 
@@ -679,16 +695,6 @@ In all operations on %ENV, the key string is treated as if it
 were entirely uppercase, regardless of the case actually 
 specified in the Perl expression.
 
-=item $?
-
-Since VMS status values are 32 bits wide, the value of C<$?>
-is simply the final status value of the last subprocess to
-complete.  This differs from the behavior of C<$?> under Unix,
-and under VMS' POSIX environment, in that the low-order 8 bits
-of C<$?> do not specify whether the process terminated normally
-or due to a signal, and you do not need to shift C<$?> 8 bits
-to the right in order to find the process' exit status.
-
 =item $!
 
 The string value of C<$!> is that returned by the CRTL's
@@ -710,6 +716,30 @@ is the value of vaxc$errno, and its string value is the
 corresponding VMS message string, as retrieved by sys$getmsg().
 Setting C<$^E> sets vaxc$errno to the value specified.
 
+=item $?
+
+The "status value" returned in C<$?> is synthesized from the
+actual exit status of the subprocess in a way that approximates
+POSIX wait(5) semantics, in order to allow Perl programs to
+portably test for successful completion of subprocesses.  The
+low order 8 bits of C<$?> are always 0 under VMS, since the
+termination status of a process may or may not have been
+generated by an exception.  The next 8 bits are derived from
+severity portion of the subprocess' exit status: if the
+severity was success or informational, these bits are all 0;
+otherwise, they contain the severity value shifted left one bit.
+As a result, C<$?> will always be zero if the subprocess' exit
+status indicated successful completion, and non-zero if a
+warning or error occurred.  The actual VMS exit status may
+be found in C<$^S> (q.v.).
+
+=item $^S
+
+Under VMS, this is the 32-bit VMS status value returned by the
+last subprocess to complete.  Unlink C<$?>, no manipulation
+is done to make this look like a POSIX wait(5) value, so it
+may be treated as a normal VMS status value.
+
 =item $|
 
 Setting C<$|> for an I/O stream causes data to be flushed
diff --git a/vms/vms.c b/vms/vms.c
index a9060b49de..08570f0e25 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -801,9 +801,9 @@ I32 my_pclose(FILE *fp)
 }  /* end of my_pclose() */
 
 /* sort-of waitpid; use only with popen() */
-/*{{{unsigned long int waitpid(unsigned long int pid, int *statusp, int flags)*/
-unsigned long int
-waitpid(unsigned long int pid, int *statusp, int flags)
+/*{{{Pid_t my_waitpid(Pid_t pid, int *statusp, int flags)*/
+Pid_t
+my_waitpid(Pid_t pid, int *statusp, int flags)
 {
     struct pipe_details *info;
     
diff --git a/vms/vmsish.h b/vms/vmsish.h
index 10cdc08eda..ad3f1e10a5 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -13,7 +13,7 @@
 #include <libdef.h>  /* status codes for various places */
 #include <rmsdef.h>  /* at which errno and vaxc$errno are */
 #include <ssdef.h>   /* explicitly set in the perl source code */
-#include <stsdef.h>
+#include <stsdef.h>  /* bitmasks for exit status testing */
 
 /* Suppress compiler warnings from DECC for VMS-specific extensions:
  * GLOBALEXT, NOSHAREEXT, READONLYEXT: global[dr]ef declarations
@@ -56,6 +56,15 @@
 #  include <unistd.h> /* DECC has this; VAXC and gcc don't */
 #endif
 
+/* DECC introduces this routine in the RTL as of VMS 7.0; for now,
+ * we'll use ours, since it gives us the full VMS exit status. */
+#ifdef __PID_T
+#  define Pid_t pid_t
+#else
+#  define Pid_t unsigned int
+#endif
+#define waitpid my_waitpid
+
 /* Our own contribution to PerlShr's global symbols . . . */
 #ifdef EMBED
 #  define my_trnlnm		Perl_my_trnlnm
@@ -63,7 +72,7 @@
 #  define prime_env_iter	Perl_prime_env_iter
 #  define my_setenv		Perl_my_setenv
 #  define my_crypt		Perl_my_crypt
-#  define waitpid		Perl_waitpid
+#  define my_waitpid		Perl_my_waitpid
 #  define my_gconvert		Perl_my_gconvert
 #  define do_rmdir		Perl_do_rmdir
 #  define kill_file		Perl_kill_file
@@ -454,7 +463,7 @@ typedef char  __VMS_PROTOTYPES__;
 int	my_trnlnm _((char *, char *, unsigned long int));
 char *	my_getenv _((char *));
 char *	my_crypt _((const char *, const char *));
-unsigned long int	waitpid _((unsigned long int, int *, int));
+Pid_t	my_waitpid _((Pid_t, int *, int));
 char *	my_gconvert _((double, int, int, char *));
 int	do_rmdir _((char *));
 int	kill_file _((char *));