Commit | Line | Data |
f0f40d86 |
1 | #!/usr/bin/perl -T -w |
893374f6 |
2 | |
3 | BEGIN { |
f0f40d86 |
4 | if( $ENV{PERL_CORE} ) { |
5 | chdir 't'; |
6 | @INC = '../lib'; |
7 | } |
893374f6 |
8 | } |
9 | |
10 | use strict; |
893374f6 |
11 | |
bf115a3f |
12 | |
893374f6 |
13 | BEGIN { |
14 | # this is sucky because threads.pm has to be loaded before Test::Builder |
f0f40d86 |
15 | use Config; |
bf115a3f |
16 | eval { require Scalar::Util }; |
17 | if ( $Config{usethreads} and !$Config{use5005threads} and defined(&Scalar::Util::weaken) ) { |
f0f40d86 |
18 | require threads; "threads"->import; |
19 | print "1..14\n"; |
20 | } else { |
bf115a3f |
21 | print "1..0 # Skip -- threads aren't enabled in your perl, or Scalar::Util::weaken is missing\n"; |
f0f40d86 |
22 | exit 0; |
23 | } |
893374f6 |
24 | } |
25 | |
26 | use Tie::RefHash; |
27 | |
f0f40d86 |
28 | $\ = "\n"; |
29 | sub ok ($$) { |
30 | print ( ( $_[0] ? "" : "not " ), "ok - $_[1]" ); |
31 | } |
32 | |
33 | sub is ($$$) { |
bf115a3f |
34 | print ( ( ( ($_[0]||'') eq ($_[1]||'') ) ? "" : "not "), "ok - $_[2]" ); |
f0f40d86 |
35 | } |
36 | |
893374f6 |
37 | tie my %hash, "Tie::RefHash"; |
38 | |
39 | my $r1 = {}; |
40 | my $r2 = []; |
41 | my $v1 = "foo"; |
42 | |
43 | $hash{$r1} = "hash"; |
44 | $hash{$r2} = "array"; |
45 | $hash{$v1} = "string"; |
46 | |
47 | is( $hash{$v1}, "string", "fetch by string before clone ($v1)" ); |
48 | is( $hash{$r1}, "hash", "fetch by ref before clone ($r1)" ); |
49 | is( $hash{$r2}, "array", "fetch by ref before clone ($r2)" ); |
50 | |
51 | my $th = threads->create(sub { |
f0f40d86 |
52 | is( scalar keys %hash, 3, "key count is OK" ); |
893374f6 |
53 | |
f0f40d86 |
54 | ok( exists $hash{$v1}, "string key exists ($v1)" ); |
55 | is( $hash{$v1}, "string", "fetch by string" ); |
893374f6 |
56 | |
f0f40d86 |
57 | ok( exists $hash{$r1}, "ref key exists ($r1)" ); |
58 | is( $hash{$r1}, "hash", "fetch by ref" ); |
893374f6 |
59 | |
f0f40d86 |
60 | ok( exists $hash{$r2}, "ref key exists ($r2)" ); |
61 | is( $hash{$r2}, "array", "fetch by ref" ); |
893374f6 |
62 | |
f0f40d86 |
63 | is( join("\0",sort keys %hash), join("\0",sort $r1, $r2, $v1), "keys are ok" ); |
893374f6 |
64 | }); |
65 | |
66 | $th->join; |
67 | |
68 | is( $hash{$v1}, "string", "fetch by string after clone, orig thread ($v1)" ); |
69 | is( $hash{$r1}, "hash", "fetch by ref after clone ($r1)" ); |
70 | is( $hash{$r2}, "array", "fetch by ref after clone ($r2)" ); |