regcomp.c, perl.c: Use 'VOL' not 'volatile'

[perl5.git] / perl.c

diff --git a/perl.c b/perl.c
index beb9d63..15e9150 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -585,6 +585,19 @@ perl_destruct(pTHXx)
     assert(PL_scopestack_ix == 0);
 
     /* Need to flush since END blocks can produce output */
+    /* flush stdout separately, since we can identify it */
+#ifdef USE_PERLIO
+    {
+        PerlIO *stdo = PerlIO_stdout();
+        if (*stdo && PerlIO_flush(stdo)) {
+            PerlIO_restore_errno(stdo);
+            PerlIO_printf(PerlIO_stderr(), "Unable to flush stdout: %s",
+                          Strerror(errno));
+            if (!STATUS_UNIX)
+                STATUS_ALL_FAILURE;
+        }
+    }
+#endif
     my_fflush_all();
 
 #ifdef PERL_TRACE_OPS
@@ -2779,7 +2792,7 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
        myop.op_other = (OP*)&myop;
        (void)POPMARK;
         old_cxix = cxstack_ix;
-       create_eval_scope(flags|G_FAKINGEVAL);
+       create_eval_scope(NULL, flags|G_FAKINGEVAL);
        (void)INCMARK;
 
        JMPENV_PUSH(ret);
@@ -2893,7 +2906,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
        myop.op_private = (OPpEVAL_COPHH | OPpEVAL_RE_REPARSING);
 
     /* fail now; otherwise we could fail after the JMPENV_PUSH but
-     * before a PUSHEVAL, which corrupts the stack after a croak */
+     * before a cx_pusheval(), which corrupts the stack after a croak */
     TAINT_PROPER("eval_sv()");
 
     JMPENV_PUSH(ret);
@@ -4078,6 +4091,8 @@ Perl_init_debugger(pTHX)
 void
 Perl_init_stacks(pTHX)
 {
+    SSize_t size;
+
     /* start with 128-item stack and 8K cxstack */
     PL_curstackinfo = new_stackinfo(REASONABLE(128),
                                 REASONABLE(8192/sizeof(PERL_CONTEXT) - 1));
@@ -4107,9 +4122,11 @@ Perl_init_stacks(pTHX)
     PL_scopestack_ix = 0;
     PL_scopestack_max = REASONABLE(32);
 
-    Newx(PL_savestack,REASONABLE_but_at_least(128,SS_MAXPUSH),ANY);
+    size = REASONABLE_but_at_least(128,SS_MAXPUSH);
+    Newx(PL_savestack, size, ANY);
     PL_savestack_ix = 0;
-    PL_savestack_max = REASONABLE_but_at_least(128,SS_MAXPUSH);
+    /*PL_savestack_max lies: it always has SS_MAXPUSH more than it claims */
+    PL_savestack_max = size - SS_MAXPUSH;
 }
 
 #undef REASONABLE
@@ -4325,23 +4342,70 @@ S_init_postdump_symbols(pTHX_ int argc, char **argv, char **env)
        }
        if (env) {
          char *s, *old_var;
+          STRLEN nlen;
          SV *sv;
+          HV *dups = newHV();
+
          for (; *env; env++) {
            old_var = *env;
 
            if (!(s = strchr(old_var,'=')) || s == old_var)
                continue;
+            nlen = s - old_var;
 
 #if defined(MSDOS) && !defined(DJGPP)
            *s = '\0';
            (void)strupr(old_var);
            *s = '=';
 #endif
-           sv = newSVpv(s+1, 0);
-           (void)hv_store(hv, old_var, s - old_var, sv, 0);
+            if (hv_exists(hv, old_var, nlen)) {
+                const char *name = savepvn(old_var, nlen);
+
+                /* make sure we use the same value as getenv(), otherwise code that
+                   uses getenv() (like setlocale()) might see a different value to %ENV
+                 */
+                sv = newSVpv(PerlEnv_getenv(name), 0);
+
+                /* keep a count of the dups of this name so we can de-dup environ later */
+                if (hv_exists(dups, name, nlen))
+                    ++SvIVX(*hv_fetch(dups, name, nlen, 0));
+                else
+                    (void)hv_store(dups, name, nlen, newSViv(1), 0);
+
+                Safefree(name);
+            }
+            else {
+                sv = newSVpv(s+1, 0);
+            }
+           (void)hv_store(hv, old_var, nlen, sv, 0);
            if (env_is_not_environ)
                mg_set(sv);
          }
+          if (HvKEYS(dups)) {
+              /* environ has some duplicate definitions, remove them */
+              HE *entry;
+              hv_iterinit(dups);
+              while ((entry = hv_iternext_flags(dups, 0))) {
+                  STRLEN nlen;
+                  const char *name = HePV(entry, nlen);
+                  IV count = SvIV(HeVAL(entry));
+                  IV i;
+                  SV **valp = hv_fetch(hv, name, nlen, 0);
+
+                  assert(valp);
+
+                  /* try to remove any duplicate names, depending on the
+                   * implementation used in my_setenv() the iteration might
+                   * not be necessary, but let's be safe.
+                   */
+                  for (i = 0; i < count; ++i)
+                      my_setenv(name, 0);
+
+                  /* and set it back to the value we set $ENV{name} to */
+                  my_setenv(name, SvPV_nolen(*valp));
+              }
+          }
+          SvREFCNT_dec_NN(dups);
       }
 #endif /* USE_ENVIRON_ARRAY */
 #endif /* !PERL_MICRO */
@@ -4875,7 +4939,7 @@ void
 Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 {
     SV *atsv;
-    volatile const line_t oldline = PL_curcop ? CopLINE(PL_curcop) : 0;
+    VOL const line_t oldline = PL_curcop ? CopLINE(PL_curcop) : 0;
     CV *cv;
     STRLEN len;
     int ret;
@@ -5082,7 +5146,7 @@ S_my_exit_jump(pTHX)
     POPSTACK_TO(PL_mainstack);
     if (cxstack_ix >= 0) {
         dounwind(-1);
-        POPBLOCK(cxstack);
+        cx_popblock(cxstack);
     }
     LEAVE_SCOPE(0);