Upgrade to Pod-Simple-3.04
[p5sagit/p5-mst-13.2.git] / toke.c
diff --git a/toke.c b/toke.c
index 139a121..12f7ace 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -844,7 +844,7 @@ S_skipspace(pTHX_ register char *s)
         * so store the line into the debugger's array of lines
         */
        if (PERLDB_LINE && PL_curstash != PL_debstash) {
-           SV * const sv = NEWSV(85,0);
+           SV * const sv = newSV(0);
 
            sv_upgrade(sv, SVt_PVMG);
            sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
@@ -878,6 +878,9 @@ S_check_uni(pTHX)
     for (s = PL_last_uni; isALNUM_lazy_if(s,UTF) || *s == '-'; s++) ;
     if ((t = strchr(s, '(')) && t < PL_bufptr)
        return;
+
+    /* XXX Things like this are just so nasty.  We shouldn't be modifying
+    source code, even if we realquick set it back. */
     if (ckWARN_d(WARN_AMBIGUOUS)){
        const char ch = *s;
         *s = '\0';
@@ -1436,7 +1439,7 @@ S_scan_const(pTHX_ char *start)
 {
     dVAR;
     register char *send = PL_bufend;           /* end of the constant */
-    SV *sv = NEWSV(93, send - start);          /* sv for the constant */
+    SV *sv = newSV(send - start);              /* sv for the constant */
     register char *s = start;                  /* start of the constant */
     register char *d = SvPVX(sv);              /* destination for copies */
     bool dorange = FALSE;                      /* are we in a translit range? */
@@ -2234,7 +2237,7 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
     if (!PL_rsfp_filters)
        PL_rsfp_filters = newAV();
     if (!datasv)
-       datasv = NEWSV(255,0);
+       datasv = newSV(0);
     SvUPGRADE(datasv, SVt_PVIO);
     IoANY(datasv) = FPTR2DPTR(void *, funcp); /* stash funcp into spare field */
     IoFLAGS(datasv) |= IOf_FAKE_DIRP;
@@ -2750,7 +2753,7 @@ Perl_yylex(pTHX)
            PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
            PL_last_lop = PL_last_uni = Nullch;
            if (PERLDB_LINE && PL_curstash != PL_debstash) {
-               SV * const sv = NEWSV(85,0);
+               SV * const sv = newSV(0);
 
                sv_upgrade(sv, SVt_PVMG);
                sv_setsv(sv,PL_linestr);
@@ -2837,7 +2840,7 @@ Perl_yylex(pTHX)
        } while (PL_doextract);
        PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
        if (PERLDB_LINE && PL_curstash != PL_debstash) {
-           SV * const sv = NEWSV(85,0);
+           SV * const sv = newSV(0);
 
            sv_upgrade(sv, SVt_PVMG);
            sv_setsv(sv,PL_linestr);
@@ -2982,15 +2985,15 @@ Perl_yylex(pTHX)
                }
 #endif
                if (d) {
-                   const U32 oldpdb = PL_perldb;
-                   const bool oldn = PL_minus_n;
-                   const bool oldp = PL_minus_p;
-
                    while (*d && !isSPACE(*d)) d++;
                    while (SPACE_OR_TAB(*d)) d++;
 
                    if (*d++ == '-') {
                        const bool switches_done = PL_doswitches;
+                       const U32 oldpdb = PL_perldb;
+                       const bool oldn = PL_minus_n;
+                       const bool oldp = PL_minus_p;
+
                        do {
                            if (*d == 'M' || *d == 'm' || *d == 'C') {
                                const char * const m = d;
@@ -4205,7 +4208,7 @@ Perl_yylex(pTHX)
            else if (gv && !gvp
                     && -tmp==KEY_lock  /* XXX generalizable kludge */
                     && GvCVu(gv)
-                    && !hv_fetch(GvHVn(PL_incgv), "Thread.pm", 9, FALSE))
+                    && !hv_fetchs(GvHVn(PL_incgv), "Thread.pm", FALSE))
            {
                tmp = 0;                /* any sub overrides "weak" keyword */
            }
@@ -4237,6 +4240,7 @@ Perl_yylex(pTHX)
            just_a_word_zero_gv:
                gv = NULL;
                gvp = NULL;
+               orig_keyword = 0;
            }
          just_a_word: {
                SV *sv;
@@ -5803,21 +5807,21 @@ S_pending_ident(pTHX)
     yylval.opval->op_private = OPpCONST_ENTERED;
     gv_fetchpv(
            PL_tokenbuf+1,
-           PL_in_eval
-               ? (GV_ADDMULTI | GV_ADDINEVAL)
-               /* If the identifier refers to a stash, don't autovivify it.
-                * Change 24660 had the side effect of causing symbol table
-                * hashes to always be defined, even if they were freshly
-                * created and the only reference in the entire program was
-                * the single statement with the defined %foo::bar:: test.
-                * It appears that all code in the wild doing this actually
-                * wants to know whether sub-packages have been loaded, so
-                * by avoiding auto-vivifying symbol tables, we ensure that
-                * defined %foo::bar:: continues to be false, and the existing
-                * tests still give the expected answers, even though what
-                * they're actually testing has now changed subtly.
-                */
-               : !(*PL_tokenbuf == '%' && *(d = PL_tokenbuf + strlen(PL_tokenbuf) - 1) == ':' && d[-1] == ':'),
+           /* If the identifier refers to a stash, don't autovivify it.
+            * Change 24660 had the side effect of causing symbol table
+            * hashes to always be defined, even if they were freshly
+            * created and the only reference in the entire program was
+            * the single statement with the defined %foo::bar:: test.
+            * It appears that all code in the wild doing this actually
+            * wants to know whether sub-packages have been loaded, so
+            * by avoiding auto-vivifying symbol tables, we ensure that
+            * defined %foo::bar:: continues to be false, and the existing
+            * tests still give the expected answers, even though what
+            * they're actually testing has now changed subtly.
+            */
+           (*PL_tokenbuf == '%' && *(d = PL_tokenbuf + strlen(PL_tokenbuf) - 1) == ':' && d[-1] == ':'
+            ? 0
+            : PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD),
            ((PL_tokenbuf[0] == '$') ? SVt_PV
             : (PL_tokenbuf[0] == '@') ? SVt_PVAV
             : SVt_PVHV));
@@ -9384,15 +9388,13 @@ STATIC char *
 S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRLEN destlen, I32 ck_uni)
 {
     dVAR;
-    register char *d;
-    register char *e;
-    char *bracket = Nullch;
+    char *bracket = NULL;
     char funny = *s++;
+    register char *d = dest;
+    register char * const e = d + destlen + 3;    /* two-character token, ending NUL */
 
     if (isSPACE(*s))
        s = skipspace(s);
-    d = dest;
-    e = d + destlen - 3;       /* two-character token, ending NUL */
     if (isDIGIT(*s)) {
        while (isDIGIT(*s)) {
            if (d >= e)
@@ -9467,15 +9469,15 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL
        if (isIDFIRST_lazy_if(d,UTF)) {
            d++;
            if (UTF) {
-               e = s;
-               while ((e < send && isALNUM_lazy_if(e,UTF)) || *e == ':') {
-                   e += UTF8SKIP(e);
-                   while (e < send && UTF8_IS_CONTINUED(*e) && is_utf8_mark((U8*)e))
-                       e += UTF8SKIP(e);
+               char *end = s;
+               while ((end < send && isALNUM_lazy_if(end,UTF)) || *end == ':') {
+                   end += UTF8SKIP(end);
+                   while (end < send && UTF8_IS_CONTINUED(*end) && is_utf8_mark((U8*)end))
+                       end += UTF8SKIP(end);
                }
-               Copy(s, d, e - s, char);
-               d += e - s;
-               s = e;
+               Copy(s, d, end - s, char);
+               d += end - s;
+               s = end;
            }
            else {
                while ((isALNUM(*s) || *s == ':') && d < e)
@@ -9563,9 +9565,10 @@ S_scan_pat(pTHX_ char *start, I32 type)
     dVAR;
     PMOP *pm;
     char *s = scan_str(start,FALSE,FALSE);
+    const char * const valid_flags = (type == OP_QR) ? "iomsx" : "iogcmsx";
 
     if (!s) {
-       char * const delimiter = skipspace(start);
+       const char * const delimiter = skipspace(start);
        Perl_croak(aTHX_ *delimiter == '?'
                   ? "Search pattern not terminated or ternary operator parsed as search pattern"
                   : "Search pattern not terminated" );
@@ -9574,14 +9577,8 @@ S_scan_pat(pTHX_ char *start, I32 type)
     pm = (PMOP*)newPMOP(type, 0);
     if (PL_multi_open == '?')
        pm->op_pmflags |= PMf_ONCE;
-    if(type == OP_QR) {
-       while (*s && strchr("iomsx", *s))
-           pmflag(&pm->op_pmflags,*s++);
-    }
-    else {
-       while (*s && strchr("iogcmsx", *s))
-           pmflag(&pm->op_pmflags,*s++);
-    }
+    while (*s && strchr(valid_flags, *s))
+       pmflag(&pm->op_pmflags,*s++);
     /* issue a warning if /c is specified,but /g is not */
     if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL)
            && ckWARN(WARN_REGEXP))
@@ -9643,12 +9640,12 @@ S_scan_subst(pTHX_ char *start)
     }
 
     if (es) {
-       SV *repl;
+       SV * const repl = newSVpvs("");
+
        PL_sublex_info.super_bufptr = s;
        PL_sublex_info.super_bufend = PL_bufend;
        PL_multi_end = 0;
        pm->op_pmflags |= PMf_EVAL;
-       repl = newSVpvs("");
        while (es-- > 0)
            sv_catpv(repl, es ? "eval " : "do ");
        sv_catpvs(repl, "{ ");
@@ -9803,7 +9800,7 @@ S_scan_heredoc(pTHX_ register char *s)
     }
     s += SvCUR(herewas);
 
-    tmpstr = NEWSV(87,79);
+    tmpstr = newSV(79);
     sv_upgrade(tmpstr, SVt_PVIV);
     if (term == '\'') {
        op_type = OP_CONST;
@@ -9819,8 +9816,8 @@ S_scan_heredoc(pTHX_ register char *s)
     PL_multi_open = PL_multi_close = '<';
     term = *PL_tokenbuf;
     if (PL_lex_inwhat == OP_SUBST && PL_in_eval && !PL_rsfp) {
-       char *bufptr = PL_sublex_info.super_bufptr;
-       char *bufend = PL_sublex_info.super_bufend;
+       char * const bufptr = PL_sublex_info.super_bufptr;
+       char * const bufend = PL_sublex_info.super_bufend;
        char * const olds = s - SvCUR(herewas);
        s = strchr(bufptr, '\n');
        if (!s)
@@ -9892,7 +9889,7 @@ S_scan_heredoc(pTHX_ register char *s)
            PL_bufend[-1] = '\n';
 #endif
        if (PERLDB_LINE && PL_curstash != PL_debstash) {
-           SV *sv = NEWSV(88,0);
+           SV * const sv = newSV(0);
 
            sv_upgrade(sv, SVt_PVMG);
            sv_setsv(sv,PL_linestr);
@@ -9951,13 +9948,12 @@ S_scan_inputsymbol(pTHX_ char *start)
 {
     dVAR;
     register char *s = start;          /* current position in buffer */
-    register char *d;
-    const char *e;
     char *end;
     I32 len;
 
-    d = PL_tokenbuf;                   /* start of temp holding space */
-    e = PL_tokenbuf + sizeof PL_tokenbuf;      /* end of temp holding space */
+    char *d = PL_tokenbuf;                                     /* start of temp holding space */
+    const char * const e = PL_tokenbuf + sizeof PL_tokenbuf;   /* end of temp holding space */
+
     end = strchr(s, '\n');
     if (!end)
        end = PL_bufend;
@@ -10003,7 +9999,7 @@ S_scan_inputsymbol(pTHX_ char *start)
     }
     else {
        bool readline_overriden = FALSE;
-       GV *gv_readline = Nullgv;
+       GV *gv_readline;
        GV **gvp;
        /* we're in a filehandle read situation */
        d = PL_tokenbuf;
@@ -10013,10 +10009,11 @@ S_scan_inputsymbol(pTHX_ char *start)
            Copy("ARGV",d,5,char);
 
        /* Check whether readline() is overriden */
-       if (((gv_readline = gv_fetchpv("readline", 0, SVt_PVCV))
+       gv_readline = gv_fetchpv("readline", 0, SVt_PVCV);
+       if ((gv_readline
                && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))
                ||
-               ((gvp = (GV**)hv_fetch(PL_globalstash, "readline", 8, FALSE))
+               ((gvp = (GV**)hv_fetchs(PL_globalstash, "readline", FALSE))
                && (gv_readline = *gvp) != (GV*)&PL_sv_undef
                && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline)))
            readline_overriden = TRUE;
@@ -10032,16 +10029,16 @@ S_scan_inputsymbol(pTHX_ char *start)
            */
            if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
                if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
-                   HV *stash = PAD_COMPNAME_OURSTASH(tmp);
-                   HEK *stashname = HvNAME_HEK(stash);
-                   SV *sym = sv_2mortal(newSVhek(stashname));
+                   HV * const stash = PAD_COMPNAME_OURSTASH(tmp);
+                   HEK * const stashname = HvNAME_HEK(stash);
+                   SV * const sym = sv_2mortal(newSVhek(stashname));
                    sv_catpvs(sym, "::");
                    sv_catpv(sym, d+1);
                    d = SvPVX(sym);
                    goto intro_sym;
                }
                else {
-                   OP *o = newOP(OP_PADSV, 0);
+                   OP * const o = newOP(OP_PADSV, 0);
                    o->op_targ = tmp;
                    PL_lex_op = readline_overriden
                        ? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
@@ -10077,7 +10074,7 @@ intro_sym:
        /* If it's none of the above, it must be a literal filehandle
           (<Foo::BAR> or <FOO>) so build a simple readline OP */
        else {
-           GV *gv = gv_fetchpv(d, GV_ADD, SVt_PVIO);
+           GV * const gv = gv_fetchpv(d, GV_ADD, SVt_PVIO);
            PL_lex_op = readline_overriden
                ? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
                        append_elem(OP_LIST,
@@ -10181,9 +10178,9 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 
     PL_multi_close = term;
 
-    /* create a new SV to hold the contents.  87 is leak category, I'm
-       assuming.  79 is the SV's initial length.  What a random number. */
-    sv = NEWSV(87,79);
+    /* create a new SV to hold the contents.  79 is the SV's initial length.
+       What a random number. */
+    sv = newSV(79);
     sv_upgrade(sv, SVt_PVIV);
     SvIV_set(sv, termcode);
     (void)SvPOK_only(sv);              /* validate pointer */
@@ -10200,8 +10197,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
                int offset = s - SvPVX_const(PL_linestr);
                const bool found = sv_cat_decode(sv, PL_encoding, PL_linestr,
                                           &offset, (char*)termstr, termlen);
-               const char *ns = SvPVX_const(PL_linestr) + offset;
-               char *svlast = SvEND(sv) - 1;
+               const char * const ns = SvPVX_const(PL_linestr) + offset;
+               char * const svlast = SvEND(sv) - 1;
 
                for (; s < ns; s++) {
                    if (*s == '\n' && !PL_rsfp)
@@ -10367,7 +10364,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 
        /* update debugger info */
        if (PERLDB_LINE && PL_curstash != PL_debstash) {
-           SV * const sv = NEWSV(88,0);
+           SV * const sv = newSV(0);
 
            sv_upgrade(sv, SVt_PVMG);
            sv_setsv(sv,PL_linestr);
@@ -10605,7 +10602,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
                    Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number");
            }
 
-           sv = NEWSV(92,0);
+           sv = newSV(0);
            if (overflowed) {
                if (n > 4294967295.0 && ckWARN(WARN_PORTABLE))
                    Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
@@ -10758,7 +10755,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
 
 
        /* make an sv from the string */
-       sv = NEWSV(92,0);
+       sv = newSV(0);
 
        /*
            We try to do an integer conversion first if no characters
@@ -10767,7 +10764,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
 
        if (!floatit) {
            UV uv;
-            int flags = grok_number (PL_tokenbuf, d - PL_tokenbuf, &uv);
+           const int flags = grok_number (PL_tokenbuf, d - PL_tokenbuf, &uv);
 
             if (flags == IS_NUMBER_IN_UV) {
               if (uv <= IV_MAX)
@@ -10799,7 +10796,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
     /* if it starts with a v, it could be a v-string */
     case 'v':
 vstring:
-               sv = NEWSV(92,5); /* preallocate storage space */
+               sv = newSV(5); /* preallocate storage space */
                s = scan_vstring(s,sv);
        break;
     }
@@ -10820,7 +10817,7 @@ S_scan_formline(pTHX_ register char *s)
     dVAR;
     register char *eol;
     register char *t;
-    SV *stuff = newSVpvs("");
+    SV * const stuff = newSVpvs("");
     bool needargs = FALSE;
     bool eofmt = FALSE;
 
@@ -10924,7 +10921,7 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
 {
     dVAR;
     const I32 oldsavestack_ix = PL_savestack_ix;
-    CV* outsidecv = PL_compcv;
+    CV* const outsidecv = PL_compcv;
 
     if (PL_compcv) {
        assert(SvTYPE(PL_compcv) == SVt_PVCV);
@@ -10933,7 +10930,7 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
     save_item(PL_subname);
     SAVESPTR(PL_compcv);
 
-    PL_compcv = (CV*)NEWSV(1104,0);
+    PL_compcv = (CV*)newSV(0);
     sv_upgrade((SV *)PL_compcv, is_format ? SVt_PVFM : SVt_PVCV);
     CvFLAGS(PL_compcv) |= flags;
 
@@ -11014,7 +11011,7 @@ Perl_yyerror(pTHX_ const char *s)
            where = "within string";
     }
     else {
-       SV *where_sv = sv_2mortal(newSVpvs("next char "));
+       SV * const where_sv = sv_2mortal(newSVpvs("next char "));
        if (yychar < 32)
            Perl_sv_catpvf(aTHX_ where_sv, "^%c", toCTRL(yychar));
        else if (isPRINT_LC(yychar))
@@ -11221,7 +11218,7 @@ vstring, as well as updating the passed in sv.
 
 Function must be called like
 
-       sv = NEWSV(92,5);
+       sv = newSV(5);
        s = scan_vstring(s,sv);
 
 The sv should already be large enough to store the vstring