From 6bc102ca57c5133ccb41282f9b318b89d8ec7a82 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Mon, 13 Sep 1999 03:03:57 +0000 Subject: [PATCH] add -DPERL_Y2KWARN build option that will generate additional warnings on "19$yy" etc (reworked a patch suggested by Ulrich Pfeifer ) p4raw-id: //depot/perl@4132 --- pod/perldelta.pod | 5 +++++ pod/perldiag.pod | 5 +++++ pod/perllexwarn.pod | 4 ++++ pp_hot.c | 15 ++++++++++++++- sv.c | 13 +++++++++++++ t/pragma/warn/pp_hot | 29 ++++++++++++++++++++++++++--- t/pragma/warn/sv | 36 ++++++++++++++++++++++++++++++++++++ 7 files changed, 103 insertions(+), 4 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 94b4635..a16f572 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -704,6 +704,11 @@ elements of a subroutine attribute list. If the previous attribute had a parenthesised parameter list, perhaps that list was terminated too soon. +=item Possible Y2K bug: %s + +(W) You are concatenating the number 19 with another number, which +could be a potential Year 2000 problem. + =item Unterminated attribute parameter in subroutine attribute list (F) The lexer saw an opening (left) parenthesis character while parsing a diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 1c07a31..91de1f4 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2348,6 +2348,11 @@ perspective, it's probably not what you intended. (F) Your C compiler uses POSIX getpgrp(), which takes no argument, unlike the BSD version, which takes a pid. +=item Possible Y2K bug: %s + +(W) You are concatenating the number 19 with another number, which +could be a potential Year 2000 problem. + =item Possible attempt to put comments in qw() list (W) qw() lists contain items separated by whitespace; as with literal diff --git a/pod/perllexwarn.pod b/pod/perllexwarn.pod index 8dbae0d..32fc210 100644 --- a/pod/perllexwarn.pod +++ b/pod/perllexwarn.pod @@ -313,6 +313,10 @@ produce a fatal error. The experimental features need bottomed out. + perldiag.pod + Need to add warning class information and notes on + how to use the class info with the warnings pragma. + perl5db.pl The debugger saves and restores C<$^W> at runtime. I haven't checked whether the debugger will still work with the lexical warnings diff --git a/pp_hot.c b/pp_hot.c index de0434e..dbea9bd 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -164,8 +164,21 @@ PP(pp_concat) s = SvPV_force(TARG, len); } s = SvPV(right,len); - if (SvOK(TARG)) + if (SvOK(TARG)) { +#if defined(PERL_Y2KWARN) + if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_MISC)) { + STRLEN n; + char *s = SvPV(TARG,n); + if (n >= 2 && s[n-2] == '1' && s[n-1] == '9' + && (n == 2 || !isDIGIT(s[n-3]))) + { + Perl_warner(aTHX_ WARN_MISC, "Possible Y2K bug: %s", + "about to append an integer to '19'"); + } + } +#endif sv_catpvn(TARG,s,len); + } else sv_setpvn(TARG,s,len); /* suppress warning */ SETTARG; diff --git a/sv.c b/sv.c index acded31..b21c9ed 100644 --- a/sv.c +++ b/sv.c @@ -5037,6 +5037,19 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV *--eptr = '0'; break; default: /* it had better be ten or less */ +#if defined(PERL_Y2KWARN) + if (ckWARN(WARN_MISC)) { + STRLEN n; + char *s = SvPV(sv,n); + if (n >= 2 && s[n-2] == '1' && s[n-1] == '9' + && (n == 2 || !isDIGIT(s[n-3]))) + { + Perl_warner(aTHX_ WARN_MISC, + "Possible Y2K bug: %%%c %s", + c, "format string following '19'"); + } + } +#endif do { dig = uv % base; *--eptr = '0' + dig; diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot index 6bd3151..9a4b0a0 100644 --- a/t/pragma/warn/pp_hot +++ b/t/pragma/warn/pp_hot @@ -36,11 +36,13 @@ glob failed (child exited with status %d%s) [Perl_do_readline] <