In taint.t, replace calls to all_tainted() with a loop over is_tainted().

[perl5.git] / perl.c

diff --git a/perl.c b/perl.c
index 157cd6b..6bb9f46 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2,8 +2,8 @@
 /*    perl.c
  *
  *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
- *    2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 by Larry Wall
- *    and others
+ *    2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
+ *     by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -24,6 +24,10 @@
  * function of the interpreter; that can be found in perlmain.c
  */
 
+#ifdef PERL_IS_MINIPERL
+#  define USE_SITECUSTOMIZE
+#endif
+
 #include "EXTERN.h"
 #define PERL_IN_PERL_C
 #include "perl.h"
@@ -557,8 +561,10 @@ perl_destruct(pTHXx)
 
         JMPENV_PUSH(x);
        PERL_UNUSED_VAR(x);
-        if (PL_endav && !PL_minus_c)
+        if (PL_endav && !PL_minus_c) {
+           PL_phase = PERL_PHASE_END;
             call_list(PL_scopestack_ix, PL_endav);
+       }
         JMPENV_POP;
     }
     LEAVE;
@@ -751,7 +757,7 @@ perl_destruct(pTHXx)
      * destruct_level > 0 */
     SvREFCNT_dec(PL_main_cv);
     PL_main_cv = NULL;
-    PL_dirty = TRUE;
+    PL_phase = PERL_PHASE_DESTRUCT;
 
     /* Tell PerlIO we are about to tear things apart in case
        we have layers which are using resources that should
@@ -1003,6 +1009,7 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_utf8_tofold);
     SvREFCNT_dec(PL_utf8_idstart);
     SvREFCNT_dec(PL_utf8_idcont);
+    SvREFCNT_dec(PL_utf8_foldclosures);
     PL_utf8_alnum      = NULL;
     PL_utf8_ascii      = NULL;
     PL_utf8_alpha      = NULL;
@@ -1022,6 +1029,7 @@ perl_destruct(pTHXx)
     PL_utf8_tofold     = NULL;
     PL_utf8_idstart    = NULL;
     PL_utf8_idcont     = NULL;
+    PL_utf8_foldclosures = NULL;
 
     if (!specialWARN(PL_compiling.cop_warnings))
        PerlMemShared_free(PL_compiling.cop_warnings);
@@ -1465,7 +1473,7 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
 #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
     /* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0
      * This MUST be done before any hash stores or fetches take place.
-     * If you set PL_rehash_seed (and assumedly also PL_rehash_seed_set)
+     * If you set PL_rehash_seed (and presumably also PL_rehash_seed_set)
      * yourself, it is your responsibility to provide a good random seed!
      * You can also define PERL_HASH_SEED in compile time, see hv.h. */
     if (!PL_rehash_seed_set)
@@ -1603,10 +1611,13 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
     switch (ret) {
     case 0:
        parse_body(env,xsinit);
-       if (PL_unitcheckav)
+       if (PL_unitcheckav) {
            call_list(oldscope, PL_unitcheckav);
-       if (PL_checkav)
+       }
+       if (PL_checkav) {
+           PL_phase = PERL_PHASE_CHECK;
            call_list(oldscope, PL_checkav);
+       }
        ret = 0;
        break;
     case 1:
@@ -1618,10 +1629,13 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
            LEAVE;
        FREETMPS;
        PL_curstash = PL_defstash;
-       if (PL_unitcheckav)
+       if (PL_unitcheckav) {
            call_list(oldscope, PL_unitcheckav);
-       if (PL_checkav)
+       }
+       if (PL_checkav) {
+           PL_phase = PERL_PHASE_CHECK;
            call_list(oldscope, PL_checkav);
+       }
        ret = STATUS_EXIT;
        break;
     case 3:
@@ -1753,6 +1767,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     SV *linestr_sv = newSV_type(SVt_PVIV);
     bool add_read_e_script = FALSE;
 
+    PL_phase = PERL_PHASE_START;
+
     SvGROW(linestr_sv, 80);
     sv_setpvs(linestr_sv,"");
 
@@ -1961,15 +1977,26 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     }
     }
 
-#if defined(USE_SITECUSTOMIZE) && !defined(PERL_IS_MINIPERL)
+#if defined(USE_SITECUSTOMIZE)
     if (!minus_f) {
-       /* SITELIB_EXP is a function call on Win32.
-          The games with local $! are to avoid setting errno if there is no
+       /* The games with local $! are to avoid setting errno if there is no
           sitecustomize script.  */
+#  ifdef PERL_IS_MINIPERL
+       AV *const inc = GvAV(PL_incgv);
+       SV **const inc0 = inc ? av_fetch(inc, 0, FALSE) : NULL;
+
+       if (inc0) {
+           (void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav,
+                                                Perl_newSVpvf(aTHX_
+                                                              "BEGIN { do {local $!; -f '%"SVf"/buildcustomize.pl'} && do '%"SVf"/buildcustomize.pl' }", *inc0, *inc0));
+       }
+#  else
+       /* SITELIB_EXP is a function call on Win32.  */
        const char *const sitelib = SITELIB_EXP;
        (void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav,
                                             Perl_newSVpvf(aTHX_
                                                           "BEGIN { do {local $!; -f '%s/sitecustomize.pl'} && do '%s/sitecustomize.pl' }", sitelib, sitelib));
+#  endif
     }
 #endif
 
@@ -2243,8 +2270,10 @@ perl_run(pTHXx)
        FREETMPS;
        PL_curstash = PL_defstash;
        if (!(PL_exit_flags & PERL_EXIT_DESTRUCT_END) &&
-           PL_endav && !PL_minus_c)
+           PL_endav && !PL_minus_c) {
+           PL_phase = PERL_PHASE_END;
            call_list(oldscope, PL_endav);
+       }
 #ifdef MYMALLOC
        if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
            dump_mstats("after execution:  ");
@@ -2293,8 +2322,10 @@ S_run_body(pTHX_ I32 oldscope)
        }
        if (PERLDB_SINGLE && PL_DBsingle)
            sv_setiv(PL_DBsingle, 1);
-       if (PL_initav)
+       if (PL_initav) {
+           PL_phase = PERL_PHASE_INIT;
            call_list(oldscope, PL_initav);
+       }
 #ifdef PERL_DEBUG_READONLY_OPS
        Perl_pending_Slabs_to_ro(aTHX);
 #endif
@@ -2302,6 +2333,8 @@ S_run_body(pTHX_ I32 oldscope)
 
     /* do it */
 
+    PL_phase = PERL_PHASE_RUN;
+
     if (PL_restartop) {
        PL_restartjmpenv = NULL;
        PL_op = PL_restartop;
@@ -3030,11 +3063,21 @@ Perl_moreswitches(pTHX_ const char *s)
        /* The following permits -d:Mod to accepts arguments following an =
           in the fashion that -MSome::Mod does. */
        if (*s == ':' || *s == '=') {
-           const char *start = ++s;
-           const char *const end = s + strlen(s);
-           SV * const sv = newSVpvs("use Devel::");
+           const char *start;
+           const char *end;
+           SV *sv;
+
+           if (*++s == '-') {
+               ++s;
+               sv = newSVpvs("no Devel::");
+           } else {
+               sv = newSVpvs("use Devel::");
+           }
+
+           start = s;
+           end = s + strlen(s);
 
-           /* We now allow -d:Module=Foo,Bar */
+           /* We now allow -d:Module=Foo,Bar and -d:-Module */
            while(isALNUM(*s) || *s==':') ++s;
            if (*s != '=')
                sv_catpvn(sv, start, end - start);
@@ -3276,7 +3319,7 @@ Perl_moreswitches(pTHX_ const char *s)
 #endif
 
        PerlIO_printf(PerlIO_stdout(),
-                     "\n\nCopyright 1987-2010, Larry Wall\n");
+                     "\n\nCopyright 1987-2011, Larry Wall\n");
 #ifdef MSDOS
        PerlIO_printf(PerlIO_stdout(),
                      "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
@@ -4473,7 +4516,7 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
                    libdir = tempsv;
                    if (PL_tainting &&
                        (PL_uid != PL_euid || PL_gid != PL_egid)) {
-                       /* Need to taint reloccated paths if running set ID  */
+                       /* Need to taint relocated paths if running set ID  */
                        SvTAINTED_on(libdir);
                    }
                }