From: Gurusamy Sarathy <gsar@cpan.org>
Date: Mon, 13 Sep 1999 03:03:57 +0000 (+0000)
Subject: add -DPERL_Y2KWARN build option that will generate additional
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6bc102ca57c5133ccb41282f9b318b89d8ec7a82;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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] <<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
--- 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