X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=ee33a9ceb0433ce8f746d7532fed6d84067b4399;hb=f69c1b32fbc1a1348f4cb6eadbb919fc9d0341cb;hp=4c69293bb80a8d8a746693c33e75f680b9a8b4ae;hpb=25c09a70fd931a4c30fe75cf5895a26fb64d6da0;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.c b/perl.c
index 4c69293..ee33a9c 100644
--- a/perl.c
+++ b/perl.c
@@ -16,6 +16,11 @@
 #include "perl.h"
 #include "patchlevel.h"			/* for local_patches */
 
+#ifdef NETWARE
+#include "nwutil.h"	
+char *nw_get_sitelib(const char *pl);
+#endif
+
 /* XXX If this causes problems, set i_unistd=undef in the hint file.  */
 #ifdef I_UNISTD
 #include <unistd.h>
@@ -425,6 +430,9 @@ perl_destruct(pTHXx)
     LEAVE;
     FREETMPS;
 
+    /* Need to flush since END blocks can produce output */
+    PerlIO_flush((PerlIO*)NULL);
+
     if (CALL_FPTR(PL_threadhook)(aTHX)) {
         /* Threads hook has vetoed further cleanup */
         return STATUS_NATIVE_EXPORT;;
@@ -490,7 +498,13 @@ perl_destruct(pTHXx)
      * so we certainly shouldn't free it here
      */
 #if defined(USE_ENVIRON_ARRAY) && !defined(PERL_USE_SAFE_PUTENV)
-    if (environ != PL_origenviron) {
+    if (environ != PL_origenviron
+#ifdef USE_ITHREADS
+	/* only main thread can free environ[0] contents */
+	&& PL_curinterp == aTHX
+#endif
+	)
+    {
 	I32 i;
 
 	for (i = 0; environ[i]; i++)
@@ -686,6 +700,8 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_utf8_totitle);
     SvREFCNT_dec(PL_utf8_tolower);
     SvREFCNT_dec(PL_utf8_tofold);
+    SvREFCNT_dec(PL_utf8_idstart);
+    SvREFCNT_dec(PL_utf8_idcont);
     PL_utf8_alnum	= Nullsv;
     PL_utf8_alnumc	= Nullsv;
     PL_utf8_ascii	= Nullsv;
@@ -704,6 +720,8 @@ perl_destruct(pTHXx)
     PL_utf8_totitle	= Nullsv;
     PL_utf8_tolower	= Nullsv;
     PL_utf8_tofold	= Nullsv;
+    PL_utf8_idstart	= Nullsv;
+    PL_utf8_idcont	= Nullsv;
 
     if (!specialWARN(PL_compiling.cop_warnings))
 	SvREFCNT_dec(PL_compiling.cop_warnings);
@@ -813,8 +831,15 @@ perl_destruct(pTHXx)
     SvANY(&PL_sv_no) = NULL;
     SvFLAGS(&PL_sv_no) = 0;
 
-    SvREFCNT(&PL_sv_undef) = 0;
-    SvREADONLY_off(&PL_sv_undef);
+    {
+        int i;
+        for (i=0; i<=2; i++) {
+            SvREFCNT(PERL_DEBUG_PAD(i)) = 0;
+            sv_clear(PERL_DEBUG_PAD(i));
+            SvANY(PERL_DEBUG_PAD(i)) = NULL;
+            SvFLAGS(PERL_DEBUG_PAD(i)) = 0;
+        }
+    }
 
     if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
 	Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Scalars leaked: %ld\n", (long)PL_sv_count);
@@ -824,6 +849,13 @@ perl_destruct(pTHXx)
     PerlIO_cleanup(aTHX);
 #endif
 
+    /* sv_undef needs to stay immortal until after PerlIO_cleanup
+       as currently layers use it rather than Nullsv as a marker
+       for no arg - and will try and SvREFCNT_dec it.
+     */
+    SvREFCNT(&PL_sv_undef) = 0;
+    SvREADONLY_off(&PL_sv_undef);
+
     Safefree(PL_origfilename);
     Safefree(PL_reg_start_tmp);
     if (PL_reg_curpm)
@@ -908,7 +940,7 @@ perl_free(pTHXx)
 #    endif
     PerlMem_free(aTHXx);
 #    ifdef NETWARE
-    nw5_delete_internal_host(host);
+    nw_delete_internal_host(host);
 #    else
     win32_delete_internal_host(host);
 #    endif
@@ -1616,7 +1648,9 @@ S_run_body(pTHX_ I32 oldscope)
 
 	if (PL_minus_c) {
 #ifdef MACOS_TRADITIONAL
-	    PerlIO_printf(Perl_error_log, "# %s syntax OK\n", MacPerl_MPWFileName(PL_origfilename));
+	    PerlIO_printf(Perl_error_log, "%s%s syntax OK\n",
+		(gMacPerl_ErrorFormat ? "# " : ""),
+		MacPerl_MPWFileName(PL_origfilename));
 #else
 	    PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename);
 #endif
@@ -2240,7 +2274,7 @@ Perl_moreswitches(pTHX_ char *s)
 	else if (!rschar && numlen >= 2)
 	    PL_rs = newSVpvn("", 0);
 	else {
-	    char ch = rschar;
+	    char ch = (char)rschar;
 	    PL_rs = newSVpvn(&ch, 1);
 	}
 	return s + numlen;
@@ -2325,10 +2359,16 @@ Perl_moreswitches(pTHX_ char *s)
     }	
     case 'h':
 	usage(PL_origargv[0]);
-	PerlProc_exit(0);
+	my_exit(0);
     case 'i':
 	if (PL_inplace)
 	    Safefree(PL_inplace);
+#if defined(__CYGWIN__) /* do backup extension automagically */
+	if (*(s+1) == '\0') {
+	PL_inplace = savepv(".bak");
+	return s+1;
+	}
+#endif /* __CYGWIN__ */
 	PL_inplace = savepv(s+1);
 	/*SUPPRESS 530*/
 	for (s = PL_inplace; *s && !isSPACE(*s); s++) ;
@@ -2557,7 +2597,7 @@ GNU General Public License, which may be found in the Perl 5 source kit.\n\n\
 Complete documentation for Perl, including FAQ lists, should be found on\n\
 this system using `man perl' or `perldoc perl'.  If you have access to the\n\
 Internet, point your browser at http://www.perl.com/, the Perl Home Page.\n\n");
-	PerlProc_exit(0);
+	my_exit(0);
     case 'w':
 	if (! (PL_dowarn & G_WARN_ALL_MASK))
 	    PL_dowarn |= G_WARN_ON;
@@ -2930,7 +2970,7 @@ S_fd_on_nosuid_fs(pTHX_ int fd)
         defined(HAS_STRUCT_FS_DATA)	&& \
         defined(NOSTAT_ONE)
 #   define FD_ON_NOSUID_CHECK_OKAY
-    struct stat fdst;
+    Stat_t fdst;
 
     if (fstat(fd, &fdst) == 0) {
         struct ustat us;
@@ -2960,7 +3000,7 @@ S_fd_on_nosuid_fs(pTHX_ int fd)
 #   define FD_ON_NOSUID_CHECK_OKAY
     FILE                *mtab = fopen("/etc/mtab", "r");
     struct mntent       *entry;
-    struct stat         stb, fsb;
+    Stat_t              stb, fsb;
 
     if (mtab && (fstat(fd, &stb) == 0)) {
         while (entry = getmntent(mtab)) {
@@ -3040,7 +3080,7 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
 	 * Then we just have to make sure he or she can execute it.
 	 */
 	{
-	    struct stat tmpstatbuf;
+	    Stat_t tmpstatbuf;
 
 	    if (
 #ifdef HAS_SETREUID
@@ -3550,8 +3590,14 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 	*/
 	if (!env)
 	    env = environ;
-	if (env != environ)
+	if (env != environ
+#  ifdef USE_ITHREADS
+	    && PL_curinterp == aTHX
+#  endif
+	   )
+	{
 	    environ[0] = Nullch;
+	}
 	if (env)
 	  for (; *env; env++) {
 	    if (!(s = strchr(*env,'=')))
@@ -3574,6 +3620,14 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 	sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
         SvREADONLY_on(GvSV(tmpgv));
     }
+
+    /* touch @F array to prevent spurious warnings 20020415 MJD */
+    if (PL_minus_a) {
+      (void) get_av("main::F", TRUE | GV_ADDMULTI);
+    }
+    /* touch @- and @+ arrays to prevent spurious warnings 20020415 MJD */
+    (void) get_av("main::-", TRUE | GV_ADDMULTI);
+    (void) get_av("main::+", TRUE | GV_ADDMULTI);
 }
 
 STATIC void
@@ -3613,7 +3667,7 @@ S_init_perllib(pTHX)
 #endif
 #ifdef MACOS_TRADITIONAL
     {
-	struct stat tmpstatbuf;
+	Stat_t tmpstatbuf;
     	SV * privdir = NEWSV(55, 0);
 	char * macperl = PerlEnv_getenv("MACPERL");
 	
@@ -3741,8 +3795,11 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers)
 	    p = Nullch;	/* break out */
 	}
 #ifdef MACOS_TRADITIONAL
-	if (!strchr(SvPVX(libdir), ':'))
-	    sv_insert(libdir, 0, 0, ":", 1);
+	if (!strchr(SvPVX(libdir), ':')) {
+	    char buf[256];
+
+	    sv_setpv(libdir, MacPerl_CanonDir(SvPVX(libdir), buf, 0));
+	}
 	if (SvPVX(libdir)[SvCUR(libdir)-1] != ':')
 	    sv_catpv(libdir, ":");
 #endif
@@ -3757,7 +3814,7 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers)
 	    const char *incverlist[] = { PERL_INC_VERSION_LIST };
 	    const char **incver;
 #endif
-	    struct stat tmpstatbuf;
+	    Stat_t tmpstatbuf;
 #ifdef VMS
 	    char *unix;
 	    STRLEN len;