YA sync with mainline

p4raw-id: //depot/vmsperl@5435

11 files changed, 168 insertions, 27 deletions

diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL
index 8341b36130..0e0f79263d 100644
--- a/ext/DynaLoader/DynaLoader_pm.PL
+++ b/ext/DynaLoader/DynaLoader_pm.PL
@@ -28,7 +28,7 @@ package DynaLoader;
 #
 # Tim.Bunce@ig.co.uk, August 1994
 
-$VERSION = "1.03";	# avoid typo warning
+$VERSION = "1.04";	# avoid typo warning
 
 require AutoLoader;
 *AUTOLOAD = \&AutoLoader::AUTOLOAD;
@@ -411,7 +411,7 @@ sub dl_find_symbol_anywhere
 
 DynaLoader - Dynamically load C libraries into Perl code
 
-dl_error(), dl_findfile(), dl_expandspec(), dl_load_file(), dl_find_symbol(), dl_find_symbol_anywhere(), dl_undef_symbols(), dl_install_xsub(), dl_load_flags(), bootstrap() - routines used by DynaLoader modules
+dl_error(), dl_findfile(), dl_expandspec(), dl_load_file(), dl_unload_file(), dl_find_symbol(), dl_find_symbol_anywhere(), dl_undef_symbols(), dl_install_xsub(), dl_load_flags(), bootstrap() - routines used by DynaLoader modules
 
 =head1 SYNOPSIS
 
@@ -463,6 +463,7 @@ DynaLoader Interface Summary
   $symref  = dl_find_symbol_anywhere($symbol)          Perl
 
   $libref  = dl_load_file($filename, $flags)           C
+  $status  = dl_unload_file($libref)                   C
   $symref  = dl_find_symbol($libref, $symbol)          C
   @symbols = dl_undef_symbols()                        C
   dl_install_xsub($name, $symref [, $filename])        C
@@ -640,6 +641,42 @@ current values of @dl_require_symbols and @dl_resolve_using if required.
 Linux, and is a common choice when providing a "wrapper" on other
 mechanisms as is done in the OS/2 port.)
 
+=item dl_unload_file()
+
+Syntax:
+
+    $status = dl_unload_file($libref)
+
+Dynamically unload $libref, which must be an opaque 'library reference' as
+returned from dl_load_file.  Returns one on success and zero on failure.
+
+This function is optional and may not necessarily be provided on all platforms.
+If it is defined, it is called automatically when the interpreter exits for
+every shared object or library loaded by DynaLoader::bootstrap.  All such
+library references are stored in @dl_librefs by DynaLoader::Bootstrap as it
+loads the libraries.  The files are unloaded in last-in, first-out order.
+
+This unloading is usually necessary when embedding a shared-object perl (e.g.
+one configured with -Duseshrplib) within a larger application, and the perl
+interpreter is created and destroyed several times within the lifetime of the
+application.  In this case it is possible that the system dynamic linker will
+unload and then subsequently reload the shared libperl without relocating any
+references to it from any files DynaLoaded by the previous incarnation of the
+interpreter.  As a result, any shared objects opened by DynaLoader may point to
+a now invalid 'ghost' of the libperl shared object, causing apparently random
+memory corruption and crashes.  This behaviour is most commonly seen when using
+Apache and mod_perl built with the APXS mechanism.
+
+    SunOS: dlclose($libref)
+    HP-UX: ???
+    Linux: ???
+    NeXT:  ???
+    VMS:   ???
+
+(The dlclose() function is also used by Solaris and some versions of
+Linux, and is a common choice when providing a "wrapper" on other
+mechanisms as is done in the OS/2 port.)
+
 =item dl_loadflags()
 
 Syntax:
diff --git a/ext/DynaLoader/Makefile.PL b/ext/DynaLoader/Makefile.PL
index bcd45ae757..83cbd770b0 100644
--- a/ext/DynaLoader/Makefile.PL
+++ b/ext/DynaLoader/Makefile.PL
@@ -12,6 +12,7 @@ WriteMakefile(
 		    'XSLoader_pm.PL'=>'XSLoader.pm'},
     PM		=> {'DynaLoader.pm' => '$(INST_LIBDIR)/DynaLoader.pm',
 		    'XSLoader.pm' => '$(INST_LIBDIR)/XSLoader.pm'},
+    depend      => {'DynaLoader.o' => 'dlutils.c'},
     clean	=> {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm ' .
 			     'XSLoader.pm'},
 );
diff --git a/ext/DynaLoader/dl_aix.xs b/ext/DynaLoader/dl_aix.xs
index f845681ae1..35242ed652 100644
--- a/ext/DynaLoader/dl_aix.xs
+++ b/ext/DynaLoader/dl_aix.xs
@@ -20,6 +20,15 @@
 #include "perl.h"
 #include "XSUB.h"
 
+/* When building as a 64-bit binary on AIX, define this to get the
+ * correct structure definitions.  Also determines the field-name
+ * macros and gates some logic in readEntries().  -- Steven N. Hirsch
+ * <hirschs@btv.ibm.com> */
+#ifdef USE_64_BIT_ALL
+#   define __XCOFF64__
+#   define __XCOFF32__
+#endif
+
 #include <stdio.h>
 #include <errno.h>
 #include <string.h>
@@ -29,15 +38,33 @@
 #include <a.out.h>
 #include <ldfcn.h>
 
+#ifdef USE_64_BIT_ALL
+#   define AIX_SCNHDR SCNHDR_64
+#   define AIX_LDHDR LDHDR_64
+#   define AIX_LDSYM LDSYM_64
+#   define AIX_LDHDRSZ LDHDRSZ_64
+#else
+#   define AIX_SCNHDR SCNHDR
+#   define AIX_LDHDR LDHDR
+#   define AIX_LDSYM LDSYM
+#   define AIX_LDHDRSZ LDHDRSZ
+#endif
+
 /* When using Perl extensions written in C++ the longer versions
  * of load() and unload() from libC and libC_r need to be used,
  * otherwise statics in the extensions won't get initialized right.
  * -- Stephanie Beals <bealzy@us.ibm.com> */
+
+/* Older AIX C compilers cannot deal with C++ double-slash comments in
+   the ibmcxx and/or xlC includes.  Since we only need a single file,
+   be more fine-grained about what's included <hirschs@btv.ibm.com> */
 #ifdef USE_libC /* The define comes, when it comes, from hints/aix.pl. */
 #   define LOAD   loadAndInit
 #   define UNLOAD terminateAndUnload
-#   ifdef USE_load_h
-#       include <load.h>
+#   if defined(USE_xlC_load_h)
+#       include "/usr/lpp/xlC/include/load.h"
+#   elif defined(USE_ibmcxx_load_h)
+#       include "/usr/ibmcxx/include/load.h"
 #   endif
 #else
 #   define LOAD   load
@@ -394,10 +421,10 @@ static int readExports(ModulePtr mp)
 {
 	dTHX;
 	LDFILE *ldp = NULL;
-	SCNHDR sh;
-	LDHDR *lhp;
+	AIX_SCNHDR sh;
+	AIX_LDHDR *lhp;
 	char *ldbuf;
-	LDSYM *ls;
+	AIX_LDSYM *ls;
 	int i;
 	ExportPtr ep;
 
@@ -463,7 +490,11 @@ static int readExports(ModulePtr mp)
 			return -1;
 		}
 	}
+#ifdef USE_64_BIT_ALL
+	if (TYPE(ldp) != U803XTOCMAGIC) {
+#else
 	if (TYPE(ldp) != U802TOCMAGIC) {
+#endif
 		errvalid++;
 		strcpy(errbuf, "readExports: bad magic");
 		while(ldclose(ldp) == FAILURE)
@@ -511,8 +542,8 @@ static int readExports(ModulePtr mp)
 			;
 		return -1;
 	}
-	lhp = (LDHDR *)ldbuf;
-	ls = (LDSYM *)(ldbuf+LDHDRSZ);
+	lhp = (AIX_LDHDR *)ldbuf;
+	ls = (AIX_LDSYM *)(ldbuf+AIX_LDHDRSZ);
 	/*
 	 * Count the number of exports to include in our export table.
 	 */
@@ -536,15 +567,19 @@ static int readExports(ModulePtr mp)
 	 * the entry point we got from load.
 	 */
 	ep = mp->exports;
-	ls = (LDSYM *)(ldbuf+LDHDRSZ);
+	ls = (AIX_LDSYM *)(ldbuf+AIX_LDHDRSZ);
 	for (i = lhp->l_nsyms; i; i--, ls++) {
 		char *symname;
 		if (!LDR_EXPORT(*ls))
 			continue;
+#ifndef USE_64_BIT_ALL
 		if (ls->l_zeroes == 0)
+#endif
 			symname = ls->l_offset+lhp->l_stoff+ldbuf;
+#ifndef USE_64_BIT_ALL
 		else
 			symname = ls->l_name;
+#endif
 		ep->name = savepv(symname);
 		ep->addr = (void *)((unsigned long)mp->entry + ls->l_value);
 		ep++;
diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs
index 135f5112f2..8e4936d128 100644
--- a/ext/DynaLoader/dl_dlopen.xs
+++ b/ext/DynaLoader/dl_dlopen.xs
@@ -5,11 +5,13 @@
  * Created:	10th July 1994
  *
  * Modified:
- * 15th July 1994   - Added code to explicitly save any error messages.
- * 3rd August 1994  - Upgraded to v3 spec.
- * 9th August 1994  - Changed to use IV
- * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging,
- *                    basic FreeBSD support, removed ClearError
+ * 15th July 1994     - Added code to explicitly save any error messages.
+ * 3rd August 1994    - Upgraded to v3 spec.
+ * 9th August 1994    - Changed to use IV
+ * 10th August 1994   - Tim Bunce: Added RTLD_LAZY, switchable debugging,
+ *                      basic FreeBSD support, removed ClearError
+ * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
+ *                      files when the interpreter exits
  *
  */
 
@@ -37,6 +39,17 @@
      RTLD_LAZY (==2) on Solaris 2.
 
 
+   dlclose
+   -------
+     int
+     dlclose(handle)
+     void * handle;
+
+     This function takes the handle returned by a previous invocation of
+     dlopen and closes the associated dynamic object file.  It returns zero
+     on success, and non-zero on failure.
+
+
    dlsym
    ------
      void *
@@ -57,7 +70,7 @@
      Returns a null-terminated string which describes the last error
      that occurred with either dlopen or dlsym. After each call to
      dlerror the error message will be reset to a null pointer. The
-     SaveError function is used to save the error as soo as it happens.
+     SaveError function is used to save the error as soon as it happens.
 
 
    Return Types
@@ -180,6 +193,20 @@ dl_load_file(filename, flags=0)
 	sv_setiv( ST(0), PTR2IV(RETVAL));
 }
 
+
+int
+dl_unload_file(libref)
+    void *	libref
+  CODE:
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", libref));
+    RETVAL = (dlclose(libref) == 0 ? 1 : 0);
+    if (!RETVAL)
+        SaveError(aTHX_ "%s", dlerror()) ;
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
+  OUTPUT:
+    RETVAL
+
+
 void *
 dl_find_symbol(libhandle, symbolname)
     void *	libhandle
diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index 664e331e7b..5c6bbea1ac 100644
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -3,6 +3,9 @@
  * Currently this file is simply #included into dl_*.xs/.c files.
  * It should really be split into a dlutils.h and dlutils.c
  *
+ * Modified:
+ * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
+ *                      files when the interpreter exits
  */
 
 
@@ -25,6 +28,31 @@ static int dl_debug = 0;	/* value copied from $DynaLoader::dl_error */
 #endif
 
 
+/* Close all dlopen'd files */
+static void
+dl_unload_all_files(pTHXo_ void *unused)
+{
+    CV *sub;
+    AV *dl_librefs;
+    SV *dl_libref;
+
+    if ((sub = get_cv("DynaLoader::dl_unload_file", FALSE)) != NULL) {
+        dl_librefs = get_av("DynaLoader::dl_librefs", FALSE);
+        while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) {
+           dSP;
+           ENTER;
+           SAVETMPS;
+           PUSHMARK(SP);
+           XPUSHs(sv_2mortal(dl_libref));
+           PUTBACK;
+           call_sv((SV*)sub, G_DISCARD | G_NODEBUG);
+           FREETMPS;
+           LEAVE;
+        }
+    }
+}
+
+
 static void
 dl_generic_private_init(pTHXo)	/* called by dl_*.xs dl_private_init() */
 {
@@ -41,6 +69,7 @@ dl_generic_private_init(pTHXo)	/* called by dl_*.xs dl_private_init() */
     if (!dl_loaded_files)
 	dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
 #endif
+    call_atexit(&dl_unload_all_files, (void*)0);
 }
 
 
diff --git a/ext/DynaLoader/hints/aix.pl b/ext/DynaLoader/hints/aix.pl
index 4225979320..7dde941b43 100644
--- a/ext/DynaLoader/hints/aix.pl
+++ b/ext/DynaLoader/hints/aix.pl
@@ -3,8 +3,8 @@ use Config;
 if ($Config{libs} =~ /-lC/ && -f '/lib/libC.a') {
     $self->{CCFLAGS} = $Config{ccflags} . ' -DUSE_libC';
     if (-f '/usr/ibmcxx/include/load.h') {
-	$self->{CCFLAGS} .= ' -I/usr/ibmcxx/include -DUSE_load_h';
+	$self->{CCFLAGS} .= ' -DUSE_ibmcxx_load_h';
     } elsif (-f '/usr/lpp/xlC/include/load.h') {
-	$self->{CCFLAGS} .= ' -I/usr/lpp/xlC/include -DUSE_load_h';
+	$self->{CCFLAGS} .= ' -DUSE_xlC_load_h';
     }
 }
diff --git a/ext/Fcntl/Fcntl.pm b/ext/Fcntl/Fcntl.pm
index 8ce761c50b..171538e583 100644
--- a/ext/Fcntl/Fcntl.pm
+++ b/ext/Fcntl/Fcntl.pm
@@ -192,8 +192,8 @@ sub S_ISSOCK   { ( $_[0] & _S_IFMT() ) == S_IFSOCK()  }
 sub S_ISBLK    { ( $_[0] & _S_IFMT() ) == S_IFBLK()   }
 sub S_ISCHR    { ( $_[0] & _S_IFMT() ) == S_IFCHR()   }
 sub S_ISFIFO   { ( $_[0] & _S_IFMT() ) == S_IFIFO()   }
-sub S_ISWHT    { ( $_[0] & _S_IFMT() ) == S_ISWHT()   }
-sub S_ISENFMT  { ( $_[0] & _S_IFMT() ) == S_ISENFMT() }
+sub S_ISWHT    { ( $_[0] & _S_IFMT() ) == S_IFWHT()   }
+sub S_ISENFMT  { ( $_[0] & _S_IFMT() ) == S_IFENFMT() }
 
 sub AUTOLOAD {
     (my $constname = $AUTOLOAD) =~ s/.*:://;
diff --git a/ext/File/Glob/Glob.pm b/ext/File/Glob/Glob.pm
index a8e0262ca7..cfb44c813e 100644
--- a/ext/File/Glob/Glob.pm
+++ b/ext/File/Glob/Glob.pm
@@ -109,8 +109,8 @@ if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) {
 # Autoload methods go after =cut, and are processed by the autosplit program.
 
 sub glob {
-    my $pat = shift;
-    my $flags = shift;
+    my ($pat,$flags) = @_;
+    $flags = $DEFAULT_FLAGS if @_ < 2;
     if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) {
         $flags |= GLOB_NOCASE();
     }
diff --git a/ext/File/Glob/Makefile.PL b/ext/File/Glob/Makefile.PL
index c82988fdb1..98781c98e7 100644
--- a/ext/File/Glob/Makefile.PL
+++ b/ext/File/Glob/Makefile.PL
@@ -9,3 +9,13 @@ WriteMakefile(
 #   DEFINE		=> '-DGLOB_DEBUG',
 #   OPTIMIZE		=> '-g',
 );
+use Config;
+sub MY::cflags {
+  package MY;
+  my $inherited = shift->SUPER::cflags(@_);
+  if ($Config::Config{archname} =~ /^aix/ and 
+      $Config::Config{use64bitall} eq 'define') {
+    $inherited =~ s/\s-O\d?//m;
+  }
+  $inherited;
+}
diff --git a/ext/File/Glob/bsd_glob.c b/ext/File/Glob/bsd_glob.c
index c64d72b2df..62bfe4f80c 100644
--- a/ext/File/Glob/bsd_glob.c
+++ b/ext/File/Glob/bsd_glob.c
@@ -663,7 +663,9 @@ glob3(Char *pathbuf, Char *pathend, Char *pattern,
             Char *q = pathend;
             if (q - pathbuf > 5) {
                 q -= 5;
-                if (q[0] == '.' && tolower(q[1]) == 'd' && tolower(q[2]) == 'i' && tolower(q[3]) == 'r' && q[4] == '/') {
+                if (q[0] == '.' && tolower(q[1]) == 'd' && tolower(q[2]) == 'i'
+		    && tolower(q[3]) == 'r' && q[4] == '/')
+		{
                     q[0] = '/';
                     q[1] = BG_EOS;
                     pathend = q+1;
diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs
index 6cc1081c40..4b5e6db9f8 100644
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@ -98,7 +98,7 @@ threadstart(void *arg)
     DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p waiting to start\n",
 			  thr));
 
-    /* Don't call *anything* requiring dTHR until after SET_THR() */
+    /* Don't call *anything* requiring dTHR until after PERL_SET_THX() */
     /*
      * Wait until our creator releases us. If we didn't do this, then
      * it would be potentially possible for out thread to carry on and
@@ -114,7 +114,7 @@ threadstart(void *arg)
      * from our pthread_t structure to our struct perl_thread, since
      * we're the only thread who can get at it anyway.
      */
-    SET_THR(thr);
+    PERL_SET_THX(thr);
 
     /* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */
     DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p starting at %s\n",
@@ -252,7 +252,7 @@ newthread (pTHX_ SV *startsv, AV *initargs, char *classname)
      * XPUSHs() below want to grow the child's stack.  This is
      * safe, since the other thread is not yet created, and we
      * are the only ones who know about it */
-    SET_THR(thr);
+    PERL_SET_THX(thr);
     SPAGAIN;
     DEBUG_S(PerlIO_printf(Perl_debug_log,
 			  "%p: newthread (%p), tid is %u, preparing stack\n",
@@ -266,7 +266,7 @@ newthread (pTHX_ SV *startsv, AV *initargs, char *classname)
     PUTBACK;
 
     /* On your marks... */
-    SET_THR(savethread);
+    PERL_SET_THX(savethread);
     MUTEX_LOCK(&thr->mutex);
 
 #ifdef THREAD_CREATE