diff options
| -rw-r--r-- | pod/perldelta.pod | 5 | ||||
| -rw-r--r-- | pod/perldiag.pod | 5 | ||||
| -rw-r--r-- | pod/perllexwarn.pod | 4 | ||||
| -rw-r--r-- | pp_hot.c | 15 | ||||
| -rw-r--r-- | sv.c | 13 | ||||
| -rw-r--r-- | t/pragma/warn/pp_hot | 29 | ||||
| -rw-r--r-- | t/pragma/warn/sv | 36 |
7 files changed, 103 insertions, 4 deletions
diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 94b4635e7b..a16f572979 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 1c07a31fa6..91de1f47fd 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 8dbae0ddbc..32fc21084e 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 @@ -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; @@ -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 6bd315148f..9a4b0a0708 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] <<TODO Deep recursion on subroutine \"%s\" [Perl_sub_crush_depth] - sub fred { fred() if $a++ < 200} fred() + sub fred { fred() if $a++ < 200} fred() Deep recursion on anonymous subroutine [Perl_sub_crush_depth] - $a = sub { &$a if $a++ < 200} &$a + $a = sub { &$a if $a++ < 200} &$a + Possible Y2K bug: about to append an integer to '19' [pp_concat] + $x = "19$yy\n"; __END__ # pp_hot.c [pp_print] @@ -189,4 +191,25 @@ $b = sub &$b ; EXPECT - +######## +# pp_hot.c [pp_concat] +use warnings 'misc'; +use Config; +BEGIN { + unless ($Config{ccflags} =~ /Y2KWARN/) { + print "SKIPPED\n# perl not built with -DPERL_Y2KWARN"; + exit 0; + } +} +my $x; +my $yy = 78; +$x = "19$yy\n"; +$x = "19" . $yy . "\n"; +$x = "319$yy\n"; +$x = "319" . $yy . "\n"; +no warnings 'misc'; +$x = "19$yy\n"; +$x = "19" . $yy . "\n"; +EXPECT +Possible Y2K bug: about to append an integer to '19' at - line 12. +Possible Y2K bug: about to append an integer to '19' at - line 13. diff --git a/t/pragma/warn/sv b/t/pragma/warn/sv index bac2c42545..7af8fb1705 100644 --- a/t/pragma/warn/sv +++ b/t/pragma/warn/sv @@ -32,6 +32,8 @@ Undefined value assigned to typeglob + Possible Y2K bug: %d format string following '19' + Reference is already weak [Perl_sv_rvweaken] <<TODO Mandatory Warnings @@ -280,3 +282,37 @@ EXPECT \xff will produce malformed UTF-8 character; use \x{ff} for that at - line 6. Malformed UTF-8 character at - line 6. Malformed UTF-8 character at - line 10. +######## +# sv.c +use warnings 'misc'; +use Config; +BEGIN { + unless ($Config{ccflags} =~ /Y2KWARN/) { + print "SKIPPED\n# perl not built with -DPERL_Y2KWARN"; + exit 0; + } + $|=1; +} +my $x; +my $yy = 78; +$x = printf "19%02d\n", $yy; +$x = sprintf "#19%02d\n", $yy; +$x = printf " 19%02d\n", 78; +$x = sprintf "19%02d\n", 78; +$x = printf "319%02d\n", $yy; +$x = sprintf "319%02d\n", $yy; +no warnings 'misc'; +$x = printf "19%02d\n", $yy; +$x = sprintf "19%02d\n", $yy; +$x = printf "19%02d\n", 78; +$x = sprintf "19%02d\n", 78; +EXPECT +Possible Y2K bug: %d format string following '19' at - line 16. +Possible Y2K bug: %d format string following '19' at - line 13. +1978 +Possible Y2K bug: %d format string following '19' at - line 14. +Possible Y2K bug: %d format string following '19' at - line 15. + 1978 +31978 +1978 +1978 |