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