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