Don't skip too much of the locale error message if no environ array,

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

diff --git a/perl.c b/perl.c
index 9a577fe..af1f27c 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1,6 +1,6 @@
 /*    perl.c
  *
- *    Copyright (c) 1987-2000 Larry Wall
+ *    Copyright (c) 1987-2001 Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -473,11 +473,11 @@ perl_destruct(pTHXx)
 
     /* magical thingies */
 
-    Safefree(PL_ofs);          /* $, */
-    PL_ofs = Nullch;
+    SvREFCNT_dec(PL_ofs_sv);   /* $, */
+    PL_ofs_sv = Nullsv;
 
-    Safefree(PL_ors);          /* $\ */
-    PL_ors = Nullch;
+    SvREFCNT_dec(PL_ors_sv);   /* $\ */
+    PL_ors_sv = Nullsv;
 
     SvREFCNT_dec(PL_rs);       /* $/ */
     PL_rs = Nullsv;
@@ -562,6 +562,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 +698,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;
@@ -724,6 +730,7 @@ perl_destruct(pTHXx)
     Safefree(PL_op_mask);
     Safefree(PL_psig_ptr);
     Safefree(PL_psig_name);
+    Safefree(PL_psig_pend);
     nuke_stacks();
     PL_hints = 0;              /* Reset hints. Should hints be per-interpreter ? */
 
@@ -789,12 +796,12 @@ perl_free(pTHXx)
 #  if defined(PERL_IMPLICIT_SYS)
     void *host = w32_internal_host;
     if (PerlProc_lasthost()) {
-       PerlIO_cleanup();     
+       PerlIO_cleanup();
     }
     PerlMem_free(aTHXx);
     win32_delete_internal_host(host);
 #else
-    PerlIO_cleanup();     
+    PerlIO_cleanup();
     PerlMem_free(aTHXx);
 #endif
 #  else
@@ -2158,23 +2165,23 @@ Perl_moreswitches(pTHX_ char *s)
     case 'l':
        PL_minus_l = TRUE;
        s++;
-       if (PL_ors)
-           Safefree(PL_ors);
+       if (PL_ors_sv) {
+           SvREFCNT_dec(PL_ors_sv);
+           PL_ors_sv = Nullsv;
+       }
        if (isDIGIT(*s)) {
-           PL_ors = savepv("\n");
-           PL_orslen = 1;
+           PL_ors_sv = newSVpvn("\n",1);
            numlen = 0;                 /* disallow underscores */
-           *PL_ors = (char)scan_oct(s, 3 + (*s == '0'), &numlen);
+           *SvPVX(PL_ors_sv) = (char)scan_oct(s, 3 + (*s == '0'), &numlen);
            s += numlen;
        }
        else {
            if (RsPARA(PL_nrs)) {
-               PL_ors = "\n\n";
-               PL_orslen = 2;
+               PL_ors_sv = newSVpvn("\n\n",2);
+           }
+           else {
+               PL_ors_sv = newSVsv(PL_nrs);
            }
-           else
-               PL_ors = SvPV(PL_nrs, PL_orslen);
-           PL_ors = savepvn(PL_ors, PL_orslen);
        }
        return s;
     case 'M':
@@ -2259,10 +2266,10 @@ Perl_moreswitches(pTHX_ char *s)
 #endif
 
        PerlIO_printf(PerlIO_stdout(),
-                     "\n\nCopyright 1987-2000, Larry Wall\n");
+                     "\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(),
@@ -3038,7 +3045,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) {
@@ -3250,6 +3257,8 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
     char *s;
     SV *sv;
     GV* tmpgv;
+    char **dup_env_base = 0;
+    int dup_env_count = 0;
 
     argc--,argv++;     /* skip name of script */
     if (PL_doswitches) {
@@ -3318,6 +3327,23 @@ 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 **)
+                safemalloc( sizeof(char *) * (dup_env_count+1) ))) {
+               char **dup_env;
+               for (env = env_base, dup_env = dup_env_base;
+                    *env;
+                    env++, dup_env++)
+                   *dup_env = savepv(*env);
+               *dup_env = Nullch;
+               env = dup_env_base;
+           } /* else what? */
+       }
+#endif /* NEED_ENVIRON_DUP_FOR_MODIFY */
        for (; *env; env++) {
            if (!(s = strchr(*env,'=')))
                continue;
@@ -3333,7 +3359,13 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
            (void)PerlEnv_putenv(savepv(*env));
 #endif
        }
-#endif
+       if (dup_env_base) {
+           char **dup_env;
+           for (dup_env = dup_env_base; *dup_env; dup_env++)
+               Safefree(*dup_env);
+           Safefree(dup_env_base);
+       }
+#endif /* USE_ENVIRON_ARRAY */
 #ifdef DYNAMIC_ENV_FETCH
        HvNAME(hv) = savepv(ENV_HV_NAME);
 #endif
@@ -3542,13 +3574,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);
@@ -3557,7 +3591,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 &&