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 | 11 | |
bf115a3f | 12 | |
893374f6 YK |
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 }; |
74175ec1 SP |
17 | |
18 | if ( $^O eq 'MSWin32' ) { | |
19 | print "1..0 # Skip -- this test is generally broken on windows for unknown reasons. If you can help debug this patches would be very welcome.\n"; | |
20 | exit 0; | |
21 | } | |
22 | if ( $Config{usethreads} and !$Config{use5005threads} | |
23 | and defined(&Scalar::Util::weaken) | |
c34a735e | 24 | and eval { require threads; threads->import; 1 } |
74175ec1 | 25 | ) { |
f0f40d86 RGS |
26 | print "1..14\n"; |
27 | } else { | |
bf115a3f | 28 | print "1..0 # Skip -- threads aren't enabled in your perl, or Scalar::Util::weaken is missing\n"; |
f0f40d86 RGS |
29 | exit 0; |
30 | } | |
893374f6 YK |
31 | } |
32 | ||
33 | use Tie::RefHash; | |
34 | ||
f0f40d86 RGS |
35 | $\ = "\n"; |
36 | sub ok ($$) { | |
37 | print ( ( $_[0] ? "" : "not " ), "ok - $_[1]" ); | |
38 | } | |
39 | ||
40 | sub is ($$$) { | |
bf115a3f | 41 | print ( ( ( ($_[0]||'') eq ($_[1]||'') ) ? "" : "not "), "ok - $_[2]" ); |
f0f40d86 RGS |
42 | } |
43 | ||
893374f6 YK |
44 | tie my %hash, "Tie::RefHash"; |
45 | ||
46 | my $r1 = {}; | |
47 | my $r2 = []; | |
48 | my $v1 = "foo"; | |
49 | ||
50 | $hash{$r1} = "hash"; | |
51 | $hash{$r2} = "array"; | |
52 | $hash{$v1} = "string"; | |
53 | ||
54 | is( $hash{$v1}, "string", "fetch by string before clone ($v1)" ); | |
55 | is( $hash{$r1}, "hash", "fetch by ref before clone ($r1)" ); | |
56 | is( $hash{$r2}, "array", "fetch by ref before clone ($r2)" ); | |
57 | ||
58 | my $th = threads->create(sub { | |
f0f40d86 | 59 | is( scalar keys %hash, 3, "key count is OK" ); |
893374f6 | 60 | |
f0f40d86 RGS |
61 | ok( exists $hash{$v1}, "string key exists ($v1)" ); |
62 | is( $hash{$v1}, "string", "fetch by string" ); | |
893374f6 | 63 | |
f0f40d86 RGS |
64 | ok( exists $hash{$r1}, "ref key exists ($r1)" ); |
65 | is( $hash{$r1}, "hash", "fetch by ref" ); | |
893374f6 | 66 | |
f0f40d86 RGS |
67 | ok( exists $hash{$r2}, "ref key exists ($r2)" ); |
68 | is( $hash{$r2}, "array", "fetch by ref" ); | |
893374f6 | 69 | |
f0f40d86 | 70 | is( join("\0",sort keys %hash), join("\0",sort $r1, $r2, $v1), "keys are ok" ); |
893374f6 YK |
71 | }); |
72 | ||
73 | $th->join; | |
74 | ||
75 | is( $hash{$v1}, "string", "fetch by string after clone, orig thread ($v1)" ); | |
76 | is( $hash{$r1}, "hash", "fetch by ref after clone ($r1)" ); | |
77 | is( $hash{$r2}, "array", "fetch by ref after clone ($r2)" ); |