X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=b1d70b17c8fafa07649a9cfd1651a68541b0b5af;hb=917b24923c0362e8f2d8d1f3f612150902a8f3eb;hp=a5f4e68b6b23646e9e44a643147f9eb163b9a156;hpb=ce08f86c8b1d404b3d9fec75a102b8cd65f8766a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.c b/perl.c
index a5f4e68..b1d70b1 100644
--- a/perl.c
+++ b/perl.c
@@ -438,6 +438,21 @@ perl_destruct(pTHXx)
 	return;
     }
 
+    /* jettison our possibly duplicated environment */
+
+#ifdef USE_ENVIRON_ARRAY
+    if (environ != PL_origenviron) {
+	I32 i;
+
+	for (i = 0; environ[i]; i++)
+	    safesysfree(environ[i]);
+	/* Must use safesysfree() when working with environ. */
+	safesysfree(environ);		
+
+	environ = PL_origenviron;
+    }
+#endif
+
     /* loosen bonds of global variables */
 
     if(PL_rsfp) {
@@ -562,6 +577,7 @@ perl_destruct(pTHXx)
 #ifdef USE_LOCALE_NUMERIC
     Safefree(PL_numeric_name);
     PL_numeric_name = Nullch;
+    SvREFCNT_dec(PL_numeric_radix);
 #endif
 
     /* clear utf8 character classes */
@@ -697,6 +713,11 @@ perl_destruct(pTHXx)
     }
     SvREFCNT_dec(PL_strtab);
 
+#ifdef USE_ITHREADS
+    /* free the pointer table used for cloning */
+    ptr_table_free(PL_ptr_table);
+#endif
+
     /* free special SVs */
 
     SvREFCNT(&PL_sv_yes) = 0;
@@ -1167,6 +1188,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 	    PL_tainting = TRUE;
 	else {
 	    while (s && *s) {
+	        char *d;
 		while (isSPACE(*s))
 		    s++;
 		if (*s == '-') {
@@ -1174,11 +1196,18 @@ print \"  \\@INC:\\n    @INC\\n\";");
 		    if (isSPACE(*s))
 			continue;
 		}
+		d = s;
 		if (!*s)
 		    break;
 		if (!strchr("DIMUdmw", *s))
 		    Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
-		s = moreswitches(s);
+		while (++s && *s) {
+		    if (isSPACE(*s)) {
+		        *s++ = '\0';
+			break;
+		    }
+		}
+		moreswitches(d);
 	    }
 	}
     }
@@ -2263,7 +2292,7 @@ Perl_moreswitches(pTHX_ char *s)
 		      "\n\nCopyright 1987-2001, Larry Wall\n");
 #ifdef MACOS_TRADITIONAL
 	PerlIO_printf(PerlIO_stdout(),
-		      "\nMacOS port Copyright (c) 1991-2000, Matthias Neeracher\n");
+		      "\nMac OS port Copyright (c) 1991-2001, Matthias Neeracher\n");
 #endif
 #ifdef MSDOS
 	PerlIO_printf(PerlIO_stdout(),
@@ -3039,7 +3068,7 @@ S_find_beginning(pTHX)
 
     forbid_setid("-x");
 #ifdef MACOS_TRADITIONAL
-    /* Since the Mac OS does not honor !# arguments for us, we do it ourselves */
+    /* Since the Mac OS does not honor #! arguments for us, we do it ourselves */
 
     while (PL_doextract || gMacPerl_AlwaysExtract) {
 	if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
@@ -3251,6 +3280,10 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
     char *s;
     SV *sv;
     GV* tmpgv;
+    char **dup_env_base = 0;
+#ifdef NEED_ENVIRON_DUP_FOR_MODIFY
+    int dup_env_count = 0;
+#endif
 
     argc--,argv++;	/* skip name of script */
     if (PL_doswitches) {
@@ -3308,7 +3341,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 	HV *hv;
 	GvMULTI_on(PL_envgv);
 	hv = GvHVn(PL_envgv);
-	hv_magic(hv, PL_envgv, 'E');
+	hv_magic(hv, Nullgv, 'E');
 #ifdef USE_ENVIRON_ARRAY
 	/* Note that if the supplied env parameter is actually a copy
 	   of the global environ then it may now point to free'd memory
@@ -3319,6 +3352,26 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 	    env = environ;
 	if (env != environ)
 	    environ[0] = Nullch;
+#ifdef NEED_ENVIRON_DUP_FOR_MODIFY
+	{
+	    char **env_base;
+	    for (env_base = env; *env; env++) 
+		dup_env_count++;
+	    if ((dup_env_base = (char **)
+		 safesysmalloc( sizeof(char *) * (dup_env_count+1) ))) {
+		char **dup_env;
+		for (env = env_base, dup_env = dup_env_base;
+		     *env;
+		     env++, dup_env++) {
+		    /* With environ one needs to use safesysmalloc(). */
+		    *dup_env = safesysmalloc(strlen(*env) + 1);
+		    (void)strcpy(*dup_env, *env);
+		}
+		*dup_env = Nullch;
+		env = dup_env_base;
+	    } /* else what? */
+	}
+#endif /* NEED_ENVIRON_DUP_FOR_MODIFY */
 	for (; *env; env++) {
 	    if (!(s = strchr(*env,'=')))
 		continue;
@@ -3329,12 +3382,16 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 	    sv = newSVpv(s--,0);
 	    (void)hv_store(hv, *env, s - *env, sv, 0);
 	    *s = '=';
-#if defined(__BORLANDC__) && defined(USE_WIN32_RTL_ENV)
-	    /* Sins of the RTL. See note in my_setenv(). */
-	    (void)PerlEnv_putenv(savepv(*env));
-#endif
 	}
-#endif
+#ifdef NEED_ENVIRON_DUP_FOR_MODIFY
+	if (dup_env_base) {
+	    char **dup_env;
+	    for (dup_env = dup_env_base; *dup_env; dup_env++)
+		safesysfree(*dup_env);
+	    safesysfree(dup_env_base);
+	}
+#endif /* NEED_ENVIRON_DUP_FOR_MODIFY */
+#endif /* USE_ENVIRON_ARRAY */
 #ifdef DYNAMIC_ENV_FETCH
 	HvNAME(hv) = savepv(ENV_HV_NAME);
 #endif
@@ -3543,13 +3600,15 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers)
 	    if (addsubdirs) {
 #ifdef MACOS_TRADITIONAL
 #define PERL_AV_SUFFIX_FMT	""
-#define PERL_ARCH_FMT 		":%s"
+#define PERL_ARCH_FMT 		"%s:"
+#define PERL_ARCH_FMT_PATH	PERL_FS_VER_FMT PERL_AV_SUFFIX_FMT
 #else
 #define PERL_AV_SUFFIX_FMT 	"/"
 #define PERL_ARCH_FMT 		"/%s"
+#define PERL_ARCH_FMT_PATH	PERL_AV_SUFFIX_FMT PERL_FS_VER_FMT
 #endif
 		/* .../version/archname if -d .../version/archname */
-		Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_AV_SUFFIX_FMT PERL_FS_VER_FMT PERL_ARCH_FMT,
+		Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT_PATH PERL_ARCH_FMT,
 				libdir,
 			       (int)PERL_REVISION, (int)PERL_VERSION,
 			       (int)PERL_SUBVERSION, ARCHNAME);
@@ -3558,7 +3617,7 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers)
 		    av_push(GvAVn(PL_incgv), newSVsv(subdir));
 
 		/* .../version if -d .../version */
-		Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_AV_SUFFIX_FMT PERL_FS_VER_FMT, libdir,
+		Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT_PATH, libdir,
 			       (int)PERL_REVISION, (int)PERL_VERSION,
 			       (int)PERL_SUBVERSION);
 		if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&