This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
(not solving: Re: Storable can't do utf8 hash keys)
[perl5.git] / t / op / utfhash.t
1 BEGIN {
2     chdir 't' if -d 't';
3     @INC = '../lib';
4     require './test.pl';
5
6     plan(tests => 48);
7 }
8
9 # Two hashes one will all keys 8-bit possible (initially), other
10 # with a utf8 requiring key from the outset.
11
12 my %hash8 = ( "\xff" => 0xff,
13               "\x7f" => 0x7f,
14             );
15 my %hashu = ( "\xff" => 0xff,
16               "\x7f" => 0x7f,
17               "\x{1ff}" => 0x1ff,
18             );
19
20 # Check that we can find the 8-bit things by various litterals
21 is($hash8{"\x{00ff}"},0xFF);
22 is($hash8{"\x{007f}"},0x7F);
23 is($hash8{"\xff"},0xFF);
24 is($hash8{"\x7f"},0x7F);
25 is($hashu{"\x{00ff}"},0xFF);
26 is($hashu{"\x{007f}"},0x7F);
27 is($hashu{"\xff"},0xFF);
28 is($hashu{"\x7f"},0x7F);
29
30 # Now try same thing with variables forced into various forms.
31 foreach my $a ("\x7f","\xff")
32  {
33   utf8::upgrade($a);
34   is($hash8{$a},ord($a));
35   is($hashu{$a},ord($a));
36   utf8::downgrade($a);
37   is($hash8{$a},ord($a));
38   is($hashu{$a},ord($a));
39   my $b = $a.chr(100);
40   chop($b);
41   is($hash8{$b},ord($b));
42   is($hashu{$b},ord($b));
43  }
44
45 # Check we have not got an spurious extra keys
46 is(join('',sort { ord $a <=> ord $b } keys %hash8),"\x7f\xff");
47 is(join('',sort { ord $a <=> ord $b } keys %hashu),"\x7f\xff\x{1ff}");
48
49 # Now add a utf8 key to the 8-bit hash
50 $hash8{chr(0x1ff)} = 0x1ff;
51
52 # Check we have not got an spurious extra keys
53 is(join('',sort { ord $a <=> ord $b } keys %hash8),"\x7f\xff\x{1ff}");
54
55 foreach my $a ("\x7f","\xff","\x{1ff}")
56  {
57   utf8::upgrade($a);
58   is($hash8{$a},ord($a));
59   my $b = $a.chr(100);
60   chop($b);
61   is($hash8{$b},ord($b));
62  }
63
64 # and remove utf8 from the other hash
65 is(delete $hashu{chr(0x1ff)},0x1ff);
66 is(join('',sort keys %hashu),"\x7f\xff");
67
68 foreach my $a ("\x7f","\xff")
69  {
70   utf8::upgrade($a);
71   is($hashu{$a},ord($a));
72   utf8::downgrade($a);
73   is($hashu{$a},ord($a));
74   my $b = $a.chr(100);
75   chop($b);
76   is($hashu{$b},ord($b));
77  }
78
79
80
81 {
82     print "# Unicode hash keys and \\w\n";
83     # This is not really a regex test but regexes bring
84     # out the issue nicely.
85     use strict;
86     my $u3 = "f\x{df}\x{100}";
87     my $u2 = substr($u3,0,2);
88     my $u1 = substr($u2,0,1);
89     my %u = ( $u1 => $u1, $u2 => $u2, $u3 => $u3 );  
90
91     for (keys %u) {
92         ok (/^\w+$/ && $u{$_} =~ /^\w+$/, "\\w on keys");
93    }
94
95     for (each %u) {
96         ok (/^\w+$/ && $u{$_} =~ /^\w+$/, "\\w on each");
97    }
98
99     for (%u) {
100         ok (/^\w+$/ && $u{$_} =~ /^\w+$/, "\\w on hash");
101    }
102 }