From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Wed, 10 Sep 2003 08:15:54 +0000 (+0000)
Subject: Linenumbers for utf8 warnings were wrong, test also rcatline.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2d79bf7f1e821d4cc07e4959f825479a7c0ab102;p=p5sagit%2Fp5-mst-13.2.git

Linenumbers for utf8 warnings were wrong, test also rcatline.

p4raw-id: //depot/perl@21157
---

diff --git a/pp_hot.c b/pp_hot.c
index 0c4c692..0ad2fcf 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1569,18 +1569,6 @@ Perl_do_readline(pTHX)
 	    MAYBE_TAINT_LINE(io, sv);
 	    RETURN;
 	}
-	if (SvUTF8(sv)) {
-	     U8 *s = (U8*)SvPVX(sv) + offset;
-	     STRLEN len = SvCUR(sv) - offset;
-	     U8 *f;
-
-	     if (ckWARN(WARN_UTF8) &&
-		 !Perl_is_utf8_string_loc(aTHX_ s, len, &f))
-		  /* Emulate :encoding(utf8) warning in the same case. */
-		  Perl_warner(aTHX_ packWARN(WARN_UTF8),
-			      "utf8 \"\\x%02X\" does not map to Unicode",
-			      f < (U8*)SvEND(sv) ? *f : 0);
-	}
 	MAYBE_TAINT_LINE(io, sv);
 	IoLINES(io)++;
 	IoFLAGS(io) |= IOf_NOLINE;
@@ -1605,6 +1593,17 @@ Perl_do_readline(pTHX)
 		(void)POPs;		/* Unmatched wildcard?  Chuck it... */
 		continue;
 	    }
+	} else if (SvUTF8(sv)) { /* OP_READLINE, OP_RCATLINE */
+	     U8 *s = (U8*)SvPVX(sv) + offset;
+	     STRLEN len = SvCUR(sv) - offset;
+	     U8 *f;
+	     
+	     if (ckWARN(WARN_UTF8) &&
+		 !Perl_is_utf8_string_loc(aTHX_ s, len, &f))
+		  /* Emulate :encoding(utf8) warning in the same case. */
+		  Perl_warner(aTHX_ packWARN(WARN_UTF8),
+			      "utf8 \"\\x%02X\" does not map to Unicode",
+			      f < (U8*)SvEND(sv) ? *f : 0);
 	}
 	if (gimme == G_ARRAY) {
 	    if (SvLEN(sv) - SvCUR(sv) > 20) {
diff --git a/t/io/utf8.t b/t/io/utf8.t
index 6806736..7b2d672 100755
--- a/t/io/utf8.t
+++ b/t/io/utf8.t
@@ -13,7 +13,7 @@ no utf8; # needed for use utf8 not griping about the raw octets
 
 require "./test.pl";
 
-plan(tests => 52);
+plan(tests => 53);
 
 $| = 1;
 
@@ -317,14 +317,22 @@ ok( 1 );
     # <FH> on a :utf8 stream should complain immediately with -w
     # if it finds bad UTF-8 (:encoding(utf8) works this way)
     use warnings 'utf8';
+    undef $@;
     local $SIG{__WARN__} = sub { $@ = shift };
     open F, ">a";
     binmode F;
     print F "foo", chr(0xE4), "\n";
+    print F "foo", chr(0xF6), "\n";
     close F;
     open F, "<:utf8", "a";
+    undef $@;
     my $line = <F>;
-    like( $@, qr/utf8 "\\xE4" does not map to Unicode/ );
+    like( $@, qr/utf8 "\\xE4" does not map to Unicode .+ <F> line 1/,
+	  "<:utf8 readline must warn about bad utf8");
+    undef $@;
+    $line .= <F>;
+    like( $@, qr/utf8 "\\xF6" does not map to Unicode .+ <F> line 2/,
+	  "<:utf8 rcatline must warn about bad utf8");
     close F;
 }