warn() misunderstands UTF8-encoded scalar #9033
Comments
From zefram@fysh.orgCreated by zefram@fysh.org$ perl -we '$a="\xee\n"; print STDERR $a; warn $a; utf8::upgrade($a); print STDERR $a; warn $a' I won't attempt to reproduce the output directly here, because it 0000000 ee 0a ee 0a ee 0a c3 ae 0a So: print() always outputs the character/byte values that are *logically* Emitting the byte values 0xc3 0xae 0x0a for $a is, of course, appropriate Perl Info |
From @cpansproutThe first patch changes warn.t to use test.pl, so I can use fresh_perl_like. The second patch fixes warn to work with utf8 scalars and :utf8 handles. Since do_print already takes care of utf8, I’ve changed write_to_stderr to call it. |
From @cpansproutInline Patchdiff -Nurp blead/t/op/warn.t blead-45549-warn/t/op/warn.t
--- blead/t/op/warn.t 2010-05-04 06:38:11.000000000 -0700
+++ blead-45549-warn/t/op/warn.t 2010-08-08 13:31:33.000000000 -0700
@@ -1,12 +1,14 @@
#!./perl
#line 3 warn.t
-print "1..18\n";
-my $test_num = 0;
-sub ok {
- print $_[0] ? "" : "not ", "ok ", ++$test_num, "\n";
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
}
+plan 18;
+
my @warnings;
my $wa = []; my $ea = [];
$SIG{__WARN__} = sub { push @warnings, $_[0] };
@@ -24,7 +26,7 @@ ok @warnings==1 && $warnings[0] eq "foob
@warnings = ();
$@ = "";
warn "foo";
-ok @warnings==1 && $warnings[0] eq "foo at warn.t line 26.\n";
+ok @warnings==1 && $warnings[0] eq "foo at warn.t line 28.\n";
@warnings = ();
$@ = "";
@@ -35,13 +37,13 @@ ok @warnings==1 && ref($warnings[0]) eq
$@ = "";
warn "";
ok @warnings==1 &&
- $warnings[0] eq "Warning: something's wrong at warn.t line 36.\n";
+ $warnings[0] eq "Warning: something's wrong at warn.t line 38.\n";
@warnings = ();
$@ = "";
warn;
ok @warnings==1 &&
- $warnings[0] eq "Warning: something's wrong at warn.t line 42.\n";
+ $warnings[0] eq "Warning: something's wrong at warn.t line 44.\n";
@warnings = ();
$@ = "ERR\n";
@@ -56,7 +58,7 @@ ok @warnings==1 && $warnings[0] eq "foob
@warnings = ();
$@ = "ERR\n";
warn "foo";
-ok @warnings==1 && $warnings[0] eq "foo at warn.t line 58.\n";
+ok @warnings==1 && $warnings[0] eq "foo at warn.t line 60.\n";
@warnings = ();
$@ = "ERR\n";
@@ -67,13 +69,13 @@ ok @warnings==1 && ref($warnings[0]) eq
$@ = "ERR\n";
warn "";
ok @warnings==1 &&
- $warnings[0] eq "ERR\n\t...caught at warn.t line 68.\n";
+ $warnings[0] eq "ERR\n\t...caught at warn.t line 70.\n";
@warnings = ();
$@ = "ERR\n";
warn;
ok @warnings==1 &&
- $warnings[0] eq "ERR\n\t...caught at warn.t line 74.\n";
+ $warnings[0] eq "ERR\n\t...caught at warn.t line 76.\n";
@warnings = ();
$@ = $ea;
@@ -88,7 +90,7 @@ ok @warnings==1 && $warnings[0] eq "foob
@warnings = ();
$@ = $ea;
warn "foo";
-ok @warnings==1 && $warnings[0] eq "foo at warn.t line 90.\n";
+ok @warnings==1 && $warnings[0] eq "foo at warn.t line 92.\n";
@warnings = ();
$@ = $ea; |
From @cpansproutInline Patchdiff -Nup blead-45549-warn/util.c blead-45549-warn2/util.c
--- blead-45549-warn/util.c 2010-07-27 00:51:15.000000000 -0700
+++ blead-45549-warn2/util.c 2010-08-08 14:14:33.000000000 -0700
@@ -1399,10 +1399,8 @@ Perl_write_to_stderr(pTHX_ SV* msv)
dSAVED_ERRNO;
#endif
PerlIO * const serr = Perl_error_log;
- STRLEN msglen;
- const char* message = SvPVx_const(msv, msglen);
- PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen);
+ do_print(msv, serr);
(void)PerlIO_flush(serr);
#ifdef USE_SFIO
RESTORE_ERRNO;
diff -Nurp blead-45549-warn/t/op/warn.t blead-45549-warn2/t/op/warn.t
--- blead-45549-warn/t/op/warn.t 2010-08-08 13:31:33.000000000 -0700
+++ blead-45549-warn2/t/op/warn.t 2010-08-08 14:26:47.000000000 -0700
@@ -7,7 +7,7 @@ BEGIN {
require './test.pl';
}
-plan 18;
+plan 20;
my @warnings;
my $wa = []; my $ea = [];
@@ -107,4 +107,28 @@ $@ = $ea;
warn;
ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $ea;
+fresh_perl_like(
+ '
+ $a = "\xee\n";
+ print STDERR $a; warn $a;
+ utf8::upgrade($a);
+ print STDERR $a; warn $a;
+ ',
+ qr/^\xee(?:\r?\n\xee){3}/,
+ {},
+ 'warn emits logical characters, not internal bytes [perl #45549]'
+);
+
+fresh_perl_like(
+ '
+ $a = "\xee\n";
+ print STDERR $a; warn $a;
+ utf8::upgrade($a);
+ print STDERR $a; warn $a;
+ ',
+ qr/^\xc3\xae(?:\r?\n\xc3\xae){3}/,
+ { switches => ['-CE'] },
+ 'warn respects :utf8 layer'
+);
+
1; |
|
The RT System itself - Status changed from 'new' to 'open' |
From @cpansproutOn Aug 8, 2010, at 2:31 PM, Father Chrysostomos wrote:
That makes ‘warn chr 300’ produce a ‘Wide character in print’ warning on a byte-sized handle, which is a good thing, except that it should say ‘warn’. Patch attached. |
From @cpansproutInline Patchdiff -Nup blead-45549-warn2/doio.c blead-45549-warn3/doio.c
--- blead-45549-warn2/doio.c 2010-07-03 08:47:11.000000000 -0700
+++ blead-45549-warn3/doio.c 2010-08-08 18:25:47.000000000 -0700
@@ -1241,7 +1241,7 @@ Perl_do_print(pTHX_ register SV *sv, Per
else {
assert((char *)result == tmps);
Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8),
- "Wide character in print");
+ "Wide character in %s", OP_DESC(PL_op));
}
}
/* To detect whether the process is about to overstep its
diff -Nurp blead-45549-warn2/t/op/warn.t blead-45549-warn3/t/op/warn.t
--- blead-45549-warn2/t/op/warn.t 2010-08-08 14:26:47.000000000 -0700
+++ blead-45549-warn3/t/op/warn.t 2010-08-08 18:24:35.000000000 -0700
@@ -7,7 +7,7 @@ BEGIN {
require './test.pl';
}
-plan 20;
+plan 21;
my @warnings;
my $wa = []; my $ea = [];
@@ -131,4 +131,11 @@ fresh_perl_like(
'warn respects :utf8 layer'
);
+fresh_perl_like(
+ 'warn chr 300',
+ qr/^Wide character in warn .*\n\xc4\xac at /,
+ {},
+ 'Wide character in warn (not print)'
+);
+
1; |
From @rgarciaOn 9 August 2010 03:30, Father Chrysostomos <sprout@cpan.org> wrote:
Thanks, all 3 patches applied to bleadperl. |
|
@rgs - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#45549 (status was 'resolved')
Searchable as RT45549$
The text was updated successfully, but these errors were encountered: