This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Accessing unicode keys in tie hashes via hv_exists was broken.
[perl5.git] / ext / XS / APItest / t / hash.t
CommitLineData
0314122a
NC
1#!perl -w
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6 push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
7 require Config; import Config;
8 if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
9 # Look, I'm using this fully-qualified variable more than once!
10 my $arch = $MacPerl::Architecture;
11 print "1..0 # Skip: XS::APItest was not built\n";
12 exit 0;
13 }
14}
15
16use Tie::Hash;
17
18my @testkeys = ('N', chr 256);
19
20my $temp = chr 258;
21utf8::encode $temp;
22
23my @keys = (@testkeys, $temp);
24my (%hash, %tiehash);
25tie %tiehash, 'Tie::StdHash';
26
27@hash{@keys} = ();
28@tiehash{@keys} = ();
29
30
31use Test::More 'no_plan';
32
33use_ok('XS::APItest');
34
35sub test_present {
36 my $key = shift;
37 my $printable = join ',', map {ord} split //, $key;
38
39 ok (exists $hash{$key}, "hv_exists_ent present $printable");
40 ok (XS::APItest::Hash::exists (\%hash, $key), "hv_exists present $printable");
41
42 ok (exists $tiehash{$key}, "hv_exists_ent tie present $printable");
43 ok (XS::APItest::Hash::exists (\%tiehash, $key),
44 "hv_exists tie present $printable");
45}
46
47sub test_absent {
48 my $key = shift;
49 my $printable = join ',', map {ord} split //, $key;
50
51 ok (!exists $hash{$key}, "hv_exists_ent absent $printable");
52 ok (!XS::APItest::Hash::exists (\%hash, $key), "hv_exists absent $printable");
53
54 ok (!exists $tiehash{$key}, "hv_exists_ent tie absent $printable");
55 ok (!XS::APItest::Hash::exists (\%tiehash, $key),
56 "hv_exists tie absent $printable");
57}
58
59foreach my $key (@testkeys) {
60 test_present ($key);
61
62 my $lckey = lc $key;
63 test_absent ($lckey);
64
65 my $unikey = $key;
66 utf8::encode $unikey;
67
68 test_absent ($unikey) unless $unikey eq $key;
69}
70
71test_absent (chr 258);