Update the warning message.

[perl5.git] / t / op / utfhash.t

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
    require './test.pl';

    plan(tests => 48);
}

# 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 { ord $a <=> ord $b } keys %hash8),"\x7f\xff");
is(join('',sort { ord $a <=> ord $b } 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 { ord $a <=> ord $b } 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));
 }



{
    print "# Unicode hash keys and \\w\n";
    # This is not really a regex test but regexes bring
    # out the issue nicely.
    use strict;
    my $u3 = "f\x{df}\x{100}";
    my $u2 = substr($u3,0,2);
    my $u1 = substr($u2,0,1);
    my %u = ( $u1 => $u1, $u2 => $u2, $u3 => $u3 );  

    for (keys %u) {
	ok (/^\w+$/ && $u{$_} =~ /^\w+$/, "\\w on keys");
   }

    for (each %u) {
	ok (/^\w+$/ && $u{$_} =~ /^\w+$/, "\\w on each");
   }

    for (%u) {
	ok (/^\w+$/ && $u{$_} =~ /^\w+$/, "\\w on hash");
   }
}