syswrite() was still returning byte counts, not character counts.
authorJarkko Hietaniemi <jhi@iki.fi>
Sun, 18 Nov 2001 16:34:29 +0000 (16:34 +0000)
committerJarkko Hietaniemi <jhi@iki.fi>
Sun, 18 Nov 2001 16:34:29 +0000 (16:34 +0000)
p4raw-id: //depot/perl@13074

pp_sys.c
t/io/utf8.t

index e7a9de18804cb03b27c36abb1bd51159521ff6cb..a333b1053a5047090b7676da2d5db1f9e594e6df 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1842,6 +1842,9 @@ PP(pp_send)
            /* See the note at doio.c:do_print about filesize limits. --jhi */
            retval = PerlLIO_write(PerlIO_fileno(IoIFP(io)),
                                   buffer, length);
+           if (DO_UTF8(bufsv))
+               retval = utf8_length((U8*)SvPVX(bufsv),
+                                    (U8*)SvPVX(bufsv) + retval);
        }
     }
 #ifdef HAS_SOCKET
index 96ea58ea9a59fa540c9150d06d766423158142f5..fcbe847efa38a4c21ad33252f10bca2c43d28c7c 100755 (executable)
@@ -12,7 +12,7 @@ BEGIN {
 no utf8; # needed for use utf8 not griping about the raw octets
 
 $| = 1;
-print "1..27\n";
+print "1..29\n";
 
 open(F,"+>:utf8",'a');
 print F chr(0x100).'£';
@@ -192,17 +192,22 @@ unshift @a, chr(0); # ... and a null byte in front just for fun
 print F @a;
 close F;
 
+my $c;
+
+# read() should work on characters, not bytes
 open F, "<:utf8", "a";
 $a = 0;
 for (@a) {
-    unless (read(F, $b, 1) == 1  &&
-            length($b)     == 1  &&
-            ord($b)        == ord($_) &&
-            tell(F)        == ($a += bytes::length($b))) {
+    unless (($c = read(F, $b, 1) == 1)  &&
+            length($b)           == 1  &&
+            ord($b)              == ord($_) &&
+            tell(F)              == ($a += bytes::length($b))) {
         print '# ord($_)    == ', ord($_), "\n";
         print '# ord($b)    == ', ord($b), "\n";
         print '# length($b) == ', length($b), "\n";
         print '# tell(F)    == ', tell(F), "\n";
+        print '# $a         == ', $a, "\n";
+        print '# $c         == ', $c, "\n";
         print "not ";
         last;
     }
@@ -210,17 +215,20 @@ for (@a) {
 close F;
 print "ok 26\n";
 
+# sysread() should work on characters, not bytes
 open F, "<:utf8", "a";
 $a = 0;
 for (@a) {
-    unless (sysread(F, $b, 1) == 1  &&
-            length($b)        == 1  &&
-            ord($b)           == ord($_) &&
-            tell(F)           == ($a += bytes::length($b))) {
+    unless (($c = sysread(F, $b, 1)) == 1  &&
+            length($b)               == 1  &&
+            ord($b)                  == ord($_) &&
+            tell(F)                  == ($a += bytes::length($b))) {
         print '# ord($_)    == ', ord($_), "\n";
         print '# ord($b)    == ', ord($b), "\n";
         print '# length($b) == ', length($b), "\n";
         print '# tell(F)    == ', tell(F), "\n";
+        print '# $a         == ', $a, "\n";
+        print '# $c         == ', $c, "\n";
         print "not ";
         last;
     }
@@ -228,4 +236,45 @@ for (@a) {
 close F;
 print "ok 27\n";
 
-END { 1 while unlink "a" }
+# syswrite() on should work on characters, not bytes
+open G, ">:utf8", "b";
+$a = 0;
+for (@a) {
+    unless (($c = syswrite(G, $_, 1)) == 1 &&
+            tell(G)                   == ($a += bytes::length($_))) {
+        print '# ord($_)    == ', ord($_), "\n";
+        print '# tell(G)    == ', tell(G), "\n";
+        print '# $a         == ', $a, "\n";
+        print '# $c         == ', $c, "\n";
+        print "not ";
+        last;
+    }
+}
+close G;
+print "ok 28\n";
+
+# did syswrite() get it right?
+open G, "<:utf8", "b";
+$a = 0;
+for (@a) {
+    unless (($c = sysread(G, $b, 1)) == 1 &&
+           length($b)               == 1 &&
+           ord($b)                  == ord($_) &&
+            tell(G)                  == ($a += bytes::length($_))) {
+        print '# ord($_)    == ', ord($_), "\n";
+        print '# ord($b)    == ', ord($b), "\n";
+        print '# length($b) == ', length($b), "\n";
+        print '# tell(G)    == ', tell(G), "\n";
+        print '# $a         == ', $a, "\n";
+        print '# $c         == ', $c, "\n";
+        print "not ";
+        last;
+    }
+}
+close G;
+print "ok 29\n";
+
+END {
+    1 while unlink "a";
+    1 while unlink "b";
+}