This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
The winsock select() implementation doesn't support all empty 'fd_set's.
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index ca18af1..0b4ff5c 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -100,7 +100,6 @@ static int
 S_pending_ident(pTHX);
 
 static const char ident_too_long[] = "Identifier too long";
-static const char commaless_variable_list[] = "comma-less variable list";
 
 #ifndef PERL_NO_UTF16_FILTER
 static I32 utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen);
@@ -124,16 +123,14 @@ static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen);
 #   define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8))
 #endif
 
+/* The maximum number of characters preceding the unrecognized one to display */
+#define UNRECOGNIZED_PRECEDE_COUNT 10
+
 /* In variables named $^X, these are the legal values for X.
  * 1999-02-27 mjd-perl-patch@plover.com */
 #define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
 
-/* On MacOS, respect nonbreaking spaces */
-#ifdef MACOS_TRADITIONAL
-#define SPACE_OR_TAB(c) ((c)==' '||(c)=='\312'||(c)=='\t')
-#else
 #define SPACE_OR_TAB(c) ((c)==' '||(c)=='\t')
-#endif
 
 /* LEX_* are values for PL_lex_state, the state of the lexer.
  * They are arranged oddly so that the guard on the switch statement
@@ -453,6 +450,13 @@ S_printbuf(pTHX_ const char *const fmt, const char *const s)
 
 #endif
 
+static int
+S_deprecate_commaless_var_list(pTHX) {
+    PL_expect = XTERM;
+    deprecate("comma-less variable list");
+    return REPORT(','); /* grandfather non-comma-format format */
+}
+
 /*
  * S_ao
  *
@@ -587,37 +591,6 @@ S_feature_is_enabled(pTHX_ const char *const name, STRLEN namelen)
 }
 
 /*
- * Perl_deprecate
- */
-
-void
-Perl_deprecate(pTHX_ const char *const s)
-{
-    PERL_ARGS_ASSERT_DEPRECATE;
-
-    if (ckWARN(WARN_DEPRECATED))
-       Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), "Use of %s is deprecated", s);
-}
-
-void
-Perl_deprecate_old(pTHX_ const char *const s)
-{
-    /* This function should NOT be called for any new deprecated warnings */
-    /* Use Perl_deprecate instead                                         */
-    /*                                                                    */
-    /* It is here to maintain backward compatibility with the pre-5.8     */
-    /* warnings category hierarchy. The "deprecated" category used to     */
-    /* live under the "syntax" category. It is now a top-level category   */
-    /* in its own right.                                                  */
-
-    PERL_ARGS_ASSERT_DEPRECATE_OLD;
-
-    if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
-       Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
-                       "Use of %s is deprecated", s);
-}
-
-/*
  * experimental text filters for win32 carriage-returns, utf16-to-utf8 and
  * utf16-to-utf8-reversed.
  */
@@ -1221,11 +1194,9 @@ S_check_uni(pTHX)
     if ((t = strchr(s, '(')) && t < PL_bufptr)
        return;
 
-    if (ckWARN_d(WARN_AMBIGUOUS)){
-        Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
-                  "Warning: Use of \"%.*s\" without parentheses is ambiguous",
-                  (int)(s - PL_last_uni), PL_last_uni);
-    }
+    Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
+                    "Warning: Use of \"%.*s\" without parentheses is ambiguous",
+                    (int)(s - PL_last_uni), PL_last_uni);
 }
 
 /*
@@ -1386,7 +1357,9 @@ S_newSV_maybe_utf8(pTHX_ const char *const start, STRLEN len)
 {
     dVAR;
     SV * const sv = newSVpvn_utf8(start, len,
-                                 UTF && !IN_BYTES
+                                 !IN_BYTES
+                                 && UTF
+                                 && !is_ascii_string((const U8*)start, len)
                                  && is_utf8_string((const U8*)start, len));
     return sv;
 }
@@ -2193,9 +2166,9 @@ S_scan_const(pTHX_ char *start)
            if (!PL_lex_inpat)  /* not a regexp, so $ must be var */
                break;
            if (s + 1 < send && !strchr("()| \r\n\t", s[1])) {
-               if (s[1] == '\\' && ckWARN(WARN_AMBIGUOUS)) {
-                   Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
-                               "Possible unintended interpolation of $\\ in regex");
+               if (s[1] == '\\') {
+                   Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
+                                  "Possible unintended interpolation of $\\ in regex");
                }
                break;          /* in regexp, $ might be tail anchor */
             }
@@ -2211,8 +2184,7 @@ S_scan_const(pTHX_ char *start)
            if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat &&
                isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
            {
-               if (ckWARN(WARN_SYNTAX))
-                   Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "\\%c better written as $%c", *s, *s);
+               Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "\\%c better written as $%c", *s, *s);
                *--s = '$';
                break;
            }
@@ -2240,11 +2212,10 @@ S_scan_const(pTHX_ char *start)
                /* FALL THROUGH */
            default:
                {
-                   if ((isALPHA(*s) || isDIGIT(*s)) &&
-                       ckWARN(WARN_MISC))
-                       Perl_warner(aTHX_ packWARN(WARN_MISC),
-                                   "Unrecognized escape \\%c passed through",
-                                   *s);
+                   if ((isALPHA(*s) || isDIGIT(*s)))
+                       Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
+                                      "Unrecognized escape \\%c passed through",
+                                      *s);
                    /* default action is to copy the quoted character */
                    goto default_action;
                }
@@ -2826,7 +2797,7 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
       bare_package:
            start_force(PL_curforce);
            NEXTVAL_NEXTTOKE.opval = (OP*)newSVOP(OP_CONST, 0,
-                                                  newSVpvn(tmpbuf,len));
+                                                 S_newSV_maybe_utf8(aTHX_ tmpbuf, len));
            NEXTVAL_NEXTTOKE.opval->op_private = OPpCONST_BARE;
            if (PL_madskills)
                curmad('X', newSVpvn(start,SvPVX(PL_linestr) + soff - start));
@@ -3657,8 +3628,17 @@ Perl_yylex(pTHX)
     default:
        if (isIDFIRST_lazy_if(s,UTF))
            goto keylookup;
-       len = UTF ? Perl_utf8_length(aTHX_ (U8 *) PL_linestart, (U8 *) s) : (STRLEN) (s - PL_linestart);
-       Perl_croak(aTHX_ "Unrecognized character \\x%02X in column %d", *s & 255, (int) len + 1);
+       {
+        unsigned char c = *s;
+        len = UTF ? Perl_utf8_length(aTHX_ (U8 *) PL_linestart, (U8 *) s) : (STRLEN) (s - PL_linestart);
+        if (len > UNRECOGNIZED_PRECEDE_COUNT) {
+            d = UTF ? (char *) Perl_utf8_hop(aTHX_ (U8 *) s, -UNRECOGNIZED_PRECEDE_COUNT) : s - UNRECOGNIZED_PRECEDE_COUNT;
+        } else {
+            d = PL_linestart;
+        }      
+        *s = '\0';
+        Perl_croak(aTHX_ "Unrecognized character \\x%02X; marked by <-- HERE after %s<-- HERE near column %d", c, d, (int) len + 1);
+    }
     case 4:
     case 26:
        goto fake_eof;                  /* emulate EOF on ^D or ^Z */
@@ -3948,7 +3928,6 @@ Perl_yylex(pTHX)
                        *s = '#';       /* Don't try to parse shebang line */
                }
 #endif /* ALTERNATE_SHEBANG */
-#ifndef MACOS_TRADITIONAL
                if (!d &&
                    *s == '#' &&
                    ipathend > ipath &&
@@ -3964,7 +3943,7 @@ Perl_yylex(pTHX)
                    while (s < PL_bufend && isSPACE(*s))
                        s++;
                    if (s < PL_bufend) {
-                       Newxz(newargv,PL_origargc+3,char*);
+                       Newx(newargv,PL_origargc+3,char*);
                        newargv[1] = s;
                        while (s < PL_bufend && !isSPACE(*s))
                            s++;
@@ -3979,7 +3958,6 @@ Perl_yylex(pTHX)
                    PERL_FPU_POST_EXEC
                    Perl_croak(aTHX_ "Can't exec %s", ipath);
                }
-#endif
                if (d) {
                    while (*d && !isSPACE(*d))
                        d++;
@@ -3994,7 +3972,14 @@ Perl_yylex(pTHX)
                        const char *d1 = d;
 
                        do {
-                           if (*d1 == 'M' || *d1 == 'm' || *d1 == 'C') {
+                           bool baduni = FALSE;
+                           if (*d1 == 'C') {
+                               const char *d2 = d1 + 1;
+                               if (parse_unicode_opts((const char **)&d2)
+                                   != PL_unicode)
+                                   baduni = TRUE;
+                           }
+                           if (baduni || *d1 == 'M' || *d1 == 'm') {
                                const char * const m = d1;
                                while (*d1 && !isSPACE(*d1))
                                    d1++;
@@ -4042,9 +4027,6 @@ Perl_yylex(pTHX)
       "\t(Maybe you didn't strip carriage returns after a network transfer?)\n");
 #endif
     case ' ': case '\t': case '\f': case 013:
-#ifdef MACOS_TRADITIONAL
-    case '\312':
-#endif
 #ifdef PERL_MAD
        PL_realtokenstart = -1;
        if (!PL_thiswhite)
@@ -4376,11 +4358,6 @@ Perl_yylex(pTHX)
                    if (len == 6 && strnEQ(SvPVX(sv), "unique", len)) {
                        sv_free(sv);
                        if (PL_in_my == KEY_our) {
-#ifdef USE_ITHREADS
-                           GvUNIQUE_on(cGVOPx_gv(pl_yylval.opval));
-#else
-                           /* skip to avoid loading attributes.pm */
-#endif
                            deprecate(":unique");
                        }
                        else
@@ -4808,10 +4785,6 @@ Perl_yylex(pTHX)
        pl_yylval.ival = 0;
        OPERATOR(ASSIGNOP);
     case '!':
-       if (PL_expect == XSTATE && s[1] == '!' && s[2] == '!') {
-           s += 3;
-           LOP(OP_DIE,XTERM);
-       }
        s++;
        {
            const char tmp = *s++;
@@ -4881,9 +4854,7 @@ Perl_yylex(pTHX)
 
        if (PL_expect == XOPERATOR) {
            if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
-               PL_expect = XTERM;
-               deprecate_old(commaless_variable_list);
-               return REPORT(','); /* grandfather non-comma-format format */
+               return deprecate_commaless_var_list();
            }
        }
 
@@ -5063,10 +5034,6 @@ Perl_yylex(pTHX)
            AOPERATOR(DORDOR);
        }
      case '?':                 /* may either be conditional or pattern */
-       if (PL_expect == XSTATE && s[1] == '?' && s[2] == '?') {
-           s += 3;
-           LOP(OP_WARN,XTERM);
-       }
        if (PL_expect == XOPERATOR) {
             char tmp = *s++;
             if(tmp == '?') {
@@ -5143,9 +5110,7 @@ Perl_yylex(pTHX)
        DEBUG_T( { printbuf("### Saw string before %s\n", s); } );
        if (PL_expect == XOPERATOR) {
            if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
-               PL_expect = XTERM;
-               deprecate_old(commaless_variable_list);
-               return REPORT(','); /* grandfather non-comma-format format */
+               return deprecate_commaless_var_list();
            }
            else
                no_op("String",s);
@@ -5160,9 +5125,7 @@ Perl_yylex(pTHX)
        DEBUG_T( { printbuf("### Saw string before %s\n", s); } );
        if (PL_expect == XOPERATOR) {
            if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
-               PL_expect = XTERM;
-               deprecate_old(commaless_variable_list);
-               return REPORT(','); /* grandfather non-comma-format format */
+               return deprecate_commaless_var_list();
            }
            else
                no_op("String",s);
@@ -5192,9 +5155,9 @@ Perl_yylex(pTHX)
 
     case '\\':
        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_lex_inwhat && isDIGIT(*s))
+           Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),"Can't use \\%c to mean $%c in expression",
+                          *s, *s);
        if (PL_expect == XOPERATOR)
            no_op("Backslash",s);
        OPERATOR(REFGEN);
@@ -5282,14 +5245,17 @@ Perl_yylex(pTHX)
        /* Is this a label? */
        if (!tmp && PL_expect == XSTATE
              && d < PL_bufend && *d == ':' && *(d + 1) != ':') {
+           tmp = keyword(PL_tokenbuf, len, 0);
+           if (tmp)
+               Perl_croak(aTHX_ "Can't use keyword '%s' as a label", PL_tokenbuf);
            s = d + 1;
            pl_yylval.pval = CopLABEL_alloc(PL_tokenbuf);
            CLINE;
            TOKEN(LABEL);
        }
-
-       /* Check for keywords */
-       tmp = keyword(PL_tokenbuf, len, 0);
+       else
+           /* Check for keywords */
+           tmp = keyword(PL_tokenbuf, len, 0);
 
        /* Is this a word before a => operator? */
        if (*d == '=' && d[1] == '>') {
@@ -5334,17 +5300,16 @@ Perl_yylex(pTHX)
            }
            else {                      /* no override */
                tmp = -tmp;
-               if (tmp == KEY_dump && ckWARN(WARN_MISC)) {
-                   Perl_warner(aTHX_ packWARN(WARN_MISC),
-                           "dump() better written as CORE::dump()");
+               if (tmp == KEY_dump) {
+                   Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
+                                  "dump() better written as CORE::dump()");
                }
                gv = NULL;
                gvp = 0;
-               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 &");
+               if (hgv && tmp != KEY_x && tmp != KEY_CORE)     /* never ambiguous */
+                   Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
+                                  "Ambiguous call resolved as CORE::%s(), %s",
+                                  GvENAME(hgv), "qualify as such or use &");
            }
        }
 
@@ -5584,10 +5549,10 @@ Perl_yylex(pTHX)
                /* Not a method, so call it a subroutine (if defined) */
 
                if (cv) {
-                   if (lastchar == '-' && ckWARN_d(WARN_AMBIGUOUS))
-                       Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
-                               "Ambiguous use of -%s resolved as -&%s()",
-                               PL_tokenbuf, PL_tokenbuf);
+                   if (lastchar == '-')
+                       Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
+                                        "Ambiguous use of -%s resolved as -&%s()",
+                                        PL_tokenbuf, PL_tokenbuf);
                    /* Check for a constant sub */
                    if ((sv = gv_const_sv(gv))) {
                  its_constant:
@@ -5700,10 +5665,22 @@ Perl_yylex(pTHX)
 
                /* Call it a bare word */
 
-               bareword:
                if (PL_hints & HINT_STRICT_SUBS)
                    pl_yylval.opval->op_private |= OPpCONST_STRICT;
                else {
+               bareword:
+                   /* after "print" and similar functions (corresponding to
+                    * "F? L" in opcode.pl), whatever wasn't already parsed as
+                    * a filehandle should be subject to "strict subs".
+                    * Likewise for the optional indirect-object argument to system
+                    * or exec, which can't be a bareword */
+                   if ((PL_last_lop_op == OP_PRINT
+                           || PL_last_lop_op == OP_PRTF
+                           || PL_last_lop_op == OP_SAY
+                           || PL_last_lop_op == OP_SYSTEM
+                           || PL_last_lop_op == OP_EXEC)
+                           && (PL_hints & HINT_STRICT_SUBS))
+                       pl_yylval.opval->op_private |= OPpCONST_STRICT;
                    if (lastchar != '-') {
                        if (ckWARN(WARN_RESERVED)) {
                            d = PL_tokenbuf;
@@ -5717,14 +5694,13 @@ Perl_yylex(pTHX)
                }
 
            safe_bareword:
-               if ((lastchar == '*' || lastchar == '%' || lastchar == '&')
-                   && ckWARN_d(WARN_AMBIGUOUS)) {
-                   Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
-                       "Operator or semicolon missing before %c%s",
-                       lastchar, PL_tokenbuf);
-                   Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
-                       "Ambiguous use of %c resolved as operator %c",
-                       lastchar, lastchar);
+               if ((lastchar == '*' || lastchar == '%' || lastchar == '&')) {
+                   Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
+                                    "Operator or semicolon missing before %c%s",
+                                    lastchar, PL_tokenbuf);
+                   Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
+                                    "Ambiguous use of %c resolved as operator %c",
+                                    lastchar, lastchar);
                }
                TOKEN(WORD);
            }
@@ -6397,6 +6373,7 @@ Perl_yylex(pTHX)
 
        case KEY_package:
            s = force_word(s,WORD,FALSE,TRUE,FALSE);
+           s = force_version(s, FALSE);
            OPERATOR(PACKAGE);
 
        case KEY_pipe:
@@ -7158,16 +7135,15 @@ S_pending_ident(pTHX)
         GV *const gv = gv_fetchpvn_flags(PL_tokenbuf + 1, tokenbuf_len - 1, 0,
                                         SVt_PVAV);
         if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
-               && ckWARN(WARN_AMBIGUOUS)
                /* DO NOT warn for @- and @+ */
                && !( PL_tokenbuf[2] == '\0' &&
                    ( PL_tokenbuf[1] == '-' || PL_tokenbuf[1] == '+' ))
           )
         {
             /* Downgraded from fatal to warning 20000522 mjd */
-            Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
-                        "Possible unintended interpolation of %s in string",
-                         PL_tokenbuf);
+            Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
+                          "Possible unintended interpolation of %s in string",
+                          PL_tokenbuf);
         }
     }
 
@@ -8708,8 +8684,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
                   name[4] == 'i' &&
                   name[5] == 'f')
               {                                   /* elseif     */
-                if(ckWARN_d(WARN_SYNTAX))
-                  Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif");
+                  Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif");
               }
 
               goto unknown;
@@ -11034,11 +11009,10 @@ S_scan_pat(pTHX_ char *start, I32 type)
     }
 #endif
     /* 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))
+    if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL))
     {
-        Perl_warner(aTHX_ packWARN(WARN_REGEXP), 
-            "Use of /c modifier is meaningless without /g" );
+        Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), 
+                      "Use of /c modifier is meaningless without /g" );
     }
 
     PL_lex_op = (OP*)pm;
@@ -11120,8 +11094,8 @@ S_scan_subst(pTHX_ char *start)
        PL_thismad = 0;
     }
 #endif
-    if ((pm->op_pmflags & PMf_CONTINUE) && ckWARN(WARN_REGEXP)) {
-        Perl_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless in s///" );
+    if ((pm->op_pmflags & PMf_CONTINUE)) {
+        Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless in s///" );
     }
 
     if (es) {
@@ -11289,7 +11263,7 @@ S_scan_heredoc(pTHX_ register char *s)
        else
            term = '"';
        if (!isALNUM_lazy_if(s,UTF))
-           deprecate_old("bare << to mean <<\"\"");
+           deprecate("bare << to mean <<\"\"");
        for (; isALNUM_lazy_if(s,UTF); s++) {
            if (d < e)
                *d++ = *s;
@@ -12133,8 +12107,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
            }
 
            if (*s == '_') {
-              if (ckWARN(WARN_SYNTAX))
-                  Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+               Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
                               "Misplaced _ in number");
               lastub = s++;
            }
@@ -12157,9 +12130,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
 
                /* _ are ignored -- but warned about if consecutive */
                case '_':
-                   if (lastub && s == lastub + 1 && ckWARN(WARN_SYNTAX))
-                       Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                                   "Misplaced _ in number");
+                   if (lastub && s == lastub + 1)
+                       Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+                                      "Misplaced _ in number");
                    lastub = s++;
                    break;
 
@@ -12201,10 +12174,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
                            && !(PL_hints & HINT_NEW_BINARY)) {
                            overflowed = TRUE;
                            n = (NV) u;
-                           if (ckWARN_d(WARN_OVERFLOW))
-                               Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
-                                           "Integer overflow in %s number",
-                                           base);
+                           Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
+                                            "Integer overflow in %s number",
+                                            base);
                        } else
                            u = x | b;          /* add the digit to the end */
                    }
@@ -12231,24 +12203,23 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
 
            /* final misplaced underbar check */
            if (s[-1] == '_') {
-               if (ckWARN(WARN_SYNTAX))
-                   Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number");
+               Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number");
            }
 
            sv = newSV(0);
            if (overflowed) {
-               if (n > 4294967295.0 && ckWARN(WARN_PORTABLE))
-                   Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
-                               "%s number > %s non-portable",
-                               Base, max);
+               if (n > 4294967295.0)
+                   Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
+                                  "%s number > %s non-portable",
+                                  Base, max);
                sv_setnv(sv, n);
            }
            else {
 #if UVSIZE > 4
-               if (u > 0xffffffff && ckWARN(WARN_PORTABLE))
-                   Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
-                               "%s number > %s non-portable",
-                               Base, max);
+               if (u > 0xffffffff)
+                   Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
+                                  "%s number > %s non-portable",
+                                  Base, max);
 #endif
                sv_setuv(sv, u);
            }
@@ -12277,9 +12248,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
               if -w is on
            */
            if (*s == '_') {
-               if (lastub && s == lastub + 1 && ckWARN(WARN_SYNTAX))
-                   Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                               "Misplaced _ in number");
+               if (lastub && s == lastub + 1)
+                   Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+                                  "Misplaced _ in number");
                lastub = s++;
            }
            else {
@@ -12293,8 +12264,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
 
        /* final misplaced underbar check */
        if (lastub && s == lastub + 1) {
-           if (ckWARN(WARN_SYNTAX))
-               Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number");
+           Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number");
        }
 
        /* read a decimal portion if there is one.  avoid
@@ -12306,9 +12276,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
            *d++ = *s++;
 
            if (*s == '_') {
-               if (ckWARN(WARN_SYNTAX))
-                   Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                               "Misplaced _ in number");
+               Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+                              "Misplaced _ in number");
                lastub = s;
            }
 
@@ -12319,9 +12288,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
                if (d >= e)
                    Perl_croak(aTHX_ number_too_long);
                if (*s == '_') {
-                  if (lastub && s == lastub + 1 && ckWARN(WARN_SYNTAX))
-                      Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                                  "Misplaced _ in number");
+                  if (lastub && s == lastub + 1)
+                      Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+                                     "Misplaced _ in number");
                   lastub = s;
                }
                else
@@ -12329,9 +12298,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
            }
            /* fractional part ending in underbar? */
            if (s[-1] == '_') {
-               if (ckWARN(WARN_SYNTAX))
-                   Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                               "Misplaced _ in number");
+               Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+                              "Misplaced _ in number");
            }
            if (*s == '.' && isDIGIT(s[1])) {
                /* oops, it's really a v-string, but without the "v" */
@@ -12350,9 +12318,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
 
            /* stray preinitial _ */
            if (*s == '_') {
-               if (ckWARN(WARN_SYNTAX))
-                   Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                               "Misplaced _ in number");
+               Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+                              "Misplaced _ in number");
                lastub = s++;
            }
 
@@ -12362,9 +12329,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
 
            /* stray initial _ */
            if (*s == '_') {
-               if (ckWARN(WARN_SYNTAX))
-                   Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                               "Misplaced _ in number");
+               Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+                              "Misplaced _ in number");
                lastub = s++;
            }
 
@@ -12377,10 +12343,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
                }
                else {
                   if (((lastub && s == lastub + 1) ||
-                       (!isDIGIT(s[1]) && s[1] != '_'))
-                   && ckWARN(WARN_SYNTAX))
-                      Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                                  "Misplaced _ in number");
+                       (!isDIGIT(s[1]) && s[1] != '_')))
+                      Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+                                     "Misplaced _ in number");
                   lastub = s++;
                }
            }
@@ -12704,8 +12669,7 @@ Perl_yyerror(pTHX_ const char *const s)
         PL_multi_end = 0;
     }
     if (PL_in_eval & EVAL_WARNONLY) {
-       if (ckWARN_d(WARN_SYNTAX))
-           Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, SVfARG(msg));
+       Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, SVfARG(msg));
     }
     else
        qerror(msg);
@@ -12948,9 +12912,9 @@ Perl_scan_vstring(pTHX_ const char *s, const char *const e, SV *sv)
                    const UV orev = rev;
                    rev += (*end - '0') * mult;
                    mult *= 10;
-                   if (orev > rev && ckWARN_d(WARN_OVERFLOW))
-                       Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
-                                   "Integer overflow in decimal number");
+                   if (orev > rev)
+                       Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
+                                        "Integer overflow in decimal number");
                }
            }
 #ifdef EBCDIC