1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
use strict;
use warnings;
BEGIN {
if ($ENV{'PERL_CORE'}){
chdir 't';
unshift @INC, '../lib';
}
use Config;
if (! $Config{'useithreads'}) {
print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
exit(0);
}
}
use ExtUtils::testlib;
my $TEST = 1;
sub is {
my ($got, $exp, $name) = @_;
my $ok = ($got eq $exp);
# You have to do it this way or VMS will get confused.
if ($ok) {
print("ok $TEST - $name\n");
} else {
print("not ok $TEST - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print("# Got: $got\n");
print("# Expected: $exp\n");
}
$TEST++;
return ($ok);
}
BEGIN {
$| = 1;
print("1..12\n"); ### Number of tests that will be run ###
};
use threads;
use threads::shared;
### Start of Testing ###
binmode STDOUT, ":utf8";
my $plain = 'foo';
my $utf8 = "\x{123}\x{84}\x{20F}\x{2C1}";
my %a :shared;
$a{$plain} = $plain;
$a{$utf8} = $utf8;
$a{\&is} = 'code';
is(exists($a{$plain}), 1, 'Found plain key in shared hash');
is(exists($a{$utf8}), 1, 'Found UTF-8 key in shared hash');
is(exists($a{\&is}), 1, 'Found code ref key in shared hash');
while (my ($key, $value) = each (%a)) {
if ($key eq $plain) {
is($key, $plain, 'Plain key in shared hash');
} elsif ($key eq $utf8) {
is($key, $utf8, 'UTF-8 key in shared hash');
} else {
is($key, \&is, 'Code ref key in shared hash');
}
}
my $a = &share({});
$$a{$plain} = $plain;
$$a{$utf8} = $utf8;
$$a{\&is} = 'code';
is(exists($$a{$plain}), 1, 'Found plain key in shared hash ref');
is(exists($$a{$utf8}), 1, 'Found UTF-8 key in shared hash ref');
is(exists($$a{\&is}), 1, 'Found code ref key in shared hash ref');
while (my ($key, $value) = each (%$a)) {
if ($key eq $plain) {
is($key, $plain, 'Plain key in shared hash ref');
} elsif ($key eq $utf8) {
is($key, $utf8, 'UTF-8 key in shared hash ref');
} else {
is($key, \&is, 'Code ref key in shared hash ref');
}
}
exit(0);
# EOF
|
