Add Perl_ck_warner(), which combines Perl_ckwarn() and Perl_warner().

Replace ckWARN{,2,3,4}() && Perl_warner() with it, which trades reduced code
size (about 0.2%), for 1 more function call if warnings are not enabled.
However, if we're now in the L1 or L2 cache when we weren't previously, that's
still going to be a speed win.

diff --git a/doop.c b/doop.c
index 5cce7ed..d3c49b5 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -807,9 +807,8 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
            }
 #ifdef UV_IS_QUAD
            else if (size == 64) {
-               if (ckWARN(WARN_PORTABLE))
-                   Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
-                               "Bit vector size > 32 non-portable");
+               Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
+                              "Bit vector size > 32 non-portable");
                if (uoffset >= srclen)
                    retnum = 0;
                else if (uoffset + 1 >= srclen)
@@ -875,9 +874,8 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
                      s[uoffset + 3];
 #ifdef UV_IS_QUAD
        else if (size == 64) {
-           if (ckWARN(WARN_PORTABLE))
-               Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
-                           "Bit vector size > 32 non-portable");
+           Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
+                          "Bit vector size > 32 non-portable");
            retnum =
                ((UV) s[uoffset    ] << 56) +
                ((UV) s[uoffset + 1] << 48) +
@@ -968,9 +966,8 @@ Perl_do_vecset(pTHX_ SV *sv)
        }
 #ifdef UV_IS_QUAD
        else if (size == 64) {
-           if (ckWARN(WARN_PORTABLE))
-               Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
-                           "Bit vector size > 32 non-portable");
+           Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
+                          "Bit vector size > 32 non-portable");
            s[offset  ] = (U8)((lval >> 56) & 0xff);
            s[offset+1] = (U8)((lval >> 48) & 0xff);
            s[offset+2] = (U8)((lval >> 40) & 0xff);

diff --git a/embed.fnc b/embed.fnc
index c76f0e7..23277ee 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1181,6 +1181,7 @@ XEpd      |void   |report_uninit  |NULLOK const SV *uninit_sv
 Afpd   |void   |warn           |NN const char* pat|...
 Ap     |void   |vwarn          |NN const char* pat|NULLOK va_list* args
 Afp    |void   |warner         |U32 err|NN const char* pat|...
+Afp    |void   |ck_warner      |U32 err|NN const char* pat|...
 Ap     |void   |vwarner        |U32 err|NN const char* pat|NULLOK va_list* args
 : FIXME
 p      |void   |watch          |NN char** addr

diff --git a/embed.h b/embed.h
index cd254f5..b4fd020 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1040,6 +1040,7 @@
 #define warn                   Perl_warn
 #define vwarn                  Perl_vwarn
 #define warner                 Perl_warner
+#define ck_warner              Perl_ck_warner
 #define vwarner                        Perl_vwarner
 #ifdef PERL_CORE
 #define watch                  Perl_watch

diff --git a/global.sym b/global.sym
index 222ea71..9bdcacb 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -613,6 +613,7 @@ Perl_report_uninit
 Perl_warn
 Perl_vwarn
 Perl_warner
+Perl_ck_warner
 Perl_vwarner
 Perl_whichsig
 Perl_yylex

diff --git a/gv.c b/gv.c
index 3df4e27..6b38fe4 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -413,9 +413,8 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
         cstash = gv_stashsv(linear_sv, 0);
 
         if (!cstash) {
-            if (ckWARN(WARN_SYNTAX))
-                Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Can't locate package %"SVf" for @%s::ISA",
-                    SVfARG(linear_sv), hvname);
+           Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Can't locate package %"SVf" for @%s::ISA",
+                          SVfARG(linear_sv), hvname);
             continue;
         }
 
@@ -729,11 +728,10 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
      * Inheriting AUTOLOAD for non-methods works ... for now.
      */
     if (!method && (GvCVGEN(gv) || GvSTASH(gv) != stash)
-       && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)
     )
-       Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
-         "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
-            packname, (int)len, name);
+       Perl_ck_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
+                      "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
+                      packname, (int)len, name);
 
     if (CvISXSUB(cv)) {
         /* rather than lookup/init $AUTOLOAD here

diff --git a/mg.c b/mg.c
index 2f9b017..05f8cd9 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1428,8 +1428,8 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
            mg->mg_private = (U16)i;
        }
        if (i <= 0) {
-           if (sv && ckWARN(WARN_SIGNAL))
-               Perl_warner(aTHX_ packWARN(WARN_SIGNAL), "No such signal: SIG%s", s);
+           if (sv)
+               Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), "No such signal: SIG%s", s);
            return 0;
        }
 #ifdef HAS_SIGPROCMASK
@@ -1880,9 +1880,8 @@ Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
     if (obj) {
        av_fill(obj, SvIV(sv) - CopARYBASE_get(PL_curcop));
     } else {
-       if (ckWARN(WARN_MISC))
-           Perl_warner(aTHX_ packWARN(WARN_MISC),
-                       "Attempt to set length of freed array");
+       Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
+                      "Attempt to set length of freed array");
     }
     return 0;
 }
@@ -2863,12 +2862,11 @@ Perl_sighandler(int sig)
     }
 
     if (!cv || !CvROOT(cv)) {
-       if (ckWARN(WARN_SIGNAL))
-           Perl_warner(aTHX_ packWARN(WARN_SIGNAL), "SIG%s handler \"%s\" not defined.\n",
-               PL_sig_name[sig], (gv ? GvENAME(gv)
-                               : ((cv && CvGV(cv))
-                                  ? GvENAME(CvGV(cv))
-                                  : "__ANON__")));
+       Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), "SIG%s handler \"%s\" not defined.\n",
+                      PL_sig_name[sig], (gv ? GvENAME(gv)
+                                         : ((cv && CvGV(cv))
+                                            ? GvENAME(CvGV(cv))
+                                            : "__ANON__")));
        goto cleanup;
     }
 

diff --git a/numeric.c b/numeric.c
index 1e847b7..2b4d68d 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -199,9 +199,9 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
                ++s;
                 goto redo;
            }
-        if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT) && ckWARN(WARN_DIGIT))
-            Perl_warner(aTHX_ packWARN(WARN_DIGIT),
-                        "Illegal binary digit '%c' ignored", *s);
+        if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
+            Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT),
+                          "Illegal binary digit '%c' ignored", *s);
         break;
     }
     
@@ -210,9 +210,8 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
        || (!overflowed && value > 0xffffffff  )
 #endif
        ) {
-       if (ckWARN(WARN_PORTABLE))
-           Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
-                       "Binary number > 0b11111111111111111111111111111111 non-portable");
+       Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
+                      "Binary number > 0b11111111111111111111111111111111 non-portable");
     }
     *len_p = s - start;
     if (!overflowed) {
@@ -318,8 +317,8 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
                ++s;
                 goto redo;
            }
-        if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT) && ckWARN(WARN_DIGIT))
-            Perl_warner(aTHX_ packWARN(WARN_DIGIT),
+        if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
+            Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT),
                         "Illegal hexadecimal digit '%c' ignored", *s);
         break;
     }
@@ -329,9 +328,8 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
        || (!overflowed && value > 0xffffffff  )
 #endif
        ) {
-       if (ckWARN(WARN_PORTABLE))
-           Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
-                       "Hexadecimal number > 0xffffffff non-portable");
+       Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
+                      "Hexadecimal number > 0xffffffff non-portable");
     }
     *len_p = s - start;
     if (!overflowed) {
@@ -424,9 +422,9 @@ Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
          * as soon as non-octal characters are seen, complain only if
          * someone seems to want to use the digits eight and nine). */
         if (digit == 8 || digit == 9) {
-            if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT) && ckWARN(WARN_DIGIT))
-                Perl_warner(aTHX_ packWARN(WARN_DIGIT),
-                            "Illegal octal digit '%c' ignored", *s);
+            if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
+                Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT),
+                              "Illegal octal digit '%c' ignored", *s);
         }
         break;
     }
@@ -436,9 +434,8 @@ Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
        || (!overflowed && value > 0xffffffff  )
 #endif
        ) {
-       if (ckWARN(WARN_PORTABLE))
-           Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
-                       "Octal number > 037777777777 non-portable");
+       Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
+                      "Octal number > 037777777777 non-portable");
     }
     *len_p = s - start;
     if (!overflowed) {

diff --git a/op.c b/op.c
index e341b08..35b7c95 100644 (file)
--- a/op.c
+++ b/op.c
@@ -908,8 +908,7 @@ Perl_scalar(pTHX_ OP *o)
        PL_curcop = &PL_compiling;
        break;
     case OP_SORT:
-       if (ckWARN(WARN_VOID))
-           Perl_warner(aTHX_ packWARN(WARN_VOID), "Useless use of sort in scalar context");
+       Perl_ck_warner(aTHX_ packWARN(WARN_VOID), "Useless use of sort in scalar context");
        break;
     }
     return o;
@@ -1188,8 +1187,8 @@ Perl_scalarvoid(pTHX_ OP *o)
     case OP_SCALAR:
        return scalar(o);
     }
-    if (useless && ckWARN(WARN_VOID))
-       Perl_warner(aTHX_ packWARN(WARN_VOID), "Useless use of %s in void context", useless);
+    if (useless)
+       Perl_ck_warner(aTHX_ packWARN(WARN_VOID), "Useless use of %s in void context", useless);
     return o;
 }
 
@@ -1667,10 +1666,8 @@ Perl_mod(pTHX_ OP *o, I32 type)
        case 0:
            break;
        case -1:
-           if (ckWARN(WARN_SYNTAX)) {
-               Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                   "Useless localization of %s", OP_DESC(o));
-           }
+           Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+                          "Useless localization of %s", OP_DESC(o));
        }
     }
     else if (type != OP_GREPSTART && type != OP_ENTERSUB
@@ -3432,12 +3429,10 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        }
     }
 
-    if(ckWARN(WARN_MISC)) {
-        if(del && rlen == tlen) {
-            Perl_warner(aTHX_ packWARN(WARN_MISC), "Useless use of /d modifier in transliteration operator"); 
-        } else if(rlen > tlen) {
-            Perl_warner(aTHX_ packWARN(WARN_MISC), "Replacement list is longer than search list");
-        } 
+    if(del && rlen == tlen) {
+       Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Useless use of /d modifier in transliteration operator"); 
+    } else if(rlen > tlen) {
+       Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Replacement list is longer than search list");
     }
 
     if (grows)
@@ -4543,8 +4538,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
     if ((cstop = search_const(first))) {
        if (cstop->op_private & OPpCONST_STRICT)
            no_bareword_allowed(cstop);
-       else if ((cstop->op_private & OPpCONST_BARE) && ckWARN(WARN_BAREWORD))
-               Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional");
+       else if ((cstop->op_private & OPpCONST_BARE))
+               Perl_ck_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional");
        if ((type == OP_AND &&  SvTRUE(((SVOP*)cstop)->op_sv)) ||
            (type == OP_OR  && !SvTRUE(((SVOP*)cstop)->op_sv)) ||
            (type == OP_DOR && !SvOK(((SVOP*)cstop)->op_sv))) {
@@ -4574,11 +4569,10 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
            if ((o2->op_type == OP_PADSV || o2->op_type == OP_PADAV
                        || o2->op_type == OP_PADHV)
                && o2->op_private & OPpLVAL_INTRO
-               && !(o2->op_private & OPpPAD_STATE)
-               && ckWARN(WARN_DEPRECATED))
+               && !(o2->op_private & OPpPAD_STATE))
            {
-               Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
-                           "Deprecated use of my() in false conditional");
+               Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+                              "Deprecated use of my() in false conditional");
            }
 
            *otherp = NULL;
@@ -5901,18 +5895,18 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
                return;
        } else if (*name == 'C') {
            if (strEQ(name, "CHECK")) {
-               if (PL_main_start && ckWARN(WARN_VOID))
-                   Perl_warner(aTHX_ packWARN(WARN_VOID),
-                               "Too late to run CHECK block");
+               if (PL_main_start)
+                   Perl_ck_warner(aTHX_ packWARN(WARN_VOID),
+                                  "Too late to run CHECK block");
                Perl_av_create_and_unshift_one(aTHX_ &PL_checkav, MUTABLE_SV(cv));
            }
            else
                return;
        } else if (*name == 'I') {
            if (strEQ(name, "INIT")) {
-               if (PL_main_start && ckWARN(WARN_VOID))
-                   Perl_warner(aTHX_ packWARN(WARN_VOID),
-                               "Too late to run INIT block");
+               if (PL_main_start)
+                   Perl_ck_warner(aTHX_ packWARN(WARN_VOID),
+                                  "Too late to run INIT block");
                Perl_av_create_and_push(aTHX_ &PL_initav, MUTABLE_SV(cv));
            }
            else
@@ -6273,10 +6267,9 @@ Perl_newAVREF(pTHX_ OP *o)
        o->op_ppaddr = PL_ppaddr[OP_PADAV];
        return o;
     }
-    else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV)
-               && ckWARN(WARN_DEPRECATED)) {
-       Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
-               "Using an array as a reference is deprecated");
+    else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV)) {
+       Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+                      "Using an array as a reference is deprecated");
     }
     return newUNOP(OP_RV2AV, 0, scalar(o));
 }
@@ -6301,10 +6294,9 @@ Perl_newHVREF(pTHX_ OP *o)
        o->op_ppaddr = PL_ppaddr[OP_PADHV];
        return o;
     }
-    else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV)
-               && ckWARN(WARN_DEPRECATED)) {
-       Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
-               "Using a hash as a reference is deprecated");
+    else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV)) {
+       Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+                      "Using a hash as a reference is deprecated");
     }
     return newUNOP(OP_RV2HV, 0, scalar(o));
 }
@@ -6371,12 +6363,11 @@ Perl_ck_bitop(pTHX_ OP *o)
                (left->op_flags & OPf_PARENS) == 0) ||
            (OP_IS_NUMCOMPARE(right->op_type) &&
                (right->op_flags & OPf_PARENS) == 0))
-           if (ckWARN(WARN_PRECEDENCE))
-               Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE),
-                       "Possible precedence problem on bitwise %c operator",
-                       o->op_type == OP_BIT_OR ? '|'
-                           : o->op_type == OP_BIT_AND ? '&' : '^'
-                       );
+           Perl_ck_warner(aTHX_ packWARN(WARN_PRECEDENCE),
+                          "Possible precedence problem on bitwise %c operator",
+                          o->op_type == OP_BIT_OR ? '|'
+                          : o->op_type == OP_BIT_AND ? '&' : '^'
+                          );
     }
     return o;
 }
@@ -6847,20 +6838,19 @@ Perl_ck_fun(pTHX_ OP *o)
                break;
            case OA_AVREF:
                if ((type == OP_PUSH || type == OP_UNSHIFT)
-                   && !kid->op_sibling && ckWARN(WARN_SYNTAX))
-                   Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                       "Useless use of %s with no values",
-                       PL_op_desc[type]);
+                   && !kid->op_sibling)
+                   Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+                                  "Useless use of %s with no values",
+                                  PL_op_desc[type]);
 
                if (kid->op_type == OP_CONST &&
                    (kid->op_private & OPpCONST_BARE))
                {
                    OP * const newop = newAVREF(newGVOP(OP_GV, 0,
                        gv_fetchsv(((SVOP*)kid)->op_sv, GV_ADD, SVt_PVAV) ));
-                   if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
-                       Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
-                           "Array @%"SVf" missing the @ in argument %"IVdf" of %s()",
-                           SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]);
+                   Perl_ck_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
+                                  "Array @%"SVf" missing the @ in argument %"IVdf" of %s()",
+                                  SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]);
 #ifdef PERL_MAD
                    op_getmad(kid,newop,'K');
 #else
@@ -6880,10 +6870,9 @@ Perl_ck_fun(pTHX_ OP *o)
                {
                    OP * const newop = newHVREF(newGVOP(OP_GV, 0,
                        gv_fetchsv(((SVOP*)kid)->op_sv, GV_ADD, SVt_PVHV) ));
-                   if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
-                       Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
-                           "Hash %%%"SVf" missing the %% in argument %"IVdf" of %s()",
-                           SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]);
+                   Perl_ck_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
+                                  "Hash %%%"SVf" missing the %% in argument %"IVdf" of %s()",
+                                  SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]);
 #ifdef PERL_MAD
                    op_getmad(kid,newop,'K');
 #else
@@ -7219,7 +7208,7 @@ Perl_ck_defined(pTHX_ OP *o)              /* 19990527 MJD */
 {
     PERL_ARGS_ASSERT_CK_DEFINED;
 
-    if ((o->op_flags & OPf_KIDS) && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) {
+    if ((o->op_flags & OPf_KIDS)) {
        switch (cUNOPo->op_first->op_type) {
        case OP_RV2AV:
            /* This is needed for
@@ -7229,10 +7218,10 @@ Perl_ck_defined(pTHX_ OP *o)            /* 19990527 MJD */
            break;                      /* Globals via GV can be undef */
        case OP_PADAV:
        case OP_AASSIGN:                /* Is this a good idea? */
-           Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
-                       "defined(@array) is deprecated");
-           Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
-                       "\t(Maybe you should just omit the defined()?)\n");
+           Perl_ck_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
+                          "defined(@array) is deprecated");
+           Perl_ck_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
+                          "\t(Maybe you should just omit the defined()?)\n");
        break;
        case OP_RV2HV:
            /* This is needed for
@@ -7241,10 +7230,10 @@ Perl_ck_defined(pTHX_ OP *o)            /* 19990527 MJD */
               */
            break;                      /* Globals via GV can be undef */
        case OP_PADHV:
-           Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
-                       "defined(%%hash) is deprecated");
-           Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
-                       "\t(Maybe you should just omit the defined()?)\n");
+           Perl_ck_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
+                          "defined(%%hash) is deprecated");
+           Perl_ck_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
+                          "\t(Maybe you should just omit the defined()?)\n");
            break;
        default:
            /* no warning */
@@ -7887,9 +7876,9 @@ Perl_ck_split(pTHX_ OP *o)
     kid->op_type = OP_PUSHRE;
     kid->op_ppaddr = PL_ppaddr[OP_PUSHRE];
     scalar(kid);
-    if (((PMOP *)kid)->op_pmflags & PMf_GLOBAL && ckWARN(WARN_REGEXP)) {
-      Perl_warner(aTHX_ packWARN(WARN_REGEXP),
-                  "Use of /g modifier is meaningless in split");
+    if (((PMOP *)kid)->op_pmflags & PMf_GLOBAL) {
+      Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP),
+                    "Use of /g modifier is meaningless in split");
     }
 
     if (!kid->op_sibling)

diff --git a/pad.c b/pad.c
index a68e202..123342f 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -781,9 +781,9 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                        ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
                        : *out_flags & PAD_FAKELEX_ANON)
                {
-                   if (warn && ckWARN(WARN_CLOSURE))
-                       Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
-                           "Variable \"%s\" is not available", name);
+                   if (warn)
+                       Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
+                                      "Variable \"%s\" is not available", name);
                    *out_capture = NULL;
                }
 
@@ -823,9 +823,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                    if (SvPADSTALE(*out_capture)
                        && !SvPAD_STATE(name_svp[offset]))
                    {
-                       if (ckWARN(WARN_CLOSURE))
-                           Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
-                               "Variable \"%s\" is not available", name);
+                       Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
+                                      "Variable \"%s\" is not available", name);
                        *out_capture = NULL;
                    }
                }
@@ -1527,9 +1526,8 @@ Perl_cv_clone(pTHX_ CV *proto)
                   while my $x if $false can leave an active var marked as
                   stale. And state vars are always available */
                if (SvPADSTALE(sv) && !SvPAD_STATE(namesv)) {
-                   if (ckWARN(WARN_CLOSURE))
-                       Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
-                           "Variable \"%s\" is not available", SvPVX_const(namesv));
+                   Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
+                                  "Variable \"%s\" is not available", SvPVX_const(namesv));
                    sv = NULL;
                }
                else 

diff --git a/perl.c b/perl.c
index 2c51286..7e5a406 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1996,9 +1996,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #  endif
            Sighandler_t sigstate = rsignal_state(SIGCHLD);
            if (sigstate == (Sighandler_t) SIG_IGN) {
-               if (ckWARN(WARN_SIGNAL))
-                   Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
-                               "Can't ignore signal CHLD, forcing to default");
+               Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL),
+                              "Can't ignore signal CHLD, forcing to default");
                (void)rsignal(SIGCHLD, (Sighandler_t)SIG_DFL);
            }
        }

diff --git a/perlio.c b/perlio.c
index 50966e6..36bf0ac 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -981,10 +981,9 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
                     * seen as an invalid separator character.
                     */
                    const char q = ((*s == '\'') ? '"' : '\'');
-                   if (ckWARN(WARN_LAYER))
-                       Perl_warner(aTHX_ packWARN(WARN_LAYER),
-                             "Invalid separator character %c%c%c in PerlIO layer specification %s",
-                             q, *s, q, s);
+                   Perl_ck_warner(aTHX_ packWARN(WARN_LAYER),
+                                  "Invalid separator character %c%c%c in PerlIO layer specification %s",
+                                  q, *s, q, s);
                    SETERRNO(EINVAL, LIB_INVARG);
                    return -1;
                }
@@ -1018,10 +1017,9 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
                             */
                        case '\0':
                            e--;
-                           if (ckWARN(WARN_LAYER))
-                               Perl_warner(aTHX_ packWARN(WARN_LAYER),
-                                     "Argument list not closed for PerlIO layer \"%.*s\"",
-                                     (int) (e - s), s);
+                           Perl_ck_warner(aTHX_ packWARN(WARN_LAYER),
+                                          "Argument list not closed for PerlIO layer \"%.*s\"",
+                                          (int) (e - s), s);
                            return -1;
                        default:
                            /*
@@ -1044,9 +1042,8 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
                            SvREFCNT_dec(arg);
                    }
                    else {
-                       if (ckWARN(WARN_LAYER))
-                           Perl_warner(aTHX_ packWARN(WARN_LAYER), "Unknown PerlIO layer \"%.*s\"",
-                                 (int) llen, s);
+                       Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), "Unknown PerlIO layer \"%.*s\"",
+                                      (int) llen, s);
                        return -1;
                    }
                }
@@ -1460,8 +1457,8 @@ PerlIO_layer_from_ref(pTHX_ SV *sv)
        PerlIO_funcs *f = PerlIO_find_layer(aTHX_ STR_WITH_LEN("scalar"), 1);
        /* This isn't supposed to happen, since PerlIO::scalar is core,
         * but could happen anyway in smaller installs or with PAR */
-       if (!f && ckWARN(WARN_LAYER))
-           Perl_warner(aTHX_ packWARN(WARN_LAYER), "Unknown PerlIO layer \"scalar\"");
+       if (!f)
+           Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), "Unknown PerlIO layer \"scalar\"");
        return f;
     }
 

diff --git a/pp.c b/pp.c
index ef7d7ab..d720b70 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -576,9 +576,9 @@ PP(pp_bless)
        if (ssv && !SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv))
            Perl_croak(aTHX_ "Attempt to bless into a reference");
        ptr = SvPV_const(ssv,len);
-       if (len == 0 && ckWARN(WARN_MISC))
-           Perl_warner(aTHX_ packWARN(WARN_MISC),
-                  "Explicit blessing to '' (assuming package main)");
+       if (len == 0)
+           Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
+                          "Explicit blessing to '' (assuming package main)");
        stash = gv_stashpvn(ptr, len, GV_ADD);
     }
 
@@ -813,10 +813,10 @@ PP(pp_undef)
        hv_undef(MUTABLE_HV(sv));
        break;
     case SVt_PVCV:
-       if (cv_const_sv((const CV *)sv) && ckWARN(WARN_MISC))
-           Perl_warner(aTHX_ packWARN(WARN_MISC), "Constant subroutine %s undefined",
-                CvANON((const CV *)sv) ? "(anonymous)"
-                       : GvENAME(CvGV((const CV *)sv)));
+       if (cv_const_sv((const CV *)sv))
+           Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Constant subroutine %s undefined",
+                          CvANON((const CV *)sv) ? "(anonymous)"
+                          : GvENAME(CvGV((const CV *)sv)));
        /* FALLTHROUGH */
     case SVt_PVFM:
        {
@@ -3148,8 +3148,7 @@ PP(pp_substr)
     if (fail < 0) {
        if (lvalue || repl)
            Perl_croak(aTHX_ "substr outside of string");
-       if (ckWARN(WARN_SUBSTR))
-           Perl_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string");
+       Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string");
        RETPUSHUNDEF;
     }
     else {
@@ -3198,9 +3197,8 @@ PP(pp_substr)
            if (!SvGMAGICAL(sv)) {
                if (SvROK(sv)) {
                    SvPV_force_nolen(sv);
-                   if (ckWARN(WARN_SUBSTR))
-                       Perl_warner(aTHX_ packWARN(WARN_SUBSTR),
-                               "Attempt to use reference as lvalue in substr");
+                   Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR),
+                                  "Attempt to use reference as lvalue in substr");
                }
                if (isGV_with_GP(sv))
                    SvPV_force_nolen(sv);
@@ -4491,8 +4489,8 @@ PP(pp_anonhash)
        SV * const val = newSV(0);
        if (MARK < SP)
            sv_setsv(val, *++MARK);
-       else if (ckWARN(WARN_MISC))
-           Perl_warner(aTHX_ packWARN(WARN_MISC), "Odd number of elements in anonymous hash");
+       else
+           Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Odd number of elements in anonymous hash");
        (void)hv_store_ent(hv,key,val,0);
     }
     SP = ORIGMARK;
@@ -4552,8 +4550,7 @@ PP(pp_splice)
        length = AvMAX(ary) + 1;
     }
     if (offset > AvFILLp(ary) + 1) {
-       if (ckWARN(WARN_MISC))
-           Perl_warner(aTHX_ packWARN(WARN_MISC), "splice() offset past end of array" );
+       Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "splice() offset past end of array" );
        offset = AvFILLp(ary) + 1;
     }
     after = AvFILLp(ary) + 1 - (offset + length);

diff --git a/pp_ctl.c b/pp_ctl.c
index e69bf0c..bbac702 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -535,8 +535,7 @@ PP(pp_formline)
                sv = *++MARK;
            else {
                sv = &PL_sv_no;
-               if (ckWARN(WARN_SYNTAX))
-                   Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Not enough format arguments");
+               Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Not enough format arguments");
            }
            break;
 
@@ -1283,9 +1282,8 @@ S_dopoptolabel(pTHX_ const char *label)
        case CXt_FORMAT:
        case CXt_EVAL:
        case CXt_NULL:
-           if (ckWARN(WARN_EXITING))
-               Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
-                       context_name[CxTYPE(cx)], OP_NAME(PL_op));
+           Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
+                          context_name[CxTYPE(cx)], OP_NAME(PL_op));
            if (CxTYPE(cx) == CXt_NULL)
                return -1;
            break;
@@ -1404,9 +1402,8 @@ S_dopoptoloop(pTHX_ I32 startingblock)
        case CXt_FORMAT:
        case CXt_EVAL:
        case CXt_NULL:
-           if (ckWARN(WARN_EXITING))
-               Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
-                       context_name[CxTYPE(cx)], OP_NAME(PL_op));
+           Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
+                          context_name[CxTYPE(cx)], OP_NAME(PL_op));
            if ((CxTYPE(cx)) == CXt_NULL)
                return -1;
            break;
@@ -1548,14 +1545,13 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
                        e = NULL;
                }
                if (!e) {
+                   STRLEN start;
                    SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen);
                    sv_catpvn(err, prefix, sizeof(prefix)-1);
                    sv_catpvn(err, message, msglen);
-                   if (ckWARN(WARN_MISC)) {
-                       const STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
-                       Perl_warner(aTHX_ packWARN(WARN_MISC), "%s",
-                               SvPVX_const(err)+start);
-                   }
+                   start = SvCUR(err)-msglen-sizeof(prefix)+1;
+                   Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "%s",
+                                  SvPVX_const(err)+start);
                }
            }
            else {

diff --git a/pp_hot.c b/pp_hot.c
index 61d8b43..16992d4 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1675,11 +1675,11 @@ Perl_do_readline(pTHX)
                (void)do_close(PL_last_in_gv, FALSE);
            }
            else if (type == OP_GLOB) {
-               if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_GLOB)) {
-                   Perl_warner(aTHX_ packWARN(WARN_GLOB),
-                          "glob failed (child exited with status %d%s)",
-                          (int)(STATUS_CURRENT >> 8),
-                          (STATUS_CURRENT & 0x80) ? ", core dumped" : "");
+               if (!do_close(PL_last_in_gv, FALSE)) {
+                   Perl_ck_warner(aTHX_ packWARN(WARN_GLOB),
+                                  "glob failed (child exited with status %d%s)",
+                                  (int)(STATUS_CURRENT >> 8),
+                                  (STATUS_CURRENT & 0x80) ? ", core dumped" : "");
                }
            }
            if (gimme == G_SCALAR) {

diff --git a/pp_pack.c b/pp_pack.c
index ef25109..18f17f7 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -630,10 +630,9 @@ uni_to_byte(pTHX_ const char **s, const char *end, I32 datumtype)
        Perl_croak(aTHX_ "Malformed UTF-8 string in '%c' format in unpack",
                   (int) TYPE_NO_MODIFIERS(datumtype));
     if (val >= 0x100) {
-       if (ckWARN(WARN_UNPACK))
-       Perl_warner(aTHX_ packWARN(WARN_UNPACK),
-                   "Character in '%c' format wrapped in unpack",
-                   (int) TYPE_NO_MODIFIERS(datumtype));
+       Perl_ck_warner(aTHX_ packWARN(WARN_UNPACK),
+                      "Character in '%c' format wrapped in unpack",
+                      (int) TYPE_NO_MODIFIERS(datumtype));
        val &= 0xff;
     }
     *s += retlen;
@@ -678,13 +677,12 @@ uni_to_bytes(pTHX_ const char **s, const char *end, const char *buf, int buf_len
            }
            if (from > end) from = end;
        }
-       if ((bad & 2) && ((datumtype & TYPE_IS_PACK)
-                         ? ckWARN(WARN_PACK) : ckWARN(WARN_UNPACK)))
-           Perl_warner(aTHX_ packWARN(datumtype & TYPE_IS_PACK ?
+       if ((bad & 2))
+           Perl_ck_warner(aTHX_ packWARN(datumtype & TYPE_IS_PACK ?
                                       WARN_PACK : WARN_UNPACK),
-                       "Character(s) in '%c' format wrapped in %s",
-                       (int) TYPE_NO_MODIFIERS(datumtype),
-                       datumtype & TYPE_IS_PACK ? "pack" : "unpack");
+                          "Character(s) in '%c' format wrapped in %s",
+                          (int) TYPE_NO_MODIFIERS(datumtype),
+                          datumtype & TYPE_IS_PACK ? "pack" : "unpack");
     }
     *s = from;
     return TRUE;
@@ -1040,11 +1038,11 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
           Perl_croak(aTHX_ "Can't use '%c' in a group with different byte-order in %s",
                      *patptr, _action( symptr ) );
 
-        if ((code & modifier) && ckWARN(WARN_UNPACK)) {
-           Perl_warner(aTHX_ packWARN(WARN_UNPACK),
-                        "Duplicate modifier '%c' after '%c' in %s",
-                        *patptr, (int) TYPE_NO_MODIFIERS(code),
-                        _action( symptr ) );
+        if ((code & modifier)) {
+           Perl_ck_warner(aTHX_ packWARN(WARN_UNPACK),
+                          "Duplicate modifier '%c' after '%c' in %s",
+                          *patptr, (int) TYPE_NO_MODIFIERS(code),
+                          _action( symptr ) );
         }
 
         code |= modifier;
@@ -2951,10 +2949,9 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                IV aiv;
                fromstr = NEXTFROM;
                aiv = SvIV(fromstr);
-               if ((-128 > aiv || aiv > 127) &&
-                   ckWARN(WARN_PACK))
-                   Perl_warner(aTHX_ packWARN(WARN_PACK),
-                               "Character in 'c' format wrapped in pack");
+               if ((-128 > aiv || aiv > 127))
+                   Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
+                                  "Character in 'c' format wrapped in pack");
                PUSH_BYTE(utf8, cur, (U8)(aiv & 0xff));
            }
            break;
@@ -2967,10 +2964,9 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                IV aiv;
                fromstr = NEXTFROM;
                aiv = SvIV(fromstr);
-               if ((0 > aiv || aiv > 0xff) &&
-                   ckWARN(WARN_PACK))
-                   Perl_warner(aTHX_ packWARN(WARN_PACK),
-                               "Character in 'C' format wrapped in pack");
+               if ((0 > aiv || aiv > 0xff))
+                   Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
+                                  "Character in 'C' format wrapped in pack");
                PUSH_BYTE(utf8, cur, (U8)(aiv & 0xff));
            }
            break;
@@ -3012,9 +3008,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                            end = start+SvLEN(cat)-UTF8_MAXLEN;
                            goto W_utf8;
                        }
-                       if (ckWARN(WARN_PACK))
-                           Perl_warner(aTHX_ packWARN(WARN_PACK),
-                                       "Character in 'W' format wrapped in pack");
+                       Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
+                                      "Character in 'W' format wrapped in pack");
                        auv &= 0xff;
                    }
                    if (cur >= end) {
@@ -3501,9 +3496,9 @@ extern const double _double_constants[];
                     * gone.
                     */
                    if ((SvTEMP(fromstr) || (SvPADTMP(fromstr) &&
-                            !SvREADONLY(fromstr))) && ckWARN(WARN_PACK)) {
-                       Perl_warner(aTHX_ packWARN(WARN_PACK),
-                                   "Attempt to pack pointer to temporary value");
+                            !SvREADONLY(fromstr)))) {
+                       Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
+                                      "Attempt to pack pointer to temporary value");
                    }
                    if (SvPOK(fromstr) || SvNIOK(fromstr))
                        aptr = SvPV_nomg_const_nolen(fromstr);
@@ -3522,9 +3517,8 @@ extern const double _double_constants[];
            if (len <= 2) len = 45;
            else len = len / 3 * 3;
            if (len >= 64) {
-               if (ckWARN(WARN_PACK))
-                   Perl_warner(aTHX_ packWARN(WARN_PACK),
-                           "Field too wide in 'u' format in pack");
+               Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
+                              "Field too wide in 'u' format in pack");
                len = 63;
            }
            aptr = SvPV_const(fromstr, fromlen);

diff --git a/pp_sys.c b/pp_sys.c
index 3f13dfe..4c00651 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -521,9 +521,9 @@ PP(pp_open)
        MAGIC *mg;
        IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
 
-       if (IoDIRP(io) && ckWARN2(WARN_IO, WARN_DEPRECATED))
-           Perl_warner(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
-                   "Opening dirhandle %s also as a file", GvENAME(gv));
+       if (IoDIRP(io))
+           Perl_ck_warner(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
+                          "Opening dirhandle %s also as a file", GvENAME(gv));
 
        mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
@@ -892,10 +892,10 @@ PP(pp_untie)
               LEAVE;
               SPAGAIN;
             }
-           else if (mg && SvREFCNT(obj) > 1 && ckWARN(WARN_UNTIE)) {
-                 Perl_warner(aTHX_ packWARN(WARN_UNTIE),
-                     "untie attempted while %"UVuf" inner references still exist",
-                      (UV)SvREFCNT(obj) - 1 ) ;
+           else if (mg && SvREFCNT(obj) > 1) {
+               Perl_ck_warner(aTHX_ packWARN(WARN_UNTIE),
+                              "untie attempted while %"UVuf" inner references still exist",
+                              (UV)SvREFCNT(obj) - 1 ) ;
            }
         }
     }
@@ -1018,8 +1018,7 @@ PP(pp_sselect)
                DIE(aTHX_ "%s", PL_no_modify);
        }
        if (!SvPOK(sv)) {
-           if (ckWARN(WARN_MISC))
-                Perl_warner(aTHX_ packWARN(WARN_MISC), "Non-string passed as bitmask");
+           Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Non-string passed as bitmask");
            SvPV_force_nolen(sv);       /* force string conversion */
        }
        j = SvCUR(sv);
@@ -1417,8 +1416,7 @@ PP(pp_leavewrite)
     }
     else {
        if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) {
-           if (ckWARN(WARN_IO))
-               Perl_warner(aTHX_ packWARN(WARN_IO), "page overflow");
+           Perl_ck_warner(aTHX_ packWARN(WARN_IO), "page overflow");
        }
        if (!do_print(PL_formtarget, fp))
            PUSHs(&PL_sv_no);
@@ -2822,9 +2820,8 @@ PP(pp_stat)
        if (PL_op->op_type == OP_LSTAT) {
            if (gv != PL_defgv) {
            do_fstat_warning_check:
-               if (ckWARN(WARN_IO))
-                   Perl_warner(aTHX_ packWARN(WARN_IO),
-                       "lstat() on filehandle %s", gv ? GvENAME(gv) : "");
+               Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+                              "lstat() on filehandle %s", gv ? GvENAME(gv) : "");
            } else if (PL_laststype != OP_LSTAT)
                Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
        }
@@ -3831,9 +3828,9 @@ PP(pp_open_dir)
     if (!io)
        goto nope;
 
-    if ((IoIFP(io) || IoOFP(io)) && ckWARN2(WARN_IO, WARN_DEPRECATED))
-       Perl_warner(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
-               "Opening filehandle %s also as a directory", GvENAME(gv));
+    if ((IoIFP(io) || IoOFP(io)))
+       Perl_ck_warner(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
+                      "Opening filehandle %s also as a directory", GvENAME(gv));
     if (IoDIRP(io))
        PerlDir_close(IoDIRP(io));
     if (!(IoDIRP(io) = PerlDir_open(dirname)))
@@ -3867,10 +3864,8 @@ PP(pp_readdir)
     register IO * const io = GvIOn(gv);
 
     if (!io || !IoDIRP(io)) {
-        if(ckWARN(WARN_IO)) {
-            Perl_warner(aTHX_ packWARN(WARN_IO),
-                "readdir() attempted on invalid dirhandle %s", GvENAME(gv));
-        }
+       Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+                      "readdir() attempted on invalid dirhandle %s", GvENAME(gv));
         goto nope;
     }
 
@@ -3920,10 +3915,8 @@ PP(pp_telldir)
     register IO * const io = GvIOn(gv);
 
     if (!io || !IoDIRP(io)) {
-        if(ckWARN(WARN_IO)) {
-            Perl_warner(aTHX_ packWARN(WARN_IO),
-               "telldir() attempted on invalid dirhandle %s", GvENAME(gv));
-        }
+       Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+                      "telldir() attempted on invalid dirhandle %s", GvENAME(gv));
         goto nope;
     }
 
@@ -3947,10 +3940,8 @@ PP(pp_seekdir)
     register IO * const io = GvIOn(gv);
 
     if (!io || !IoDIRP(io)) {
-       if(ckWARN(WARN_IO)) {
-           Perl_warner(aTHX_ packWARN(WARN_IO),
-                "seekdir() attempted on invalid dirhandle %s", GvENAME(gv));
-        }
+       Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+                      "seekdir() attempted on invalid dirhandle %s", GvENAME(gv));
         goto nope;
     }
     (void)PerlDir_seek(IoDIRP(io), along);
@@ -3973,10 +3964,8 @@ PP(pp_rewinddir)
     register IO * const io = GvIOn(gv);
 
     if (!io || !IoDIRP(io)) {
-       if(ckWARN(WARN_IO)) {
-           Perl_warner(aTHX_ packWARN(WARN_IO),
-               "rewinddir() attempted on invalid dirhandle %s", GvENAME(gv));
-       }
+       Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+                      "rewinddir() attempted on invalid dirhandle %s", GvENAME(gv));
        goto nope;
     }
     (void)PerlDir_rewind(IoDIRP(io));
@@ -3998,10 +3987,8 @@ PP(pp_closedir)
     register IO * const io = GvIOn(gv);
 
     if (!io || !IoDIRP(io)) {
-       if(ckWARN(WARN_IO)) {
-           Perl_warner(aTHX_ packWARN(WARN_IO),
-                "closedir() attempted on invalid dirhandle %s", GvENAME(gv));
-        }
+       Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+                      "closedir() attempted on invalid dirhandle %s", GvENAME(gv));
         goto nope;
     }
 #ifdef VOID_CLOSEDIR
@@ -4489,9 +4476,9 @@ PP(pp_gmtime)
     else {
        double input = Perl_floor(POPn);
        when = (Time64_T)input;
-       if (when != input && ckWARN(WARN_OVERFLOW)) {
-           Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
-                       "%s(%.0f) too large", opname, input);
+       if (when != input) {
+           Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+                          "%s(%.0f) too large", opname, input);
        }
     }
 
@@ -4500,10 +4487,10 @@ PP(pp_gmtime)
     else
        err = S_gmtime64_r(&when, &tmbuf);
 
-    if (err == NULL && ckWARN(WARN_OVERFLOW)) {
+    if (err == NULL) {
        /* XXX %lld broken for quads */
-       Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
-                   "%s(%.0f) failed", opname, (double)when);
+       Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+                      "%s(%.0f) failed", opname, (double)when);
     }
 
     if (GIMME != G_ARRAY) {    /* scalar context */

diff --git a/proto.h b/proto.h
index df73c20..4afff50 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3702,6 +3702,12 @@ PERL_CALLCONV void       Perl_warner(pTHX_ U32 err, const char* pat, ...)
 #define PERL_ARGS_ASSERT_WARNER        \
        assert(pat)
 
+PERL_CALLCONV void     Perl_ck_warner(pTHX_ U32 err, const char* pat, ...)
+                       __attribute__format__(__printf__,pTHX_2,pTHX_3)
+                       __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_CK_WARNER     \
+       assert(pat)
+
 PERL_CALLCONV void     Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args)
                        __attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT_VWARNER       \

diff --git a/sv.c b/sv.c
index 976cfe3..cf1e698 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4005,9 +4005,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
     }
     else if (dtype == SVt_PVGV && isGV_with_GP(dstr)) {
        if (!(sflags & SVf_OK)) {
-           if (ckWARN(WARN_MISC))
-               Perl_warner(aTHX_ packWARN(WARN_MISC),
-                           "Undefined value assigned to typeglob");
+           Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
+                          "Undefined value assigned to typeglob");
        }
        else {
            GV *gv = gv_fetchsv(sstr, GV_ADD, SVt_PVGV);
@@ -5239,8 +5238,7 @@ Perl_sv_rvweaken(pTHX_ SV *const sv)
     if (!SvROK(sv))
        Perl_croak(aTHX_ "Can't weaken a nonreference");
     else if (SvWEAKREF(sv)) {
-       if (ckWARN(WARN_MISC))
-           Perl_warner(aTHX_ packWARN(WARN_MISC), "Reference is already weak");
+       Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Reference is already weak");
        return sv;
     }
     tsv = SvRV(sv);
@@ -7284,10 +7282,10 @@ Perl_sv_inc(pTHX_ register SV *const sv)
     if (flags & SVp_NOK) {
        const NV was = SvNVX(sv);
        if (NV_OVERFLOWS_INTEGERS_AT &&
-           was >= NV_OVERFLOWS_INTEGERS_AT && ckWARN(WARN_IMPRECISION)) {
-           Perl_warner(aTHX_ packWARN(WARN_IMPRECISION),
-                       "Lost precision when incrementing %" NVff " by 1",
-                       was);
+           was >= NV_OVERFLOWS_INTEGERS_AT) {
+           Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION),
+                          "Lost precision when incrementing %" NVff " by 1",
+                          was);
        }
        (void)SvNOK_only(sv);
         SvNV_set(sv, was + 1.0);
@@ -7450,10 +7448,10 @@ Perl_sv_dec(pTHX_ register SV *const sv)
        {
            const NV was = SvNVX(sv);
            if (NV_OVERFLOWS_INTEGERS_AT &&
-               was <= -NV_OVERFLOWS_INTEGERS_AT && ckWARN(WARN_IMPRECISION)) {
-               Perl_warner(aTHX_ packWARN(WARN_IMPRECISION),
-                           "Lost precision when decrementing %" NVff " by 1",
-                           was);
+               was <= -NV_OVERFLOWS_INTEGERS_AT) {
+               Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION),
+                              "Lost precision when decrementing %" NVff " by 1",
+                              was);
            }
            (void)SvNOK_only(sv);
            SvNV_set(sv, was - 1.0);

diff --git a/toke.c b/toke.c
index 4ace11f..02ddf97 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -593,8 +593,7 @@ 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);
+    Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED), "Use of %s is deprecated", s);
 }
 
 static void
@@ -610,9 +609,8 @@ S_deprecate_old(pTHX_ const char *const s)
 
     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);
+    Perl_ck_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
+                  "Use of %s is deprecated", s);
 }
 
 /*
@@ -2193,9 +2191,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 +2209,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 +2237,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;
                }
@@ -5190,9 +5186,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);
@@ -5335,17 +5331,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 &");
            }
        }
 
@@ -7175,13 +7170,12 @@ S_pending_ident(pTHX)
                /* DO NOT warn for @- and @+ */
                && !( PL_tokenbuf[2] == '\0' &&
                    ( PL_tokenbuf[1] == '-' || PL_tokenbuf[1] == '+' ))
-               && ckWARN(WARN_AMBIGUOUS)
           )
         {
             /* 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);
         }
     }
 
@@ -11048,11 +11042,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;
@@ -11134,8 +11127,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) {
@@ -12147,8 +12140,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++;
            }
@@ -12171,9 +12163,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;
 
@@ -12245,24 +12237,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);
            }
@@ -12291,9 +12282,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 {
@@ -12307,8 +12298,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
@@ -12320,9 +12310,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;
            }
 
@@ -12333,9 +12322,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
@@ -12343,9 +12332,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" */
@@ -12364,9 +12352,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++;
            }
 
@@ -12376,9 +12363,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++;
            }
 
@@ -12391,10 +12377,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++;
                }
            }

diff --git a/util.c b/util.c
index 6ee5ddf..2018540 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1529,6 +1529,19 @@ Perl_warner_nocontext(U32 err, const char *pat, ...)
 #endif /* PERL_IMPLICIT_CONTEXT */
 
 void
+Perl_ck_warner(pTHX_ U32 err, const char* pat, ...)
+{
+    PERL_ARGS_ASSERT_CK_WARNER;
+
+    if (Perl_ckwarn(aTHX_ err)) {
+       va_list args;
+       va_start(args, pat);
+       vwarner(err, pat, &args);
+       va_end(args);
+    }
+}
+
+void
 Perl_warner(pTHX_ U32  err, const char* pat,...)
 {
     va_list args;
@@ -2275,8 +2288,7 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args)
            }
            return NULL;
        }
-       if (ckWARN(WARN_PIPE))
-           Perl_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds");
+       Perl_ck_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds");
        sleep(5);
     }
     if (pid == 0) {
@@ -2423,8 +2435,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
                Perl_croak(aTHX_ "Can't fork: %s", Strerror(errno));
            return NULL;
        }
-       if (ckWARN(WARN_PIPE))
-           Perl_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds");
+       Perl_ck_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds");
        sleep(5);
     }
     if (pid == 0) {
@@ -4295,9 +4306,8 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
                        mult /= 10;
                        if (   (PERL_ABS(orev) > PERL_ABS(rev)) 
                            || (PERL_ABS(rev) > VERSION_MAX )) {
-                           if(ckWARN(WARN_OVERFLOW))
-                               Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), 
-                               "Integer overflow in version %d",VERSION_MAX);
+                           Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), 
+                                          "Integer overflow in version %d",VERSION_MAX);
                            s = end - 1;
                            rev = VERSION_MAX;
                            vinf = 1;
@@ -4314,9 +4324,8 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
                        mult *= 10;
                        if (   (PERL_ABS(orev) > PERL_ABS(rev)) 
                            || (PERL_ABS(rev) > VERSION_MAX )) {
-                           if(ckWARN(WARN_OVERFLOW))
-                               Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), 
-                               "Integer overflow in version");
+                           Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), 
+                                          "Integer overflow in version");
                            end = s - 1;
                            rev = VERSION_MAX;
                            vinf = 1;
@@ -4564,10 +4573,9 @@ Perl_upg_version(pTHX_ SV *ver, bool qv)
 
     s = scan_version(version, ver, qv);
     if ( *s != '\0' ) 
-       if(ckWARN(WARN_MISC))
-           Perl_warner(aTHX_ packWARN(WARN_MISC), 
-               "Version string '%s' contains invalid data; "
-               "ignoring: '%s'", version, s);
+       Perl_ck_warner(aTHX_ packWARN(WARN_MISC), 
+                      "Version string '%s' contains invalid data; "
+                      "ignoring: '%s'", version, s);
     Safefree(version);
     return ver;
 }