[ 22465]
Fix Dave's original shared hash key corruption bug
[ 22471]
Make a temporary copy of the input buffer in pp_send, so that send
and syswrite don't gratuitously upgrade their input to UTF8
[ 22483]
croaking for readonly SVs in Perl_sv_utf8_upgrade_flags was a mistake
back this out until we have a tangible policy
p4raw-link: @22483 on //depot/perl:
ebc91362714bda54cacd3ec2407cd23a2dc04902
p4raw-link: @22471 on //depot/perl:
6aa2f6a7a4e2a0d061a689b227dcf063d93806a6
p4raw-link: @22465 on //depot/perl:
4c94c214622791382d764e5aa3e12c672818b5fb
p4raw-id: //depot/maint-5.8/perl@22487
p4raw-integrated: from //depot/perl@22486 'copy in' t/op/sysio.t
(@13902..) 'merge in' pp_sys.c (@22294..)
p4raw-integrated: from //depot/perl@22465 'edit in' sv.c (@22463..)
}
if (PerlIO_isutf8(IoIFP(io))) {
- buffer = SvPVutf8(bufsv, blen);
+ if (!SvUTF8(bufsv)) {
+ bufsv = sv_2mortal(newSVsv(bufsv));
+ buffer = sv_2pvutf8(bufsv, &blen);
+ } else
+ buffer = SvPV(bufsv, blen);
}
else {
if (DO_UTF8(bufsv)) {
sv_force_normal(sv);
}
- if (SvREADONLY(sv)) {
- Perl_croak(aTHX_ PL_no_modify);
- }
-
if (PL_encoding && !(flags & SV_UTF8_NO_ENCODING))
sv_recode_to_utf8(sv, PL_encoding);
else { /* Assume Latin-1/EBCDIC */
Perl_sv_utf8_encode(pTHX_ register SV *sv)
{
(void) sv_utf8_upgrade(sv);
+ if (SvIsCOW(sv)) {
+ sv_force_normal_flags(sv, 0);
+ }
+ if (SvREADONLY(sv)) {
+ Perl_croak(aTHX_ PL_no_modify);
+ }
SvUTF8_off(sv);
}
#!./perl
-print "1..39\n";
+print "1..42\n";
chdir('op') || chdir('t/op') || die "sysio.t: cannot look for myself: $!";
+@INC = '../../lib';
open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!";
unlink $outfile;
+# Check that utf8 IO doesn't upgrade the scalar
+open(I, ">$outfile") || die "sysio.t: cannot write $outfile: $!";
+# Will skip harmlessly on stdioperl
+eval {binmode STDOUT, ":utf8"};
+die $@ if $@ and $@ !~ /^IO layers \(like ':utf8'\) unavailable/;
+
+# y diaresis is \w when UTF8
+$a = chr 255;
+
+print $a =~ /\w/ ? "not ok 40\n" : "ok 40\n";
+
+syswrite I, $a;
+
+# Should not be upgraded as a side effect of syswrite.
+print $a =~ /\w/ ? "not ok 41\n" : "ok 41\n";
+
+# This should work
+eval {syswrite I, 2;};
+print $@ eq "" ? "ok 42\n" : "not ok 42 # $@";
+
+close(I);
+unlink $outfile;
+
chdir('..');
1;