diag_listed_as galore

In two instances, I actually modified to code to avoid %s for a
constant string, as it should be faster that way.

diff --git a/gv.c b/gv.c
index 37c1f9c..c0baa09 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1926,6 +1926,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
        case '*':               /* $* */
        case '#':               /* $# */
            if (sv_type == SVt_PV)
+               /* diag_listed_as: $* is no longer supported */
                Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
                                 "$%c is no longer supported", *name);
            break;
@@ -2346,6 +2347,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
                        const SV * const name = (gvsv && SvPOK(gvsv))
                                                     ? gvsv
                                                     : newSVpvs_flags("???", SVs_TEMP);
+                       /* diag_listed_as: Can't resolve method "%s" overloading "%s" in package "%s" */
                        Perl_croak(aTHX_ "%s method \"%"SVf256
                                    "\" overloading \"%s\" "\
                                    "in package \"%"HEKf256"\"",

diff --git a/numeric.c b/numeric.c
index 2749e5e..fe8837a 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -180,6 +180,7 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
                     continue;
                 }
                 /* Bah. We're just overflowed.  */
+               /* diag_listed_as: Integer overflow in %s number */
                Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
                                 "Integer overflow in binary number");
                 overflowed = TRUE;
@@ -302,6 +303,7 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
                     continue;
                 }
                 /* Bah. We're just overflowed.  */
+               /* diag_listed_as: Integer overflow in %s number */
                Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
                                 "Integer overflow in hexadecimal number");
                 overflowed = TRUE;
@@ -407,6 +409,7 @@ Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
                     continue;
                 }
                 /* Bah. We're just overflowed.  */
+               /* diag_listed_as: Integer overflow in %s number */
                Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
                               "Integer overflow in octal number");
                 overflowed = TRUE;

diff --git a/op.c b/op.c
index fea3014..7f217e7 100644 (file)
--- a/op.c
+++ b/op.c
@@ -6831,6 +6831,7 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
        } else if (*name == 'C') {
            if (strEQ(name, "CHECK")) {
                if (PL_main_start)
+                   /* diag_listed_as: Too late to run %s block */
                    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));
@@ -6840,6 +6841,7 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
        } else if (*name == 'I') {
            if (strEQ(name, "INIT")) {
                if (PL_main_start)
+                   /* diag_listed_as: Too late to run %s block */
                    Perl_ck_warner(aTHX_ packWARN(WARN_VOID),
                                   "Too late to run INIT block");
                Perl_av_create_and_push(aTHX_ &PL_initav, MUTABLE_SV(cv));
@@ -7072,6 +7074,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
                Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
                            "Format %"SVf" redefined", SVfARG(cSVOPo->op_sv));
            } else {
+               /* diag_listed_as: Format %s redefined */
                Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
                            "Format STDOUT redefined");
            }

diff --git a/perlio.c b/perlio.c
index 79c6fdf..c61ba44 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -1519,6 +1519,7 @@ PerlIO_layer_from_ref(pTHX_ SV *sv)
        /* This isn't supposed to happen, since PerlIO::scalar is core,
         * but could happen anyway in smaller installs or with PAR */
        if (!f)
+           /* diag_listed_as: Unknown PerlIO layer "%s" */
            Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), "Unknown PerlIO layer \"scalar\"");
        return f;
     }

diff --git a/pp.c b/pp.c
index f477f6a..eaf6a85 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -2715,6 +2715,7 @@ PP(pp_sin)
       if (neg_report) {
          if (op_type == OP_LOG ? (value <= 0.0) : (value < 0.0)) {
              SET_NUMERIC_STANDARD();
+             /* diag_listed_as: Can't take log of %g */
              DIE(aTHX_ "Can't take %s of %"NVgf, neg_report, value);
          }
       }

diff --git a/pp_ctl.c b/pp_ctl.c
index 3b7a079..b74855b 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1394,6 +1394,7 @@ S_dopoptolabel(pTHX_ const char *label)
        case CXt_FORMAT:
        case CXt_EVAL:
        case CXt_NULL:
+           /* diag_listed_as: Exiting subroutine via %s */
            Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
                           context_name[CxTYPE(cx)], OP_NAME(PL_op));
            if (CxTYPE(cx) == CXt_NULL)
@@ -1531,6 +1532,7 @@ S_dopoptoloop(pTHX_ I32 startingblock)
        case CXt_FORMAT:
        case CXt_EVAL:
        case CXt_NULL:
+           /* diag_listed_as: Exiting subroutine via %s */
            Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
                           context_name[CxTYPE(cx)], OP_NAME(PL_op));
            if ((CxTYPE(cx)) == CXt_NULL)

diff --git a/pp_hot.c b/pp_hot.c
index aea1f02..cbdcb90 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -774,6 +774,7 @@ PP(pp_rv2av)
        }
        sv = SvRV(sv);
        if (SvTYPE(sv) != type)
+           /* diag_listed_as: Not an ARRAY reference */
            DIE(aTHX_ "Not %s reference", is_pp_rv2av ? an_array : a_hash);
        if (PL_op->op_flags & OPf_REF) {
            SETs(sv);

diff --git a/pp_sys.c b/pp_sys.c
index 9c6bc99..92624bf 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -248,6 +248,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
     if (setresuid(euid, ruid, (Uid_t)-1))
 #endif
 #endif
+       /* diag_listed_as: entering effective %s failed */
        Perl_croak(aTHX_ "entering effective uid failed");
 #endif
 
@@ -261,6 +262,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
     if (setresgid(egid, rgid, (Gid_t)-1))
 #endif
 #endif
+       /* diag_listed_as: entering effective %s failed */
        Perl_croak(aTHX_ "entering effective gid failed");
 #endif
 
@@ -273,6 +275,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
     if (setresuid(ruid, euid, (Uid_t)-1))
 #endif
 #endif
+       /* diag_listed_as: leaving effective %s failed */
        Perl_croak(aTHX_ "leaving effective uid failed");
 
 #ifdef HAS_SETREGID
@@ -282,6 +285,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
     if (setresgid(rgid, egid, (Gid_t)-1))
 #endif
 #endif
+       /* diag_listed_as: leaving effective %s failed */
        Perl_croak(aTHX_ "leaving effective gid failed");
 
     return res;
@@ -4461,17 +4465,20 @@ PP(pp_gmtime)
        NV input = Perl_floor(POPn);
        when = (Time64_T)input;
        if (when != input) {
+           /* diag_listed_as: gmtime(%f) too large */
            Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                           "%s(%.0" NVff ") too large", opname, input);
        }
     }
 
     if ( TIME_LOWER_BOUND > when ) {
+       /* diag_listed_as: gmtime(%f) too small */
        Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                       "%s(%.0" NVff ") too small", opname, when);
        err = NULL;
     }
     else if( when > TIME_UPPER_BOUND ) {
+       /* diag_listed_as: gmtime(%f) too small */
        Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                       "%s(%.0" NVff ") too large", opname, when);
        err = NULL;

diff --git a/regexec.c b/regexec.c
index ced20bd..44d7b96 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -4843,8 +4843,9 @@ NULL
                && !(PL_reg_flags & RF_warned))
            {
                PL_reg_flags |= RF_warned;
-               Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
-                    "Complex regular subexpression recursion",
+               Perl_warner(aTHX_ packWARN(WARN_REGEXP),
+                    "Complex regular subexpression recursion limit (%d) "
+                    "exceeded",
                     REG_INFTY - 1);
            }
 
@@ -4867,8 +4868,8 @@ NULL
                {
                    PL_reg_flags |= RF_warned;
                    Perl_warner(aTHX_ packWARN(WARN_REGEXP),
-                       "%s limit (%d) exceeded",
-                       "Complex regular subexpression recursion",
+                       "Complex regular subexpression recursion "
+                       "limit (%d) exceeded",
                        REG_INFTY - 1);
                }
                cur_curlyx->u.curlyx.count--;

diff --git a/sv.c b/sv.c
index 6cbba65..2d8039b 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -7955,6 +7955,7 @@ Perl_sv_inc_nomg(pTHX_ register SV *const sv)
        const NV was = SvNVX(sv);
        if (NV_OVERFLOWS_INTEGERS_AT &&
            was >= NV_OVERFLOWS_INTEGERS_AT) {
+           /* diag_listed_as: Lost precision when %s %f by 1 */
            Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION),
                           "Lost precision when incrementing %" NVff " by 1",
                           was);
@@ -8139,6 +8140,7 @@ Perl_sv_dec_nomg(pTHX_ register SV *const sv)
            const NV was = SvNVX(sv);
            if (NV_OVERFLOWS_INTEGERS_AT &&
                was <= -NV_OVERFLOWS_INTEGERS_AT) {
+               /* diag_listed_as: Lost precision when %s %f by 1 */
                Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION),
                               "Lost precision when decrementing %" NVff " by 1",
                               was);

diff --git a/t/porting/diag.t b/t/porting/diag.t
index c691dfa..9065659 100644 (file)
--- a/t/porting/diag.t
+++ b/t/porting/diag.t
@@ -381,13 +381,11 @@ Can't spawn "%s": %s
 Can't %s script `%s' with ARGV[0] being `%s'
 Can't %s "%s": %s
 Can't %s `%s' with ARGV[0] being `%s' (looking for executables only, not found)
-Can't take %s of %f
 Can't use '%c' after -mname
 Can't use string ("%s"%s) as a subroutine ref while "strict refs" in use
 Can't use when() outside a topicalizer
 \%c better written as $%c
 Character(s) in '%c' format wrapped in %s
-$%c is no longer supported
 Cloning substitution context is unimplemented
 Code missing after '/' in pack
 Code missing after '/' in unpack
@@ -398,15 +396,11 @@ Deep recursion on anonymous subroutine
 defined(\%hash) is deprecated
 Don't know how to handle magic of type \%o
 -Dp not implemented on this platform
-entering effective gid failed
-entering effective uid failed
 Error reading "%s": %s
-Exiting %s via %s
 Filehandle opened only for %sput
 Filehandle %s opened only for %sput
 Filehandle STD%s reopened as %s only for input
 YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET! FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!
-Format STDOUT redefined
 Free to wrong pool %p not %p
 get %s %p %p %p
 glob failed (can't start child: %s)
@@ -415,10 +409,6 @@ Goto undefined subroutine
 Goto undefined subroutine &%s
 Hash \%%s missing the \% in argument %d of %s()
 Illegal character %sin prototype for %s : %s
-Integer overflow in binary number
-Integer overflow in decimal number
-Integer overflow in hexadecimal number
-Integer overflow in octal number
 Integer overflow in version %d
 internal %<num>p might conflict with future printf extensions
 invalid control request: '\%o'
@@ -433,11 +423,7 @@ Invalid type '%c' in unpack
 Invalid type ',' in %s
 'j' not supported on this platform
 'J' not supported on this platform
-leaving effective gid failed
-leaving effective uid failed
 List form of piped open not implemented
-Lost precision when decrementing %f by 1
-Lost precision when incrementing %f by 1
 %lx
 Malformed UTF-8 character (fatal)
 Missing (suid) fd script name
@@ -449,7 +435,6 @@ No code specified for -%c
 No directory specified for -I
 No such class field "%s"
 Not an XSUB reference
-Not %s reference
 Operator or semicolon missing before %c%s
 Perl %s required (did you mean %s?)--this is only %s, stopped
 Perl %s required--this is only %s, stopped
@@ -461,20 +446,14 @@ Reversed %c= operator
 Runaway prototype
 %s(%.0
 %s(%f) failed
-%s(%f) too large
-%s(%f) too small
-Scalar value %s better written as $%s
 %sCompilation failed in regexp
 %sCompilation failed in require
 set %s %p %p %p
 %s free() ignored (RMAGIC, PERL_CORE)
 %s has too many errors.
 SIG%s handler "%s" not defined.
-%s: illegal mapping '%s'
 %s in %s
 Size magic not implemented
-%s limit (%d) exceeded
-%s method "%s" overloading "%s" in package "%s"
 %s number > %s non-portable
 %s object version %s does not match %s %s
 %srealloc() %signored
@@ -491,20 +470,13 @@ The rewinddir() function is not implemented on NetWare
 The seekdir() function is not implemented on NetWare
 The telldir() function is not implemented on NetWare
 Too deeply nested ()-groups in %s
-Too late to run CHECK block
-Too late to run INIT block
 Too many args on %s line of "%s"
 U0 mode on a byte string
 Unbalanced string table refcount: (%d) for "%s"
 Undefined top format called
 Unexpected constant lvalue entersub entry via type/targ %d:%d
 Unicode non-character 0x%X
-Unknown PerlIO layer "scalar"
 Unstable directory path, current directory changed unexpectedly
-Unsupported script encoding UTF-16BE
-Unsupported script encoding UTF-16LE
-Unsupported script encoding UTF-32BE
-Unsupported script encoding UTF-32LE
 Unterminated compressed integer in unpack
 Usage: CODE(0x%x)(%s)
 Usage: %s(%s)

diff --git a/toke.c b/toke.c
index db743e9..8fb6164 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -6239,6 +6239,7 @@ Perl_yylex(pTHX)
                    if (*t == '}' || *t == ']') {
                        t++;
                        PL_bufptr = PEEKSPACE(PL_bufptr); /* XXX can realloc */
+       /* diag_listed_as: Scalar value @%s[%s] better written as $%s[%s] */
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                            "Scalar value %.*s better written as $%.*s",
                            (int)(t-PL_bufptr), PL_bufptr,
@@ -10823,6 +10824,7 @@ S_swallow_bom(pTHX_ U8 *s)
        if (s[1] == 0xFE) {
            /* UTF-16 little-endian? (or UTF-32LE?) */
            if (s[2] == 0 && s[3] == 0)  /* UTF-32 little-endian */
+               /* diag_listed_as: Unsupported script encoding %s */
                Perl_croak(aTHX_ "Unsupported script encoding UTF-32LE");
 #ifndef PERL_NO_UTF16_FILTER
            if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (BOM)\n");
@@ -10831,6 +10833,7 @@ S_swallow_bom(pTHX_ U8 *s)
                s = add_utf16_textfilter(s, TRUE);
            }
 #else
+           /* diag_listed_as: Unsupported script encoding %s */
            Perl_croak(aTHX_ "Unsupported script encoding UTF-16LE");
 #endif
        }
@@ -10844,6 +10847,7 @@ S_swallow_bom(pTHX_ U8 *s)
                s = add_utf16_textfilter(s, FALSE);
            }
 #else
+           /* diag_listed_as: Unsupported script encoding %s */
            Perl_croak(aTHX_ "Unsupported script encoding UTF-16BE");
 #endif
        }
@@ -10859,6 +10863,7 @@ S_swallow_bom(pTHX_ U8 *s)
             if (s[1] == 0) {
                  if (s[2] == 0xFE && s[3] == 0xFF) {
                       /* UTF-32 big-endian */
+                      /* diag_listed_as: Unsupported script encoding %s */
                       Perl_croak(aTHX_ "Unsupported script encoding UTF-32BE");
                  }
             }
@@ -10870,6 +10875,7 @@ S_swallow_bom(pTHX_ U8 *s)
                  if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding (no BOM)\n");
                  s = add_utf16_textfilter(s, FALSE);
 #else
+                 /* diag_listed_as: Unsupported script encoding %s */
                  Perl_croak(aTHX_ "Unsupported script encoding UTF-16BE");
 #endif
             }
@@ -10892,6 +10898,7 @@ S_swallow_bom(pTHX_ U8 *s)
              if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (no BOM)\n");
              s = add_utf16_textfilter(s, TRUE);
 #else
+             /* diag_listed_as: Unsupported script encoding %s */
              Perl_croak(aTHX_ "Unsupported script encoding UTF-16LE");
 #endif
         }
@@ -11108,6 +11115,7 @@ Perl_scan_vstring(pTHX_ const char *s, const char *const e, SV *sv)
                    rev += (*end - '0') * mult;
                    mult *= 10;
                    if (orev > rev)
+                       /* diag_listed_as: Integer overflow in %s number */
                        Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
                                         "Integer overflow in decimal number");
                }

diff --git a/utf8.c b/utf8.c
index e985386..23308a3 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -2776,6 +2776,7 @@ S_swash_scan_list_line(pTHX_ U8* l, U8* const lend, UV* min, UV* max, UV* val,
            else {
                *val = 0;
                if (typeto) {
+                   /* diag_listed_as: To%s: illegal mapping '%s' */
                    Perl_croak(aTHX_ "%s: illegal mapping '%s'",
                                     typestr, l);
                }
@@ -2790,6 +2791,7 @@ S_swash_scan_list_line(pTHX_ U8* l, U8* const lend, UV* min, UV* max, UV* val,
        if (wants_value) {
            *val = 0;
            if (typeto) {
+               /* diag_listed_as: To%s: illegal mapping '%s' */
                Perl_croak(aTHX_ "%s: illegal mapping '%s'", typestr, l);
            }
        }