Re: Named-capture regex syntax

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

diff --git a/perl.c b/perl.c
index 269a18c..7d0aeb0 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -452,7 +452,7 @@ Perl_dump_sv_child(pTHX_ SV *sv)
        it to dump out to.  We can't let it hold open the file descriptor when it
        forks, as the file descriptor it will dump to can turn out to be one end
        of pipe that some other process will wait on for EOF. (So as it would
-       be open, the wait would be forever.  */
+       be open, the wait would be forever.)  */
 
     msg.msg_control = control.control;
     msg.msg_controllen = sizeof(control.control);
@@ -792,19 +792,6 @@ perl_destruct(pTHXx)
     PL_exitlist = NULL;
     PL_exitlistlen = 0;
 
-    if (destruct_level == 0){
-
-       DEBUG_P(debprofdump());
-
-#if defined(PERLIO_LAYERS)
-       /* No more IO - including error messages ! */
-       PerlIO_cleanup(aTHX);
-#endif
-
-       /* The exit() function will do everything that needs doing. */
-        return STATUS_EXIT;
-    }
-
     /* jettison our possibly duplicated environment */
     /* if PERL_USE_SAFE_PUTENV is defined environ will not have been copied
      * so we certainly shouldn't free it here
@@ -831,6 +818,22 @@ perl_destruct(pTHXx)
 #endif
 #endif /* !PERL_MICRO */
 
+    if (destruct_level == 0) {
+
+       DEBUG_P(debprofdump());
+
+#if defined(PERLIO_LAYERS)
+       /* No more IO - including error messages ! */
+       PerlIO_cleanup(aTHX);
+#endif
+
+       CopFILE_free(&PL_compiling);
+       CopSTASH_free(&PL_compiling);
+
+       /* The exit() function will do everything that needs doing. */
+        return STATUS_EXIT;
+    }
+
     /* reset so print() ends up where we expect */
     setdefout(NULL);
 
@@ -1544,11 +1547,7 @@ setuid perl scripts securely.\n");
         }
         /* Can we grab env area too to be used as the area for $0? */
         if (s && PL_origenviron) {
-             if ((PL_origenviron[0] == s + 1
-#ifdef OS2
-                  || (PL_origenviron[0] == s + 9 && (s += 8))
-#endif 
-                 )
+             if ((PL_origenviron[0] == s + 1)
                  ||
                  (aligned &&
                   (PL_origenviron[0] >  s &&
@@ -1556,7 +1555,7 @@ setuid perl scripts securely.\n");
                    INT2PTR(char *, PTR2UV(s + PTRSIZE) & mask)))
                 )
              {
-#ifndef OS2
+#ifndef OS2            /* ENVIRON is read by the kernel too. */
                   s = PL_origenviron[0];
                   while (*s) s++;
 #endif
@@ -1654,7 +1653,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     VOL bool dosearch = FALSE;
     const char *validarg = "";
     register SV *sv;
-    register char *s;
+    register char *s, c;
     const char *cddir = NULL;
 #ifdef USE_SITECUSTOMIZE
     bool minus_f = FALSE;
@@ -1682,7 +1681,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #endif
        s = argv[0]+1;
       reswitch:
-       switch (*s) {
+       switch ((c = *s)) {
        case 'C':
 #ifndef PERL_STRICT_CR
        case '\r':
@@ -1749,7 +1748,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                argc--,argv++;
            }
            else
-               Perl_croak(aTHX_ "No code specified for -%c", *s);
+               Perl_croak(aTHX_ "No code specified for -%c", c);
            sv_catpvs(PL_e_script, "\n");
            break;
 
@@ -4654,6 +4653,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
     }
     if ((PL_envgv = gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV))) {
        HV *hv;
+       bool env_is_not_environ;
        GvMULTI_on(PL_envgv);
        hv = GvHVn(PL_envgv);
        hv_magic(hv, NULL, PERL_MAGIC_env);
@@ -4666,7 +4666,8 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
        */
        if (!env)
            env = environ;
-       if (env != environ
+       env_is_not_environ = env != environ;
+       if (env_is_not_environ
 #  ifdef USE_ITHREADS
            && PL_curinterp == aTHX
 #  endif
@@ -4688,7 +4689,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 #endif
            sv = newSVpv(s+1, 0);
            (void)hv_store(hv, *env, s - *env, sv, 0);
-           if (env != environ)
+           if (env_is_not_environ)
                mg_set(sv);
            if (origenv != environ) {
              /* realloc has shifted us */