add -DPERL_Y2KWARN build option that will generate additional

warnings on "19$yy" etc (reworked a patch suggested by
Ulrich Pfeifer <upf@de.uu.net>)

p4raw-id: //depot/perl@4132

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 94b4635..a16f572 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 bac2c42..7af8fb1 100644 (file)
--- 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