Move Test from ext/ to cpan/

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

diff --git a/perl.c b/perl.c
index 2c7a4c1..e595a0a 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -985,7 +985,6 @@ perl_destruct(pTHXx)
 
     /* clear utf8 character classes */
     SvREFCNT_dec(PL_utf8_alnum);
-    SvREFCNT_dec(PL_utf8_alnumc);
     SvREFCNT_dec(PL_utf8_ascii);
     SvREFCNT_dec(PL_utf8_alpha);
     SvREFCNT_dec(PL_utf8_space);
@@ -1005,7 +1004,6 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_utf8_idstart);
     SvREFCNT_dec(PL_utf8_idcont);
     PL_utf8_alnum      = NULL;
-    PL_utf8_alnumc     = NULL;
     PL_utf8_ascii      = NULL;
     PL_utf8_alpha      = NULL;
     PL_utf8_space      = NULL;
@@ -1228,16 +1226,18 @@ perl_destruct(pTHXx)
     Safefree(PL_reg_poscache);
     free_tied_hv_pool();
     Safefree(PL_op_mask);
-    Safefree(PL_psig_ptr);
-    PL_psig_ptr = (SV**)NULL;
     Safefree(PL_psig_name);
     PL_psig_name = (SV**)NULL;
-#ifdef MULTIPLICITY
-    Safefree(my_perl->Ibitcount);
-    my_perl->Ibitcount = NULL;
-#endif
+    PL_psig_ptr = (SV**)NULL;
     Safefree(PL_psig_pend);
     PL_psig_pend = (int*)NULL;
+    {
+       /* We need to NULL PL_psig_pend first, so that
+          signal handlers know not to use it */
+       int *psig_save = PL_psig_pend;
+       PL_psig_pend = (int*)NULL;
+       Safefree(psig_save);
+    }
     PL_formfeed = NULL;
     nuke_stacks();
     PL_tainting = FALSE;
@@ -1768,26 +1768,23 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #  ifdef NO_MATHOMS
                             " NO_MATHOMS"
 #  endif
+#  ifdef PERL_DISABLE_PMC
+                            " PERL_DISABLE_PMC"
+#  endif
 #  ifdef PERL_DONT_CREATE_GVSV
                             " PERL_DONT_CREATE_GVSV"
 #  endif
+#  ifdef PERL_IS_MINIPERL
+                            " PERL_IS_MINIPERL"
+#  endif
 #  ifdef PERL_MALLOC_WRAP
                             " PERL_MALLOC_WRAP"
 #  endif
 #  ifdef PERL_MEM_LOG
                             " PERL_MEM_LOG"
 #  endif
-#  ifdef PERL_MEM_LOG_ENV
-                            " PERL_MEM_LOG_ENV"
-#  endif
-#  ifdef PERL_MEM_LOG_ENV_FD
-                            " PERL_MEM_LOG_ENV_FD"
-#  endif
-#  ifdef PERL_MEM_LOG_STDERR
-                            " PERL_MEM_LOG_STDERR"
-#  endif
-#  ifdef PERL_MEM_LOG_TIMESTAMP
-                            " PERL_MEM_LOG_TIMESTAMP"
+#  ifdef PERL_MEM_LOG_NOIMPL
+                            " PERL_MEM_LOG_NOIMPL"
 #  endif
 #  ifdef PERL_USE_DEVEL
                             " PERL_USE_DEVEL"
@@ -1946,10 +1943,15 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     }
     }
 
-#ifdef USE_SITECUSTOMIZE
+#if defined(USE_SITECUSTOMIZE) && !defined(PERL_IS_MINIPERL)
     if (!minus_f) {
+       /* SITELIB_EXP is a function call on Win32.
+          The games with local $! are to avoid setting errno if there is no
+          sitecustomize script.  */
+       const char *const sitelib = SITELIB_EXP;
        (void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav,
-                                            Perl_newSVpvf(aTHX_ "BEGIN { do '%s/sitecustomize.pl' }", SITELIB_EXP));
+                                            Perl_newSVpvf(aTHX_
+                                                          "BEGIN { do {local $!; -f '%s/sitecustomize.pl'} && do '%s/sitecustomize.pl' }", sitelib, sitelib));
     }
 #endif
 
@@ -2053,6 +2055,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #if defined(__SYMBIAN32__)
     PL_unicode = PERL_UNICODE_STD_FLAG; /* See PERL_SYMBIAN_CONSOLE_UTF8. */
 #endif
+#  ifndef PERL_IS_MINIPERL
     if (PL_unicode) {
         /* Requires init_predump_symbols(). */
         if (!(PL_unicode & PERL_UNICODE_LOCALE_FLAG) || PL_utf8locale) {
@@ -2091,6 +2094,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
              }
         }
     }
+#endif
 
     {
        const char *s;
@@ -2257,8 +2261,9 @@ S_run_body(pTHX_ I32 oldscope)
            exit(0);    /* less likely to core dump than my_exit(0) */
        }
 #endif
-       DEBUG_x(dump_all());
 #ifdef DEBUGGING
+       if (DEBUG_x_TEST || DEBUG_B_TEST)
+           dump_all_perl(!DEBUG_B_TEST);
        if (!DEBUG_q_TEST)
          PERL_DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n"));
 #endif
@@ -2488,9 +2493,13 @@ Perl_call_method(pTHX_ const char *methname, I32 flags)
                                /* name of the subroutine */
                        /* See G_* flags in cop.h */
 {
+    STRLEN len;
     PERL_ARGS_ASSERT_CALL_METHOD;
 
-    return call_sv(sv_2mortal(newSVpv(methname,0)), flags | G_METHOD);
+    len = strlen(methname);
+
+    /* XXX: sv_2mortal(newSVpvn_share(methname, len)) can be faster */
+    return call_sv(newSVpvn_flags(methname, len, SVs_TEMP), flags | G_METHOD);
 }
 
 /* May be called with any of a CV, a GV, or an SV containing the name. */
@@ -2867,6 +2876,8 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
       "  C  Copy On Write",
       "  A  Consistency checks on internal structures",
       "  q  quiet - currently only suppresses the 'EXECUTING' message",
+      "  M  trace smart match resolution",
+      "  B  dump suBroutine definitions, including special Blocks like BEGIN",
       NULL
     };
     int i = 0;
@@ -2875,7 +2886,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
 
     if (isALPHA(**s)) {
        /* if adding extra options, remember to update DEBUG_MASK */
-       static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAq";
+       static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMB";
 
        for (; isALNUM(**s); (*s)++) {
            const char * const d = strchr(debopts,**s);
@@ -3278,10 +3289,6 @@ Perl_moreswitches(pTHX_ const char *s)
        PerlIO_printf(PerlIO_stdout(),
                      "BS2000 (POSIX) port by Start Amadeus GmbH, 1998-1999\n");
 #endif
-#ifdef __MINT__
-       PerlIO_printf(PerlIO_stdout(),
-                     "MiNT port by Guido Flohr, 1997-1999\n");
-#endif
 #ifdef EPOC
        PerlIO_printf(PerlIO_stdout(),
                      "EPOC port by Olaf Flebbe, 1999-2002\n");
@@ -3940,11 +3947,6 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 
     if ((tmpgv = gv_fetchpvs("0", GV_ADD|GV_NOTQUAL, SVt_PV))) {
        sv_setpv(GvSV(tmpgv),PL_origfilename);
-       {
-           GV * const gv = gv_fetchpv("0", GV_ADD, SVt_PV);
-           if (gv)
-               sv_magic(GvSV(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, "0", 1);
-       }
     }
     if ((PL_envgv = gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV))) {
        HV *hv;
@@ -4058,6 +4060,10 @@ S_init_perllib(pTHX)
 #endif /* VMS */
     }
 
+#ifndef PERL_IS_MINIPERL
+    /* miniperl gets just -I..., the split of $ENV{PERL5LIB}, and "." in @INC
+       (and not the architecture specific directories from $ENV{PERL5LIB}) */
+
 /* Use the ~-expanded versions of APPLLIB (undocumented),
     ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB
 */
@@ -4188,6 +4194,7 @@ S_init_perllib(pTHX)
                      INCPUSH_ADD_OLD_VERS|INCPUSH_ADD_ARCHONLY_SUB_DIRS
                      |INCPUSH_CAN_RELOCATE);
 #endif
+#endif /* !PERL_IS_MINIPERL */
 
     if (!PL_tainting)
        S_incpush(aTHX_ STR_WITH_LEN("."), 0);