Upgrade to Test::Simple 0.61
[p5sagit/p5-mst-13.2.git] / toke.c
diff --git a/toke.c b/toke.c
index 76bfc9a..93623f6 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -283,7 +283,7 @@ S_tokereport(pTHX_ const char* s, I32 rv)
        const char *name = Nullch;
        enum token_type type = TOKENTYPE_NONE;
        const struct debug_tokens *p;
-       SV* report = newSVpvn("<== ", 4);
+       SV* const report = newSVpvn("<== ", 4);
 
        for (p = debug_tokens; p->token; p++) {
            if (p->token == (int)rv) {
@@ -375,8 +375,8 @@ S_ao(pTHX_ int toketype)
 STATIC void
 S_no_op(pTHX_ const char *what, char *s)
 {
-    char *oldbp = PL_bufptr;
-    bool is_first = (PL_oldbufptr == PL_linestart);
+    char * const oldbp = PL_bufptr;
+    const bool is_first = (PL_oldbufptr == PL_linestart);
 
     if (!s)
        s = oldbp;
@@ -419,7 +419,7 @@ S_missingterm(pTHX_ char *s)
     char tmpbuf[3];
     char q;
     if (s) {
-       char *nl = strrchr(s,'\n');
+       char * const nl = strrchr(s,'\n');
        if (nl)
            *nl = '\0';
     }
@@ -492,7 +492,7 @@ static void
 strip_return(SV *sv)
 {
     register const char *s = SvPVX_const(sv);
-    register const char *e = s + SvCUR(sv);
+    register const char * const e = s + SvCUR(sv);
     /* outer loop optimized to do nothing if there are no CR-LFs */
     while (s < e) {
        if (*s++ == '\r' && *s == '\n') {
@@ -570,8 +570,8 @@ Perl_lex_start(pTHX_ SV *line)
     PL_lex_defer = 0;
     PL_expect = XSTATE;
     PL_lex_brackets = 0;
-    New(899, PL_lex_brackstack, 120, char);
-    New(899, PL_lex_casestack, 12, char);
+    Newx(PL_lex_brackstack, 120, char);
+    Newx(PL_lex_casestack, 12, char);
     PL_lex_casemods = 0;
     *PL_lex_casestack = '\0';
     PL_lex_dojoin = 0;
@@ -664,6 +664,43 @@ S_incline(pTHX_ char *s)
     ch = *t;
     *t = '\0';
     if (t - s > 0) {
+#ifndef USE_ITHREADS
+       const char *cf = CopFILE(PL_curcop);
+       if (cf && strlen(cf) > 7 && strnEQ(cf, "(eval ", 6)) {
+           /* must copy *{"::_<(eval N)[oldfilename:L]"}
+            * to *{"::_<newfilename"} */
+           char smallbuf[256], smallbuf2[256];
+           char *tmpbuf, *tmpbuf2;
+           GV **gvp, *gv2;
+           STRLEN tmplen = strlen(cf);
+           STRLEN tmplen2 = strlen(s);
+           if (tmplen + 3 < sizeof smallbuf)
+               tmpbuf = smallbuf;
+           else
+               Newx(tmpbuf, tmplen + 3, char);
+           if (tmplen2 + 3 < sizeof smallbuf2)
+               tmpbuf2 = smallbuf2;
+           else
+               Newx(tmpbuf2, tmplen2 + 3, char);
+           tmpbuf[0] = tmpbuf2[0] = '_';
+           tmpbuf[1] = tmpbuf2[1] = '<';
+           memcpy(tmpbuf + 2, cf, ++tmplen);
+           memcpy(tmpbuf2 + 2, s, ++tmplen2);
+           ++tmplen; ++tmplen2;
+           gvp = (GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, FALSE);
+           if (gvp) {
+               gv2 = *(GV**)hv_fetch(PL_defstash, tmpbuf2, tmplen2, TRUE);
+               if (!isGV(gv2))
+                   gv_init(gv2, PL_defstash, tmpbuf2, tmplen2, FALSE);
+               /* adjust ${"::_<newfilename"} to store the new file name */
+               GvSV(gv2) = newSVpvn(tmpbuf2 + 2, tmplen2 - 2);
+               GvHV(gv2) = (HV*)SvREFCNT_inc(GvHV(*gvp));
+               GvAV(gv2) = (AV*)SvREFCNT_inc(GvAV(*gvp));
+           }
+           if (tmpbuf != smallbuf) Safefree(tmpbuf);
+           if (tmpbuf2 != smallbuf2) Safefree(tmpbuf2);
+       }
+#endif
        CopFILE_free(PL_curcop);
        CopFILE_set(PL_curcop, s);
     }
@@ -778,7 +815,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 *sv = NEWSV(85,0);
+           SV * const sv = NEWSV(85,0);
 
            sv_upgrade(sv, SVt_PVMG);
            sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
@@ -812,7 +849,7 @@ S_check_uni(pTHX)
     if ((t = strchr(s, '(')) && t < PL_bufptr)
        return;
     if (ckWARN_d(WARN_AMBIGUOUS)){
-        char ch = *s;
+       const char ch = *s;
         *s = '\0';
         Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
                   "Warning: Use of \"%s\" without parentheses is ambiguous",
@@ -880,7 +917,7 @@ S_force_next(pTHX_ I32 type)
 STATIC SV *
 S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len)
 {
-    SV *sv = newSVpvn(start,len);
+    SV * const sv = newSVpvn(start,len);
     if (UTF && !IN_BYTES && is_utf8_string((const U8*)start, len))
        SvUTF8_on(sv);
     return sv;
@@ -972,7 +1009,7 @@ Perl_str_to_version(pTHX_ SV *sv)
     NV nshift = 1.0;
     STRLEN len;
     const char *start = SvPV_const(sv,len);
-    const char *end = start + len;
+    const char * const end = start + len;
     const bool utf = SvUTF8(sv) ? TRUE : FALSE;
     while (start < end) {
        STRLEN skip;
@@ -1206,8 +1243,8 @@ S_sublex_push(pTHX)
 
     PL_lex_dojoin = FALSE;
     PL_lex_brackets = 0;
-    New(899, PL_lex_brackstack, 120, char);
-    New(899, PL_lex_casestack, 12, char);
+    Newx(PL_lex_brackstack, 120, char);
+    Newx(PL_lex_casestack, 12, char);
     PL_lex_casemods = 0;
     *PL_lex_casestack = '\0';
     PL_lex_starts = 0;
@@ -1233,7 +1270,7 @@ S_sublex_done(pTHX)
 {
     dVAR;
     if (!PL_lex_starts++) {
-       SV *sv = newSVpvn("",0);
+       SV * const sv = newSVpvn("",0);
        if (SvUTF8(PL_linestr))
            SvUTF8_on(sv);
        PL_expect = XOPERATOR;
@@ -1368,6 +1405,9 @@ S_scan_const(pTHX_ char *start)
     I32  has_utf8 = FALSE;                     /* Output constant is UTF8 */
     I32  this_utf8 = UTF;                      /* The source string is assumed to be UTF8 */
     UV uv;
+#ifdef EBCDIC
+    UV literal_endpoint = 0;
+#endif
 
     const char *leaveit =      /* set of acceptably-backslashed characters */
        PL_lex_inpat
@@ -1391,7 +1431,7 @@ S_scan_const(pTHX_ char *start)
                I32 max;                        /* last character in range */
 
                if (has_utf8) {
-                   char *c = (char*)utf8_hop((U8*)d, -1);
+                   char * const c = (char*)utf8_hop((U8*)d, -1);
                    char *e = d++;
                    while (e-- > c)
                        *(e + 1) = *e;
@@ -1417,8 +1457,9 @@ S_scan_const(pTHX_ char *start)
                 }
 
 #ifdef EBCDIC
-               if ((isLOWER(min) && isLOWER(max)) ||
-                   (isUPPER(min) && isUPPER(max))) {
+               if (literal_endpoint == 2 &&
+                   ((isLOWER(min) && isLOWER(max)) ||
+                    (isUPPER(min) && isUPPER(max)))) {
                    if (isLOWER(min)) {
                        for (i = min; i <= max; i++)
                            if (isLOWER(i))
@@ -1437,6 +1478,9 @@ S_scan_const(pTHX_ char *start)
                /* mark the range as done, and continue */
                dorange = FALSE;
                didrange = TRUE;
+#ifdef EBCDIC
+               literal_endpoint = 0;
+#endif
                continue;
            }
 
@@ -1455,6 +1499,9 @@ S_scan_const(pTHX_ char *start)
            }
            else {
                didrange = FALSE;
+#ifdef EBCDIC
+               literal_endpoint = 0;
+#endif
            }
        }
 
@@ -1555,9 +1602,9 @@ S_scan_const(pTHX_ char *start)
                /* FALL THROUGH */
            default:
                {
-                   if (ckWARN(WARN_MISC) &&
-                       isALNUM(*s) &&
-                       *s != '_')
+                   if (isALNUM(*s) &&
+                       *s != '_' &&
+                       ckWARN(WARN_MISC))
                        Perl_warner(aTHX_ packWARN(WARN_MISC),
                               "Unrecognized escape \\%c passed through",
                               *s);
@@ -1580,7 +1627,7 @@ S_scan_const(pTHX_ char *start)
            case 'x':
                ++s;
                if (*s == '{') {
-                   char* e = strchr(s, '}');
+                   char* const e = strchr(s, '}');
                     I32 flags = PERL_SCAN_ALLOW_UNDERSCORES |
                       PERL_SCAN_DISALLOW_PREFIX;
                    STRLEN len;
@@ -1629,7 +1676,7 @@ S_scan_const(pTHX_ char *start)
                            }
                        }
                        if (hicount) {
-                           STRLEN offset = d - SvPVX_const(sv);
+                           const STRLEN offset = d - SvPVX_const(sv);
                            U8 *src, *dst;
                            d = SvGROW(sv, SvLEN(sv) + hicount + 1) + offset;
                            src = (U8 *)d - 1;
@@ -1637,7 +1684,7 @@ S_scan_const(pTHX_ char *start)
                            d  += hicount;
                            while (src >= (const U8 *)SvPVX_const(sv)) {
                                if (!NATIVE_IS_INVARIANT(*src)) {
-                                   U8 ch = NATIVE_TO_ASCII(*src);
+                                   const U8 ch = NATIVE_TO_ASCII(*src);
                                    *dst-- = (U8)UTF8_EIGHT_BIT_LO(ch);
                                    *dst-- = (U8)UTF8_EIGHT_BIT_HI(ch);
                                }
@@ -1719,7 +1766,7 @@ S_scan_const(pTHX_ char *start)
                    }
 #endif
                    if (!has_utf8 && SvUTF8(res)) {
-                       const char *ostart = SvPVX_const(sv);
+                       const char * const ostart = SvPVX_const(sv);
                        SvCUR_set(sv, d - ostart);
                        SvPOK_on(sv);
                        *d = '\0';
@@ -1730,7 +1777,7 @@ S_scan_const(pTHX_ char *start)
                        has_utf8 = TRUE;
                    }
                    if (len > (STRLEN)(e - s + 4)) { /* I _guess_ 4 is \N{} --jhi */
-                       const char *odest = SvPVX_const(sv);
+                       const char * const odest = SvPVX_const(sv);
 
                        SvGROW(sv, (SvLEN(sv) + len - (e - s + 4)));
                        d = SvPVX(sv) + (d - odest);
@@ -1788,18 +1835,22 @@ S_scan_const(pTHX_ char *start)
            s++;
            continue;
        } /* end if (backslash) */
+#ifdef EBCDIC
+       else
+           literal_endpoint++;
+#endif
 
     default_action:
        /* If we started with encoded form, or already know we want it
           and then encode the next character */
        if ((has_utf8 || this_utf8) && !NATIVE_IS_INVARIANT((U8)(*s))) {
            STRLEN len  = 1;
-           UV uv       = (this_utf8) ? utf8n_to_uvchr((U8*)s, send - s, &len, 0) : (UV) ((U8) *s);
-           STRLEN need = UNISKIP(NATIVE_TO_UNI(uv));
+           const UV uv       = (this_utf8) ? utf8n_to_uvchr((U8*)s, send - s, &len, 0) : (UV) ((U8) *s);
+           const STRLEN need = UNISKIP(NATIVE_TO_UNI(uv));
            s += len;
            if (need > len) {
                /* encoded value larger than old, need extra space (NOTE: SvCUR() not set here) */
-               STRLEN off = d - SvPVX_const(sv);
+               const STRLEN off = d - SvPVX_const(sv);
                d = SvGROW(sv, SvLEN(sv) + (need-len)) + off;
            }
            d = (char*)uvchr_to_utf8((U8*)d, uv);
@@ -1911,7 +1962,7 @@ S_intuit_more(pTHX_ register char *s)
        int weight = 2;         /* let's weigh the evidence */
        char seen[256];
        unsigned char un_char = 255, last_un_char;
-       const char *send = strchr(s,']');
+       const char * const send = strchr(s,']');
        char tmpbuf[sizeof PL_tokenbuf * 4];
 
        if (!send)              /* has to be an expression */
@@ -2101,7 +2152,7 @@ STATIC const char*
 S_incl_perldb(pTHX)
 {
     if (PL_perldb) {
-       const char *pdb = PerlEnv_getenv("PERL5DB");
+       const char * const pdb = PerlEnv_getenv("PERL5DB");
 
        if (pdb)
            return pdb;
@@ -2279,6 +2330,30 @@ S_find_in_my_stash(pTHX_ const char *pkgname, I32 len)
     return gv_stashpv(pkgname, FALSE);
 }
 
+STATIC char *
+S_tokenize_use(pTHX_ int is_use, char *s) {
+    if (PL_expect != XSTATE)
+       yyerror(Perl_form(aTHX_ "\"%s\" not allowed in expression",
+                   is_use ? "use" : "no"));
+    s = skipspace(s);
+    if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
+       s = force_version(s, TRUE);
+       if (*s == ';' || (s = skipspace(s), *s == ';')) {
+           PL_nextval[PL_nexttoke].opval = Nullop;
+           force_next(WORD);
+       }
+       else if (*s == 'v') {
+           s = force_word(s,WORD,FALSE,TRUE,FALSE);
+           s = force_version(s, FALSE);
+       }
+    }
+    else {
+       s = force_word(s,WORD,FALSE,TRUE,FALSE);
+       s = force_version(s, FALSE);
+    }
+    yylval.ival = is_use;
+    return s;
+}
 #ifdef DEBUGGING
     static const char* const exp_name[] =
        { "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "ATTRBLOCK",
@@ -2632,7 +2707,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 *sv = NEWSV(85,0);
+               SV * const sv = NEWSV(85,0);
 
                sv_upgrade(sv, SVt_PVMG);
                sv_setsv(sv,PL_linestr);
@@ -2719,7 +2794,7 @@ Perl_yylex(pTHX)
        } while (PL_doextract);
        PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
        if (PERLDB_LINE && PL_curstash != PL_debstash) {
-           SV *sv = NEWSV(85,0);
+           SV * const sv = NEWSV(85,0);
 
            sv_upgrade(sv, SVt_PVMG);
            sv_setsv(sv,PL_linestr);
@@ -2775,7 +2850,7 @@ Perl_yylex(pTHX)
                        STRLEN blen;
                        STRLEN llen;
                        const char *bstart = SvPV_const(CopFILESV(PL_curcop),blen);
-                       const char *lstart = SvPV_const(x,llen);
+                       const char * const lstart = SvPV_const(x,llen);
                        if (llen < blen) {
                            bstart += blen - llen;
                            if (strnEQ(bstart, lstart, llen) && bstart[-1] == '/') {
@@ -2846,7 +2921,7 @@ Perl_yylex(pTHX)
                    while (s < PL_bufend && isSPACE(*s))
                        s++;
                    if (s < PL_bufend) {
-                       Newz(899,newargv,PL_origargc+3,char*);
+                       Newxz(newargv,PL_origargc+3,char*);
                        newargv[1] = s;
                        while (s < PL_bufend && !isSPACE(*s))
                            s++;
@@ -2874,7 +2949,7 @@ Perl_yylex(pTHX)
                        const bool switches_done = PL_doswitches;
                        do {
                            if (*d == 'M' || *d == 'm' || *d == 'C') {
-                               const char *m = d;
+                               const char * const m = d;
                                while (*d && !isSPACE(*d)) d++;
                                Perl_croak(aTHX_ "Too late for \"-%.*s\" option",
                                      (int)(d - m), m);
@@ -3479,8 +3554,8 @@ Perl_yylex(pTHX)
            AOPERATOR(ANDAND);
        s--;
        if (PL_expect == XOPERATOR) {
-           if (ckWARN(WARN_SEMICOLON)
-               && isIDFIRST_lazy_if(s,UTF) && PL_bufptr == PL_linestart)
+           if (PL_bufptr == PL_linestart && ckWARN(WARN_SEMICOLON)
+               && isIDFIRST_lazy_if(s,UTF))
            {
                CopLINE_dec(PL_curcop);
                Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), PL_warn_nosemi);
@@ -3515,7 +3590,7 @@ Perl_yylex(pTHX)
            OPERATOR(',');
        if (tmp == '~')
            PMop(OP_MATCH);
-       if (ckWARN(WARN_SYNTAX) && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
+       if (tmp && isSPACE(*s) && ckWARN(WARN_SYNTAX) && strchr("+-*/%.^&|<",tmp))
            Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Reversed %c= operator",(int)tmp);
        s--;
        if (PL_expect == XSTATE && isALPHA(tmp) &&
@@ -3665,10 +3740,10 @@ Perl_yylex(pTHX)
            s = skipspace(s);
 
        if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
-           char *t;
            if (*s == '[') {
                PL_tokenbuf[0] = '@';
                if (ckWARN(WARN_SYNTAX)) {
+                   char *t;
                    for(t = s + 1;
                        isSPACE(*t) || isALNUM_lazy_if(t,UTF) || *t == '$';
                        t++) ;
@@ -3683,9 +3758,10 @@ Perl_yylex(pTHX)
                }
            }
            else if (*s == '{') {
+               char *t;
                PL_tokenbuf[0] = '%';
-               if (ckWARN(WARN_SYNTAX) && strEQ(PL_tokenbuf+1, "SIG") &&
-                   (t = strchr(s, '}')) && (t = strchr(t, '=')))
+               if (strEQ(PL_tokenbuf+1, "SIG")  && ckWARN(WARN_SYNTAX)
+                   && (t = strchr(s, '}')) && (t = strchr(t, '=')))
                {
                    char tmpbuf[sizeof PL_tokenbuf];
                    for (t++; isSPACE(*t); t++) ;
@@ -3765,8 +3841,8 @@ Perl_yylex(pTHX)
                PL_tokenbuf[0] = '%';
 
            /* Warn about @ where they meant $. */
-           if (ckWARN(WARN_SYNTAX)) {
-               if (*s == '[' || *s == '{') {
+           if (*s == '[' || *s == '{') {
+               if (ckWARN(WARN_SYNTAX)) {
                    const char *t = s + 1;
                    while (*t && (isALNUM_lazy_if(t,UTF) || strchr(" \t$#+-'\"", *t)))
                        t++;
@@ -3919,7 +3995,7 @@ Perl_yylex(pTHX)
 
     case '\\':
        s++;
-       if (ckWARN(WARN_SYNTAX) && PL_lex_inwhat && isDIGIT(*s))
+       if (PL_lex_inwhat && isDIGIT(*s) && ckWARN(WARN_SYNTAX))
            Perl_warner(aTHX_ packWARN(WARN_SYNTAX),"Can't use \\%c to mean $%c in expression",
                        *s, *s);
        if (PL_expect == XOPERATOR)
@@ -4080,8 +4156,8 @@ Perl_yylex(pTHX)
                }
                gv = Nullgv;
                gvp = 0;
-               if (ckWARN(WARN_AMBIGUOUS) && hgv
-                   && tmp != KEY_x && tmp != KEY_CORE) /* never ambiguous */
+               if (hgv && tmp != KEY_x && tmp != KEY_CORE
+                       && ckWARN(WARN_AMBIGUOUS))      /* never ambiguous */
                    Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
                        "Ambiguous call resolved as CORE::%s(), %s",
                         GvENAME(hgv), "qualify as such or use &");
@@ -4299,8 +4375,8 @@ Perl_yylex(pTHX)
                    yylval.opval->op_private |= OPpCONST_STRICT;
                else {
                bareword:
-                   if (ckWARN(WARN_RESERVED)) {
-                       if (lastchar != '-') {
+                   if (lastchar != '-') {
+                       if (ckWARN(WARN_RESERVED)) {
                            for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ;
                            if (!*d && !gv_stashpv(PL_tokenbuf,FALSE))
                                Perl_warner(aTHX_ packWARN(WARN_RESERVED), PL_warn_reserved,
@@ -4444,6 +4520,9 @@ Perl_yylex(pTHX)
                    Perl_croak(aTHX_ "CORE::%s is not a keyword", PL_tokenbuf);
                if (tmp < 0)
                    tmp = -tmp;
+               else if (tmp == KEY_require)
+                   /* that's a way to remember we saw "CORE::" */
+                   orig_keyword = KEY_require;
                goto reserved_word;
            }
            goto just_a_word;
@@ -4856,11 +4935,7 @@ Perl_yylex(pTHX)
            Eop(OP_SNE);
 
        case KEY_no:
-           if (PL_expect != XSTATE)
-               yyerror("\"no\" not allowed in expression");
-           s = force_word(s,WORD,FALSE,TRUE,FALSE);
-           s = force_version(s, FALSE);
-           yylval.ival = 0;
+           s = tokenize_use(0, s);
            OPERATOR(USE);
 
        case KEY_not:
@@ -5029,7 +5104,18 @@ Perl_yylex(pTHX)
                else if (*s == '<')
                    yyerror("<> should be quotes");
            }
-           UNI(OP_REQUIRE);
+           if (orig_keyword == KEY_require) {
+               orig_keyword = 0;
+               yylval.ival = 1;
+           }
+           else 
+               yylval.ival = 0;
+           PL_expect = XTERM;
+           PL_bufptr = s;
+           PL_last_uni = PL_oldbufptr;
+           PL_last_lop_op = OP_REQUIRE;
+           s = skipspace(s);
+           return REPORT( (int)REQUIRE );
 
        case KEY_reset:
            UNI(OP_RESET);
@@ -5392,25 +5478,7 @@ Perl_yylex(pTHX)
            LOP(OP_UNSHIFT,XTERM);
 
        case KEY_use:
-           if (PL_expect != XSTATE)
-               yyerror("\"use\" not allowed in expression");
-           s = skipspace(s);
-           if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
-               s = force_version(s, TRUE);
-               if (*s == ';' || (s = skipspace(s), *s == ';')) {
-                   PL_nextval[PL_nexttoke].opval = Nullop;
-                   force_next(WORD);
-               }
-               else if (*s == 'v') {
-                   s = force_word(s,WORD,FALSE,TRUE,FALSE);
-                   s = force_version(s, FALSE);
-               }
-           }
-           else {
-               s = force_word(s,WORD,FALSE,TRUE,FALSE);
-               s = force_version(s, FALSE);
-           }
-           yylval.ival = 1;
+           s = tokenize_use(1, s);
            OPERATOR(USE);
 
        case KEY_values:
@@ -5524,9 +5592,9 @@ S_pending_ident(pTHX)
             /* might be an "our" variable" */
             if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
                 /* build ops for a bareword */
-               HV *stash = PAD_COMPNAME_OURSTASH(tmp);
-               HEK *stashname = HvNAME_HEK(stash);
-                SV *sym = newSVhek(stashname);
+               HV *  const stash = PAD_COMPNAME_OURSTASH(tmp);
+               HEK * const stashname = HvNAME_HEK(stash);
+               SV *  const sym = newSVhek(stashname);
                 sv_catpvn(sym, "::", 2);
                 sv_catpv(sym, PL_tokenbuf+1);
                 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
@@ -8949,7 +9017,7 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, SV *sv, SV *pv,
               const char *type)
 {
     dVAR; dSP;
-    HV *table = GvHV(PL_hintgv);                /* ^H */
+    HV * const table = GvHV(PL_hintgv);                 /* ^H */
     SV *res;
     SV **cvp;
     SV *cv, *typesv;
@@ -9046,7 +9114,7 @@ STATIC char *
 S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
 {
     register char *d = dest;
-    register char *e = d + destlen - 3;  /* two-character token, ending NUL */
+    register char * const e = d + destlen - 3;  /* two-character token, ending NUL */
     for (;;) {
        if (d >= e)
            Perl_croak(aTHX_ ident_too_long);
@@ -9084,7 +9152,7 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL
 {
     register char *d;
     register char *e;
-    char *bracket = 0;
+    char *bracket = Nullch;
     char funny = *s++;
 
     if (isSPACE(*s))
@@ -9262,7 +9330,7 @@ S_scan_pat(pTHX_ char *start, I32 type)
     char *s = scan_str(start,FALSE,FALSE);
 
     if (!s) {
-       char *delimiter = skipspace(start);
+       char * const delimiter = skipspace(start);
        Perl_croak(aTHX_ *delimiter == '?'
                   ? "Search pattern not terminated or ternary operator parsed as search pattern"
                   : "Search pattern not terminated" );
@@ -9280,8 +9348,8 @@ S_scan_pat(pTHX_ char *start, I32 type)
            pmflag(&pm->op_pmflags,*s++);
     }
     /* issue a warning if /c is specified,but /g is not */
-    if (ckWARN(WARN_REGEXP) &&
-        (pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL))
+    if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL)
+           && ckWARN(WARN_REGEXP))
     {
         Perl_warner(aTHX_ packWARN(WARN_REGEXP), c_without_g);
     }
@@ -9336,7 +9404,7 @@ S_scan_subst(pTHX_ char *start)
     }
 
     /* /c is not meaningful with s/// */
-    if (ckWARN(WARN_REGEXP) && (pm->op_pmflags & PMf_CONTINUE))
+    if ((pm->op_pmflags & PMf_CONTINUE) && ckWARN(WARN_REGEXP))
     {
         Perl_warner(aTHX_ packWARN(WARN_REGEXP), c_in_subst);
     }
@@ -9410,7 +9478,7 @@ S_scan_trans(pTHX_ char *start)
     }
   no_more:
 
-    New(803, tbl, complement&&!del?258:256, short);
+    Newx(tbl, complement&&!del?258:256, short);
     o = newPVOP(OP_TRANS, 0, (char*)tbl);
     o->op_private &= ~OPpTRANS_ALL;
     o->op_private |= del|squash|complement|
@@ -10222,7 +10290,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
 
                /* _ are ignored -- but warned about if consecutive */
                case '_':
-                   if (ckWARN(WARN_SYNTAX) && lastub && s == lastub + 1)
+                   if (lastub && s == lastub + 1 && ckWARN(WARN_SYNTAX))
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                                    "Misplaced _ in number");
                    lastub = s++;
@@ -10302,7 +10370,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
 
            sv = NEWSV(92,0);
            if (overflowed) {
-               if (ckWARN(WARN_PORTABLE) && n > 4294967295.0)
+               if (n > 4294967295.0 && ckWARN(WARN_PORTABLE))
                    Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
                                "%s number > %s non-portable",
                                Base, max);
@@ -10310,7 +10378,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
            }
            else {
 #if UVSIZE > 4
-               if (ckWARN(WARN_PORTABLE) && u > 0xffffffff)
+               if (u > 0xffffffff && ckWARN(WARN_PORTABLE))
                    Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
                                "%s number > %s non-portable",
                                Base, max);
@@ -10342,7 +10410,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
               if -w is on
            */
            if (*s == '_') {
-               if (ckWARN(WARN_SYNTAX) && lastub && s == lastub + 1)
+               if (lastub && s == lastub + 1 && ckWARN(WARN_SYNTAX))
                    Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                                "Misplaced _ in number");
                lastub = s++;
@@ -10384,7 +10452,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
                if (d >= e)
                    Perl_croak(aTHX_ number_too_long);
                if (*s == '_') {
-                  if (ckWARN(WARN_SYNTAX) && lastub && s == lastub + 1)
+                  if (lastub && s == lastub + 1 && ckWARN(WARN_SYNTAX))
                       Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                                   "Misplaced _ in number");
                   lastub = s;
@@ -10441,9 +10509,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
                    *d++ = *s++;
                }
                else {
-                  if (ckWARN(WARN_SYNTAX) &&
-                      ((lastub && s == lastub + 1) ||
-                       (!isDIGIT(s[1]) && s[1] != '_')))
+                  if (((lastub && s == lastub + 1) ||
+                       (!isDIGIT(s[1]) && s[1] != '_'))
+                   && ckWARN(WARN_SYNTAX))
                       Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                                   "Misplaced _ in number");
                   lastub = s++;
@@ -10765,7 +10833,7 @@ S_swallow_bom(pTHX_ U8 *s)
                I32 newlen;
 
                filter_add(utf16rev_textfilter, NULL);
-               New(898, news, (PL_bufend - (char*)s) * 3 / 2 + 1, U8);
+               Newx(news, (PL_bufend - (char*)s) * 3 / 2 + 1, U8);
                utf16_to_utf8_reversed(s, news,
                                       PL_bufend - (char*)s - 1,
                                       &newlen);
@@ -10791,7 +10859,7 @@ S_swallow_bom(pTHX_ U8 *s)
                I32 newlen;
 
                filter_add(utf16_textfilter, NULL);
-               New(898, news, (PL_bufend - (char*)s) * 3 / 2 + 1, U8);
+               Newx(news, (PL_bufend - (char*)s) * 3 / 2 + 1, U8);
                utf16_to_utf8(s, news,
                              PL_bufend - (char*)s,
                              &newlen);
@@ -10869,7 +10937,7 @@ utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
     if (count) {
        U8* tmps;
        I32 newlen;
-       New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
+       Newx(tmps, SvCUR(sv) * 3 / 2 + 1, U8);
        Copy(SvPVX_const(sv), tmps, old, char);
        utf16_to_utf8((U8*)SvPVX_const(sv) + old, tmps + old,
                      SvCUR(sv) - old, &newlen);
@@ -10890,7 +10958,7 @@ utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen)
     if (count) {
        U8* tmps;
        I32 newlen;
-       New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
+       Newx(tmps, SvCUR(sv) * 3 / 2 + 1, U8);
        Copy(SvPVX_const(sv), tmps, old, char);
        utf16_to_utf8((U8*)SvPVX_const(sv) + old, tmps + old,
                      SvCUR(sv) - old, &newlen);