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 }