diff options
| -rw-r--r-- | gv.c | 2 | ||||
| -rw-r--r-- | numeric.c | 3 | ||||
| -rw-r--r-- | op.c | 3 | ||||
| -rw-r--r-- | perlio.c | 1 | ||||
| -rw-r--r-- | pp.c | 1 | ||||
| -rw-r--r-- | pp_ctl.c | 2 | ||||
| -rw-r--r-- | pp_hot.c | 1 | ||||
| -rw-r--r-- | pp_sys.c | 7 | ||||
| -rw-r--r-- | regexec.c | 9 | ||||
| -rw-r--r-- | sv.c | 2 | ||||
| -rw-r--r-- | t/porting/diag.t | 28 | ||||
| -rw-r--r-- | toke.c | 8 | ||||
| -rw-r--r-- | utf8.c | 2 |
13 files changed, 37 insertions, 32 deletions
@@ -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"\"", @@ -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; @@ -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"); } @@ -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; } @@ -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); } } @@ -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) @@ -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); @@ -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; @@ -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--; @@ -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 c691dfa0dc..9065659ec0 100644 --- 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) @@ -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"); } @@ -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); } } |