Actually submit previous change.

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

diff --git a/perl.c b/perl.c
index c15874a..0f242d7 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);
@@ -539,7 +539,7 @@ int
 perl_destruct(pTHXx)
 {
     dVAR;
-    volatile int destruct_level;  /* 0=none, 1=full, 2=full with checks */
+    VOL int destruct_level;  /* 0=none, 1=full, 2=full with checks */
     HV *hv;
 #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
     pid_t child;
@@ -881,6 +881,11 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_rsfp_filters);
     PL_rsfp_filters = NULL;
 
+    if (PL_minus_F) {
+       Safefree(PL_splitstr);
+       PL_splitstr = NULL;
+    }
+
     /* switches */
     PL_preprocess   = FALSE;
     PL_minus_n      = FALSE;
@@ -944,12 +949,16 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_endav);
     SvREFCNT_dec(PL_checkav);
     SvREFCNT_dec(PL_checkav_save);
+    SvREFCNT_dec(PL_unitcheckav);
+    SvREFCNT_dec(PL_unitcheckav_save);
     SvREFCNT_dec(PL_initav);
     PL_beginav = NULL;
     PL_beginav_save = NULL;
     PL_endav = NULL;
     PL_checkav = NULL;
     PL_checkav_save = NULL;
+    PL_unitcheckav = NULL;
+    PL_unitcheckav_save = NULL;
     PL_initav = NULL;
 
     /* shortcuts just get cleared */
@@ -1605,6 +1614,8 @@ setuid perl scripts securely.\n");
     switch (ret) {
     case 0:
        parse_body(env,xsinit);
+       if (PL_unitcheckav)
+           call_list(oldscope, PL_unitcheckav);
        if (PL_checkav)
            call_list(oldscope, PL_checkav);
        ret = 0;
@@ -1618,6 +1629,8 @@ setuid perl scripts securely.\n");
            LEAVE;
        FREETMPS;
        PL_curstash = PL_defstash;
+       if (PL_unitcheckav)
+           call_list(oldscope, PL_unitcheckav);
        if (PL_checkav)
            call_list(oldscope, PL_checkav);
        ret = STATUS_EXIT;
@@ -1641,7 +1654,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;
@@ -1669,7 +1682,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':
@@ -1736,7 +1749,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;
 
@@ -2576,7 +2589,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
     LOGOP myop;                /* fake syntax tree node */
     UNOP method_op;
     I32 oldmark;
-    volatile I32 retval = 0;
+    VOL I32 retval = 0;
     I32 oldscope;
     bool oldcatch = CATCH_GET;
     int ret;
@@ -2703,8 +2716,8 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
     dVAR;
     dSP;
     UNOP myop;         /* fake syntax tree node */
-    volatile I32 oldmark = SP - PL_stack_base;
-    volatile I32 retval = 0;
+    VOL I32 oldmark = SP - PL_stack_base;
+    VOL I32 retval = 0;
     int ret;
     OP* const oldop = PL_op;
     dJMPENV;
@@ -2933,7 +2946,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
     int i = 0;
     if (isALPHA(**s)) {
        /* if adding extra options, remember to update DEBUG_MASK */
-       static const char debopts[] = "psltocPmfrxu HXDSTRJvCAq";
+       static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAq";
 
        for (; isALNUM(**s); (*s)++) {
            const char * const d = strchr(debopts,**s);
@@ -5113,6 +5126,12 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
                    PL_checkav_save = newAV();
                av_push(PL_checkav_save, (SV*)cv);
            }
+           else if (paramList == PL_unitcheckav) {
+               /* save PL_unitcheckav for compiler */
+               if (! PL_unitcheckav_save)
+                   PL_unitcheckav_save = newAV();
+               av_push(PL_unitcheckav_save, (SV*)cv);
+           }
        } else {
            if (!PL_madskills)
                SAVEFREESV(cv);
@@ -5143,6 +5162,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
                                   "%s failed--call queue aborted",
                                   paramList == PL_checkav ? "CHECK"
                                   : paramList == PL_initav ? "INIT"
+                                  : paramList == PL_unitcheckav ? "UNITCHECK"
                                   : "END");
                while (PL_scopestack_ix > oldscope)
                    LEAVE;
@@ -5171,6 +5191,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
                    Perl_croak(aTHX_ "%s failed--call queue aborted",
                               paramList == PL_checkav ? "CHECK"
                               : paramList == PL_initav ? "INIT"
+                              : paramList == PL_unitcheckav ? "UNITCHECK"
                               : "END");
            }
            my_exit_jump();