syswrite couldn't correctly handle surprises from UTF-8 overloading.

As part of fixing this, syswrite now tries to take advantage of the
UTF-8 cache logic for lengths and offsets on regular scalars.

p4raw-id: //depot/perl@28019

2 files changed, 40 insertions, 12 deletions

diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit
index 07fffa87eb..575161d2a1 100644
--- a/t/lib/warnings/9uninit
+++ b/t/lib/warnings/9uninit
@@ -1162,7 +1162,7 @@ our ($g1);
 
 eval { my $x; seek    $x,$m1, $g1 };
 eval { my $x; sysseek $x,$m1, $g1 };
-eval { syswrite $m1, $g1 };
+eval { syswrite $m1, $g1 }; # logic changed - now won't try $g1 if $m1 is bad
 # eval { syswrite STDERR, $m1 };        # XXX under utf8, can give
 # eval { syswrite STDERR, $m1, $g1 };   # XXX different warnings
 # eval { syswrite STDERR, $m1, $g1, $m2 };
@@ -1176,7 +1176,6 @@ Use of uninitialized value $x in ref-to-glob cast at - line 6.
 Use of uninitialized value $g1 in sysseek at - line 6.
 Use of uninitialized value $m1 in sysseek at - line 6.
 Use of uninitialized value $m1 in ref-to-glob cast at - line 7.
-Use of uninitialized value $g1 in syswrite at - line 7.
 Use of uninitialized value $m2 in socket at - line 11.
 Use of uninitialized value $g1 in socket at - line 11.
 Use of uninitialized value $m1 in socket at - line 11.
diff --git a/t/uni/overload.t b/t/uni/overload.t
index 478544c89a..5812425ca5 100644
--- a/t/uni/overload.t
+++ b/t/uni/overload.t
@@ -7,7 +7,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 68;
+use Test::More tests => 116;
 
 package UTF8Toggle;
 use strict;
@@ -151,17 +151,46 @@ SKIP: {
 
 my $tmpfile = 'overload.tmp';
 
-foreach my $operator (qw (print)) {
+foreach my $operator ('print', 'syswrite', 'syswrite len', 'syswrite off',
+		      'syswrite len off') {
     foreach my $layer ('', ':utf8') {
 	open my $fh, "+>$layer", $tmpfile or die $!;
-	my $u = UTF8Toggle->new("\311\n");
-	print $fh $u;
-	print $fh $u;
-	print $fh $u;
-	my $l = UTF8Toggle->new("\351\n", 1);
-	print $fh $l;
-	print $fh $l;
-	print $fh $l;
+	my $pad = $operator =~ /\boff\b/ ? "\243" : "";
+	my $trail = $operator =~ /\blen\b/ ? "!" : "";
+	my $u = UTF8Toggle->new("$pad\311\n$trail");
+	my $l = UTF8Toggle->new("$pad\351\n$trail", 1);
+	if ($operator eq 'print') {
+	    print $fh $u;
+	    print $fh $u;
+	    print $fh $u;
+	    print $fh $l;
+	    print $fh $l;
+	    print $fh $l;
+	} elsif ($operator eq 'syswrite') {
+	    syswrite $fh, $u;
+	    syswrite $fh, $u;
+	    syswrite $fh, $u;
+	    syswrite $fh, $l;
+	    syswrite $fh, $l;
+	    syswrite $fh, $l;
+	} elsif ($operator eq 'syswrite len') {
+	    syswrite $fh, $u, 2;
+	    syswrite $fh, $u, 2;
+	    syswrite $fh, $u, 2;
+	    syswrite $fh, $l, 2;
+	    syswrite $fh, $l, 2;
+	    syswrite $fh, $l, 2;
+	} elsif ($operator eq 'syswrite off'
+		 || $operator eq 'syswrite len off') {
+	    syswrite $fh, $u, 2, 1;
+	    syswrite $fh, $u, 2, 1;
+	    syswrite $fh, $u, 2, 1;
+	    syswrite $fh, $l, 2, 1;
+	    syswrite $fh, $l, 2, 1;
+	    syswrite $fh, $l, 2, 1;
+	} else {
+	    die $operator;
+	}
 
 	seek $fh, 0, 0 or die $!;
 	my $line;