Integrate perlio:

[ 15412]
Check for sanity of UTF-8 keys in hashes
(feel free to add more tests...)

[ 15410]
Fix [ID 20020318.003] cannot open STDOUT into in memory variable
- when (e.g.) STDOUT is char special file and gets IoOFP
created - do _NOT_ pass num_svs as that fopen-s stringified
glob, and not fdopen-s the fd.
p4raw-link: @15412 on //depot/perlio: cb0a5b5c946748a0ce5472032178d97c33e21b33
p4raw-link: @15410 on //depot/perlio: dd37d22f759197ae537bfc89e7f0cd73321b19b3

p4raw-id: //depot/perl@15413

diff --git a/MANIFEST b/MANIFEST
index 0459088..1403dfd 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2421,6 +2421,7 @@ t/op/undef.t                      See if undef works
 t/op/universal.t               See if UNIVERSAL class works
 t/op/unshift.t                 See if unshift works
 t/op/utf8decode.t              See if UTF-8 decoding works
+t/op/utfhash.t                 See if utf8 keys in hashes behave
 t/op/vec.t                     See if vectors work
 t/op/ver.t                     See if v-strings and the %v format flag work
 t/op/wantarray.t               See if wantarray works

diff --git a/doio.c b/doio.c
index d68d13c..2027e36 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -640,7 +640,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        if (IoTYPE(io) == IoTYPE_SOCKET
            || (IoTYPE(io) == IoTYPE_WRONLY && fd >= 0 && S_ISCHR(PL_statbuf.st_mode)) ) {
            mode[0] = 'w';
-           if (!(IoOFP(io) = PerlIO_openn(aTHX_ type,mode,fd,0,0,NULL,num_svs,svp))) {
+           if (!(IoOFP(io) = PerlIO_openn(aTHX_ type,mode,fd,0,0,NULL,0,svp))) {
                PerlIO_close(fp);
                IoIFP(io) = Nullfp;
                goto say_false;

diff --git a/t/op/utfhash.t b/t/op/utfhash.t
new file mode 100644 (file)
index 0000000..a955f28
--- /dev/null
+++ b/t/op/utfhash.t
@@ -0,0 +1,79 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+
+    plan(tests => 37);
+}
+
+# Two hashes one will all keys 8-bit possible (initially), other
+# with a utf8 requiring key from the outset.
+
+my %hash8 = ( "\xff" => 0xff,
+              "\x7f" => 0x7f,
+            );
+my %hashu = ( "\xff" => 0xff,
+              "\x7f" => 0x7f,
+              "\x{1ff}" => 0x1ff,
+            );
+
+# Check that we can find the 8-bit things by various litterals
+is($hash8{"\x{00ff}"},0xFF);
+is($hash8{"\x{007f}"},0x7F);
+is($hash8{"\xff"},0xFF);
+is($hash8{"\x7f"},0x7F);
+is($hashu{"\x{00ff}"},0xFF);
+is($hashu{"\x{007f}"},0x7F);
+is($hashu{"\xff"},0xFF);
+is($hashu{"\x7f"},0x7F);
+
+# Now try same thing with variables forced into various forms.
+foreach my $a ("\x7f","\xff")
+ {
+  utf8::upgrade($a);
+  is($hash8{$a},ord($a));
+  is($hashu{$a},ord($a));
+  utf8::downgrade($a);
+  is($hash8{$a},ord($a));
+  is($hashu{$a},ord($a));
+  my $b = $a.chr(100);
+  chop($b);
+  is($hash8{$b},ord($b));
+  is($hashu{$b},ord($b));
+ }
+
+# Check we have not got an spurious extra keys
+is(join('',sort keys %hash8),"\x7f\xff");
+is(join('',sort keys %hashu),"\x7f\xff\x{1ff}");
+
+# Now add a utf8 key to the 8-bit hash
+$hash8{chr(0x1ff)} = 0x1ff;
+
+# Check we have not got an spurious extra keys
+is(join('',sort keys %hash8),"\x7f\xff\x{1ff}");
+
+foreach my $a ("\x7f","\xff","\x{1ff}")
+ {
+  utf8::upgrade($a);
+  is($hash8{$a},ord($a));
+  my $b = $a.chr(100);
+  chop($b);
+  is($hash8{$b},ord($b));
+ }
+
+# and remove utf8 from the other hash
+is(delete $hashu{chr(0x1ff)},0x1ff);
+is(join('',sort keys %hashu),"\x7f\xff");
+
+foreach my $a ("\x7f","\xff")
+ {
+  utf8::upgrade($a);
+  is($hashu{$a},ord($a));
+  utf8::downgrade($a);
+  is($hashu{$a},ord($a));
+  my $b = $a.chr(100);
+  chop($b);
+  is($hashu{$b},ord($b));
+ }
+
+