Fix regexec.c so $^N and $+ are correctly updated so that they work properly inside...

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

diff --git a/perl.c b/perl.c
index 3371b84..abebfa6 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -187,6 +187,7 @@ S_init_tls_and_interp(PerlInterpreter *my_perl)
 void
 Perl_sys_init(int* argc, char*** argv)
 {
+    dVAR;
     PERL_UNUSED_ARG(argc); /* may not be used depending on _BODY macro */
     PERL_UNUSED_ARG(argv);
     PERL_SYS_INIT_BODY(argc, argv);
@@ -195,6 +196,7 @@ Perl_sys_init(int* argc, char*** argv)
 void
 Perl_sys_init3(int* argc, char*** argv, char*** env)
 {
+    dVAR;
     PERL_UNUSED_ARG(argc); /* may not be used depending on _BODY macro */
     PERL_UNUSED_ARG(argv);
     PERL_UNUSED_ARG(env);
@@ -202,8 +204,9 @@ Perl_sys_init3(int* argc, char*** argv, char*** env)
 }
 
 void
-Perl_sys_term(pTHX)
+Perl_sys_term()
 {
+    dVAR;
     if (!PL_veto_cleanup) {
        PERL_SYS_TERM_BODY();
     }
@@ -560,7 +563,7 @@ int
 perl_destruct(pTHXx)
 {
     dVAR;
-    VOL int destruct_level;  /* 0=none, 1=full, 2=full with checks */
+    VOL signed char destruct_level;  /* see possible values in intrpvar.h */
     HV *hv;
 #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
     pid_t child;
@@ -1686,7 +1689,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     VOL bool dosearch = FALSE;
     const char *validarg = "";
     register SV *sv;
-    register char *s, c;
+    register char c;
     const char *cddir = NULL;
 #ifdef USE_SITECUSTOMIZE
     bool minus_f = FALSE;
@@ -1701,6 +1704,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     SAVEFREESV(sv);
     init_main_stash();
 
+    {
+       const char *s;
     for (argc--,argv++; argc > 0; argc--,argv++) {
        if (argv[0][0] != '-' || !argv[0][1])
            break;
@@ -1953,8 +1958,13 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            Perl_croak(aTHX_ "Unrecognized switch: -%s  (-h will show valid options)",s);
        }
     }
+    }
+
   switch_end:
 
+    {
+       char *s;
+
     if (
 #ifndef SECURE_INTERNAL_GETENV
         !PL_tainting &&
@@ -1983,7 +1993,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                d = s;
                if (!*s)
                    break;
-               if (!strchr("CDIMUdmtwA", *s))
+               if (!strchr("CDIMUdmtw", *s))
                    Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
                while (++s && *s) {
                    if (isSPACE(*s)) {
@@ -2007,6 +2017,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            }
        }
     }
+    }
 
 #ifdef USE_SITECUSTOMIZE
     if (!minus_f) {
@@ -2159,6 +2170,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
         }
     }
 
+    {
+       const char *s;
     if ((s = PerlEnv_getenv("PERL_SIGNALS"))) {
         if (strEQ(s, "unsafe"))
              PL_signals |=  PERL_SIGNALS_UNSAFE_FLAG;
@@ -2167,8 +2180,11 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
         else
              Perl_croak(aTHX_ "PERL_SIGNALS illegal: \"%s\"", s);
     }
+    }
 
 #ifdef PERL_MAD
+    {
+       const char *s;
     if ((s = PerlEnv_getenv("PERL_XMLDUMP"))) {
        PL_madskills = 1;
        PL_minus_c = 1;
@@ -2179,11 +2195,16 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            if (!PL_xmlfp)
                Perl_croak(aTHX_ "Can't open %s", s);
        }
-       my_setenv("PERL_XMLDUMP", Nullch);      /* hide from subprocs */
+       my_setenv("PERL_XMLDUMP", NULL);        /* hide from subprocs */
+    }
     }
+
+    {
+       const char *s;
     if ((s = PerlEnv_getenv("PERL_MADSKILLS"))) {
        PL_madskills = atoi(s);
-       my_setenv("PERL_MADSKILLS", Nullch);    /* hide from subprocs */
+       my_setenv("PERL_MADSKILLS", NULL);      /* hide from subprocs */
+    }
     }
 #endif
 
@@ -2236,8 +2257,11 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     FREETMPS;
 
 #ifdef MYMALLOC
+    {
+       const char *s;
     if ((s=PerlEnv_getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2)
        dump_mstats("after compilation:");
+    }
 #endif
 
     ENTER;
@@ -2457,8 +2481,7 @@ Perl_get_cvn_flags(pTHX_ const char *name, STRLEN len, I32 flags)
      * It has the same effect as "sub name;", i.e. just a forward
      * declaration! */
     if ((flags & ~GV_NOADD_MASK) && !GvCVu(gv)) {
-       SV *const sv = newSVpvn(name,len);
-       SvFLAGS(sv) |= flags & SVf_UTF8;
+       SV *const sv = newSVpvn_flags(name, len, flags & SVf_UTF8);
        return newSUB(start_subparse(FALSE, 0),
                      newSVOP(OP_CONST, 0, sv),
                      NULL, NULL);
@@ -2499,7 +2522,7 @@ Perl_call_argv(pTHX_ const char *sub_name, I32 flags, register char **argv)
     PUSHMARK(SP);
     if (argv) {
        while (*argv) {
-           XPUSHs(sv_2mortal(newSVpv(*argv,0)));
+           mXPUSHs(newSVpv(*argv,0));
            argv++;
        }
        PUTBACK;
@@ -2944,8 +2967,8 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
 
 /* This routine handles any switches that can be given during run */
 
-char *
-Perl_moreswitches(pTHX_ char *s)
+const char *
+Perl_moreswitches(pTHX_ const char *s)
 {
     dVAR;
     UV rschar;
@@ -3026,20 +3049,21 @@ Perl_moreswitches(pTHX_ 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;
+           const char *start = ++s;
+           const char *const end = s + strlen(s);
            SV * const sv = newSVpvs("use Devel::");
-           start = ++s;
+
            /* We now allow -d:Module=Foo,Bar */
            while(isALNUM(*s) || *s==':') ++s;
            if (*s != '=')
-               sv_catpv(sv, start);
+               sv_catpvn(sv, start, end - start);
            else {
                sv_catpvn(sv, start, s-start);
                /* Don't use NUL as q// delimiter here, this string goes in the
                 * environment. */
                Perl_sv_catpvf(aTHX_ sv, " split(/,/,q{%s});", ++s);
            }
-           s += strlen(s);
+           s = end;
            my_setenv("PERL5DB", SvPV_nolen_const(sv));
            SvREFCNT_dec(sv);
        }
@@ -3092,7 +3116,7 @@ Perl_moreswitches(pTHX_ char *s)
        while (*s && isSPACE(*s))
            ++s;
        if (*s) {
-           char *e, *p;
+           const char *e, *p;
            p = s;
            /* ignore trailing spaces (possibly followed by other switches) */
            do {
@@ -3141,7 +3165,8 @@ Perl_moreswitches(pTHX_ char *s)
     case 'm':
        forbid_setid('m', -1);  /* XXX ? */
        if (*++s) {
-           char *start;
+           const char *start;
+           const char *end;
            SV *sv;
            const char *use = "use ";
            /* -M-foo == 'no foo'       */
@@ -3152,8 +3177,9 @@ Perl_moreswitches(pTHX_ char *s)
            start = s;
            /* We allow -M'Module qw(Foo Bar)'  */
            while(isALNUM(*s) || *s==':') ++s;
+           end = s + strlen(s);
            if (*s != '=') {
-               sv_catpv(sv, start);
+               sv_catpvn(sv, start, end - start);
                if (*(start-1) == 'm') {
                    if (*s != '\0')
                        Perl_croak(aTHX_ "Can't use '%c' after -mname", *s);
@@ -3164,12 +3190,13 @@ Perl_moreswitches(pTHX_ char *s)
                     Perl_croak(aTHX_ "Module name required with -%c option",
                               s[-1]);
                sv_catpvn(sv, start, s-start);
-               sv_catpvs(sv, " split(/,/,q");
-               sv_catpvs(sv, "\0");        /* Use NUL as q//-delimiter. */
-               sv_catpv(sv, ++s);
+               /* Use NUL as q''-delimiter.  */
+               sv_catpvs(sv, " split(/,/,q\0");
+               ++s;
+               sv_catpvn(sv, s, end - s);
                sv_catpvs(sv,  "\0)");
            }
-           s += strlen(s);
+           s = end;
            Perl_av_create_and_push(aTHX_ &PL_preambleav, sv);
        }
        else
@@ -4251,7 +4278,7 @@ STATIC void
 S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp)
 {
     dVAR;
-    register char *s;
+    const char *s;
     register const char *s2;
 #ifdef MACOS_TRADITIONAL
     int maclines = 0;
@@ -4925,7 +4952,8 @@ S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep,
                   SvPOK() won't be true.  */
                assert(caret_X);
                assert(SvPOKp(caret_X));
-               prefix_sv = newSVpvn(SvPVX(caret_X), SvCUR(caret_X));
+               prefix_sv = newSVpvn_flags(SvPVX(caret_X), SvCUR(caret_X),
+                                          SvUTF8(caret_X));
                /* Firstly take off the leading .../
                   If all else fail we'll do the paths relative to the current
                   directory.  */