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