Add more known sprintf failures.

[p5sagit/p5-mst-13.2.git] / perl.c

diff --git a/perl.c b/perl.c
index 21ca8aa..b1d70b1 100644 (file)
--- 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) {
@@ -698,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;
@@ -1168,6 +1188,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
            PL_tainting = TRUE;
        else {
            while (s && *s) {
+               char *d;
                while (isSPACE(*s))
                    s++;
                if (*s == '-') {
@@ -1175,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);
            }
        }
     }
@@ -2264,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(),
@@ -3040,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) {
@@ -3252,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) {
@@ -3309,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
@@ -3320,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;
@@ -3330,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
@@ -3544,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);
@@ -3559,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 &&