projects / p5sagit/p5-mst-13.2.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw
do subname() is deprecated, so update this hunk of test dating from perl 1.
[p5sagit/p5-mst-13.2.git] / toke.c
diff --git a/toke.c b/toke.c
index 02ddf97..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);
@@ -451,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
  *
@@ -585,35 +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;
-
-    Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED), "Use of %s is deprecated", s);
-}
-
-static void
-S_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;
-
-    Perl_ck_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.
  */
@@ -1217,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);
 }
 
 /*
@@ -4879,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();
            }
        }
 
@@ -5137,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);
@@ -5154,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);
@@ -5580,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:
@@ -5725,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);
            }
@@ -8716,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;
@@ -11296,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;
@@ -12207,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 */
                    }
@@ -12703,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);
@@ -12947,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
Unnamed repository; edit this file to name it for gitweb.