Resync with mainline prior to post-5.6.0 updates

p4raw-id: //depot/vmsperl@6111

6 files changed, 113 insertions, 12 deletions

diff --git a/vms/ext/Stdio/Stdio.pm b/vms/ext/Stdio/Stdio.pm
index d485e0e159..b51f2c9f15 100644
--- a/vms/ext/Stdio/Stdio.pm
+++ b/vms/ext/Stdio/Stdio.pm
@@ -637,6 +637,6 @@ it encounters an error.
 =head1 REVISION
 
 This document was last revised on 13-Oct-1998, for Perl 5.004, 5.005, and
-5.006.
+5.6.0.
 
 =cut
diff --git a/vms/ext/vmsish.pm b/vms/ext/vmsish.pm
index a0e6e3cc21..5d738d0a82 100644
--- a/vms/ext/vmsish.pm
+++ b/vms/ext/vmsish.pm
@@ -20,7 +20,7 @@ vmsish - Perl pragma to control VMS-specific language features
 
 If no import list is supplied, all possible VMS-specific features are
 assumed.  Currently, there are four VMS-specific features available:
-'status' (a.k.a '$?'), 'exit', 'time' and 'messages' (a.k.a 'message').
+'status' (a.k.a '$?'), 'exit', 'time' and 'hushed'.
 
 =over 6
 
@@ -44,8 +44,13 @@ default of Universal Time (a.k.a Greenwich Mean Time, or GMT).
 
 =item C<vmsish hushed>
 
-This supresses printing of VMS status messages to SYS$OUTPUT and SYS$ERROR
-if Perl terminates with an error status.
+This suppresses printing of VMS status messages to SYS$OUTPUT and SYS$ERROR
+if Perl terminates with an error status.  This primarily effects error
+exits from things like Perl compiler errors or "standard Perl" runtime errors,
+where text error messages are also generated by Perl.
+
+The error exits from inside the core are generally more serious, and are
+not supressed.
 
 =back
 
diff --git a/vms/perlvms.pod b/vms/perlvms.pod
index 3883233c28..e6d13f3081 100644
--- a/vms/perlvms.pod
+++ b/vms/perlvms.pod
@@ -569,7 +569,7 @@ invoked using C<MCR> or a text file which should be passed to DCL
 as a command procedure.
 
 If LIST consists of the empty string, C<system> spawns an
-interactive DCL subprocess, in the same fashion as typiing
+interactive DCL subprocess, in the same fashion as typing
 B<SPAWN> at the DCL prompt.
 
 Perl waits for the subprocess to complete before continuing
@@ -597,7 +597,7 @@ not appear separately in the "child time" field, depending on
 whether L<times> keeps track of subprocesses separately.  Note
 especially that the VAXCRTL (at least) keeps track only of
 subprocesses spawned using L<fork> and L<exec>; it will not
-accumulate the times of suprocesses spawned via pipes, L<system>,
+accumulate the times of subprocesses spawned via pipes, L<system>,
 or backticks.
 
 =item unlink LIST
@@ -661,7 +661,7 @@ The FLAGS argument is ignored in all cases.
 
 The following VMS-specific information applies to the indicated
 "special" Perl variables, in addition to the general information
-in L<perlvar>.  Where there is a conflict, this infrmation
+in L<perlvar>.  Where there is a conflict, this information
 takes precedence.
 
 =over 4
@@ -858,9 +858,9 @@ it's equivalent to calling fflush() and fsync() from C.
 
 =head2 SDBM_File
 
-SDBM_File works peroperly on VMS. It has, however, one minor
-difference. The database directory file created has a L<.sdbm_dir>
-extension rather than a L<.dir> extension. L<.dir> files are VMS filesystem
+SDBM_File works properly on VMS. It has, however, one minor
+difference. The database directory file created has a F<.sdbm_dir>
+extension rather than a F<.dir> extension. F<.dir> files are VMS filesystem
 directory files, and using them for other purposes could cause unacceptable
 problems.
 
diff --git a/vms/subconfigure.com b/vms/subconfigure.com
index b16eb53c02..4aea63bb62 100644
--- a/vms/subconfigure.com
+++ b/vms/subconfigure.com
@@ -69,14 +69,18 @@ $ myname = myhostname
 $ IF myname .EQS. "" THEN myname = F$TRNLNM("SYS$NODE")
 $!
 $! ##ADD NEW CONSTANTS HERE##
+$ perl_d_isnan= = "define"
+$ perl_sizesize = "4"
 $ perl_shmattype = ""
 $ perl_mmaptype = ""
 $ perl_gidformat = "lu"
 $ perl_gidsize = "4"
+$ perl_gidsign = "1"
 $ perl_groupstype = "Gid_t"
 $ perl_stdio_stream_array = ""
 $ perl_uidformat = "lu"
 $ perl_uidsize = "4"
+$ perl_uidsign = "1"
 $ perl_d_getcwd = "undef"
 $ perl_d_nv_preserves_uv = "define"
 $ perl_d_fs_data_s = "undef"
@@ -397,6 +401,8 @@ $ perl_lseektype="int"
 $ perl_i_values="undef"
 $ perl_malloctype="void *"
 $ perl_freetype="void"
+$ perl_d_perl_otherlibdirs="undef"
+$ perl_otherlibdirs=""
 $ IF mymalloc
 $ THEN
 $ perl_d_mymalloc="define"
@@ -483,6 +489,9 @@ $   perl_d_quad = "define"
 $   perl_quadtype = "long long"
 $   perl_uquadtype = "unsigned long long"
 $   perl_quadkind  = "QUAD_IS_LONG_LONG"
+$   perl_d_frexpl = "define"
+$   perl_d_isnanl = "define"
+$   perl_d_modfl = "define"
 $ ELSE
 $   perl_d_PRIfldbl = "undef"
 $   perl_d_PRIgldbl = "undef"
@@ -500,6 +509,9 @@ $   perl_d_quad = "undef"
 $   perl_quadtype = "long"
 $   perl_uquadtype = "unsigned long"
 $   perl_quadkind  = "QUAD_IS_LONG"
+$   perl_d_frexpl = "undef"
+$   perl_d_isnanl = "undef"
+$   perl_d_modfl = "undef"
 $ ENDIF
 $!
 $! Now some that we build up
@@ -3205,6 +3217,49 @@ $
 $ perl_ptrsize=line
 $ WRITE_RESULT "ptrsize is ''perl_ptrsize'"
 $!
+$! Check for size_t size
+$!
+$ OS
+$ WS "#ifdef __DECC
+$ WS "#include <stdlib.h>
+$ WS "#endif
+$ WS "#include <stdio.h>
+$ WS "int main()
+$ WS "{"
+$ WS "int foo;
+$ WS "foo = sizeof(size_t);
+$ WS "printf(""%d\n"", foo);
+$ WS "exit(0);
+$ WS "}"
+$ CS
+$   DEFINE SYS$ERROR _NLA0:
+$   DEFINE SYS$OUTPUT _NLA0:
+$   ON ERROR THEN CONTINUE
+$   ON WARNING THEN CONTINUE
+$   'Checkcc' temp.c
+$   If Needs_Opt
+$   THEN
+$     link temp.obj,temp.opt/opt
+$   else
+$     link temp.obj
+$   endif
+$   OPEN/WRITE TEMPOUT [-.uu]tempout.lis
+$   DEASSIGN SYS$OUTPUT
+$   DEASSIGN SYS$ERROR
+$   DEFINE SYS$ERROR TEMPOUT
+$   DEFINE SYS$OUTPUT TEMPOUT
+$   mcr []temp
+$   CLOSE TEMPOUT
+$   DEASSIGN SYS$OUTPUT
+$   DEASSIGN SYS$ERROR
+$   OPEN/READ TEMPOUT [-.uu]tempout.lis
+$   READ TEMPOUT line
+$   CLOSE TEMPOUT
+$ DELETE/NOLOG [-.uu]tempout.lis;
+$ 
+$ perl_sizesize=line
+$ WRITE_RESULT "sizesize is ''perl_sizesize'"
+$!
 $! Check rand48 and its ilk
 $!
 $ OS
@@ -3767,6 +3822,8 @@ $ WC "d_mkdir='" + perl_d_mkdir + "'"
 $ WC "d_msg='" + perl_d_msg + "'"
 $ WC "d_open3='" + perl_d_open3 + "'"
 $ WC "d_poll='" + perl_d_poll + "'"
+$ WC "d_perl_otherlibdirs='" + perl_d_perl_otherlibdirs + "'"
+$ WC "otherlibdirs='" + perl_otherlibdirs + "'"
 $ WC "d_readdir='" + perl_d_readdir + "'"
 $ WC "d_seekdir='" + perl_d_seekdir + "'"
 $ WC "d_telldir='" + perl_d_telldir + "'"
@@ -3963,13 +4020,21 @@ $ WC "libs='" + perl_libs + "'"
 $ WC "libc='" + perl_libc + "'"
 $ WC "xs_apiversion='" + version + "'"
 $ WC "pm_apiversion='" + version + "'"
+$ WC "version='" + version + "'"
+$ WC "revision='" + revision + "'"
+$ WC "patchlevel='" + patchlevel + "'"
+$ WC "subversion='" + subversion + "'"
+$ WC "PERL_VERSION='" + patchlevel + "'"
+$ WC "PERL_SUBVERSION='" + subversion + "'"
 $ WC "pager='" + perl_pager + "'"
 $ WC "uidtype='" + perl_uidtype + "'"
 $ WC "uidformat='" + perl_uidformat + "'"
 $ WC "uidsize='" + perl_uidsize + "'"
+$ WC "uidsign='" + perl_uidsign + "'"
 $ WC "gidtype='" + perl_gidtype + "'"
 $ WC "gidformat='" + perl_gidformat + "'"
 $ WC "gidsize='" + perl_gidsize + "'"
+$ WC "gidsign='" + perl_gidsign + "'"
 $ WC "usethreads='" + perl_usethreads + "'"
 $ WC "d_pthread_yield='" + perl_d_pthread_yield + "'"
 $ WC "d_pthreads_created_joinable='" + perl_d_pthreads_created_joinable + "'"
@@ -4195,6 +4260,11 @@ $ WC "uvuformat='" + perl_uvuformat + "'"
 $ WC "uvoformat='" + perl_uvoformat + "'"
 $ WC "uvxformat='" + perl_uvxformat + "'"
 $ WC "d_vms_case_sensitive_symbols='" + d_vms_be_case_sensitive + "'"
+$ WC "sizesize='" + perl_sizesize + "'"
+$ WC "d_frexpl='" + perl_d_frexpl + "'"
+$ WC "d_isnan='" + perl_d_isnan + "'"
+$ WC "d_isnanl='" + perl_d_isnanl + "'"
+$ WC "d_modfl='" + perl_d_modfl + "'"
 $!
 $! ##WRITE NEW CONSTANTS HERE##
 $!
diff --git a/vms/vms.c b/vms/vms.c
index c18ca49879..c50d828e7c 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -911,6 +911,30 @@ my_mkdir(char *dir, Mode_t mode)
 }  /* end of my_mkdir */
 /*}}}*/
 
+/*{{{int my_chdir(char *)*/
+int
+my_chdir(char *dir)
+{
+  STRLEN dirlen = strlen(dir);
+  dTHX;
+
+  /* zero length string sometimes gives ACCVIO */
+  if (dirlen == 0) return -1;
+
+  /* some versions of CRTL chdir() doesn't tolerate trailing /, since
+   * that implies
+   * null file name/type.  However, it's commonplace under Unix,
+   * so we'll allow it for a gain in portability.
+   */
+  if (dir[dirlen-1] == '/') {
+    char *newdir = savepvn(dir,dirlen-1);
+    int ret = chdir(newdir);
+    Safefree(newdir);
+    return ret;
+  }
+  else return chdir(dir);
+}  /* end of my_chdir */
+/*}}}*/
 
 static void
 create_mbx(unsigned short int *chan, struct dsc$descriptor_s *namdsc)
diff --git a/vms/vmsish.h b/vms/vmsish.h
index e460241ba1..16d119dd06 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -109,6 +109,7 @@
 #define do_rmdir		Perl_do_rmdir
 #define kill_file		Perl_kill_file
 #define my_mkdir		Perl_my_mkdir
+#define my_chdir		Perl_my_chdir
 #define my_utime		Perl_my_utime
 #define rmsexpand	Perl_rmsexpand
 #define rmsexpand_ts	Perl_rmsexpand_ts
@@ -232,7 +233,6 @@
 #define TEST_VMSISH(h)	(PL_curcop->op_private & ((h) >> HINT_V_VMSISH))
 #define VMSISH_HUSHED	TEST_VMSISH(HINT_M_VMSISH_HUSHED)
 #define VMSISH_STATUS	TEST_VMSISH(HINT_M_VMSISH_STATUS)
-#define VMSISH_EXIT	TEST_VMSISH(HINT_M_VMSISH_EXIT)
 #define VMSISH_TIME	TEST_VMSISH(HINT_M_VMSISH_TIME)
 
 /* Flags for vmstrnenv() */
@@ -449,8 +449,9 @@ struct utimbuf {
 /* Ditto for sys$hash_passwrod() . . . */
 #define crypt  my_crypt
 
-/* Tweak arg to mkdir first, so we can tolerate trailing /. */
+/* Tweak arg to mkdir & chdir first, so we can tolerate trailing /. */
 #define Mkdir(dir,mode) my_mkdir((dir),(mode))
+#define Chdir(dir) my_chdir((dir))
 
 /* Use our own stat() clones, which handle Unix-style directory names */
 #define Stat(name,bufptr) flex_stat(name,bufptr)
@@ -640,6 +641,7 @@ char *	my_gconvert (double, int, int, char *);
 int	do_rmdir (char *);
 int	kill_file (char *);
 int	my_mkdir (char *, Mode_t);
+int	my_chdir (char *);
 int	my_utime (char *, struct utimbuf *);
 char *	rmsexpand (char *, char *, char *, unsigned);
 char *	rmsexpand_ts (char *, char *, char *, unsigned);