Commit | Line | Data |
60f3865b |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | unless (-d 'blib') { |
5 | chdir 't' if -d 't'; |
6 | @INC = '../lib'; |
7 | require Config; import Config; |
8 | keys %Config; # Silence warning |
9 | if ($Config{extensions} !~ /\bList\/Util\b/) { |
10 | print "1..0 # Skip: List::Util was not built\n"; |
11 | exit 0; |
12 | } |
13 | } |
14 | } |
15 | |
16 | |
2ff28616 |
17 | use Test::More tests => 32; |
cf083cf9 |
18 | |
60f3865b |
19 | use Scalar::Util qw(refaddr); |
20 | use vars qw($t $y $x *F $v $r); |
21 | use Symbol qw(gensym); |
22 | |
23 | # Ensure we do not trigger and tied methods |
24 | tie *F, 'MyTie'; |
25 | |
60f3865b |
26 | my $i = 1; |
27 | foreach $v (undef, 10, 'string') { |
cf083cf9 |
28 | is(refaddr($v), undef, "not " . (defined($v) ? "'$v'" : "undef")); |
60f3865b |
29 | } |
30 | |
31 | foreach $r ({}, \$t, [], \*F, sub {}) { |
cf083cf9 |
32 | my $n = "$r"; |
c658fda9 |
33 | $n =~ /0x(\w+)/; |
34 | my $addr = do { local $^W; hex $1 }; |
9850bf21 |
35 | my $before = ref($r); |
cf083cf9 |
36 | is( refaddr($r), $addr, $n); |
9850bf21 |
37 | is( ref($r), $before, $n); |
cf083cf9 |
38 | |
60f3865b |
39 | my $obj = bless $r, 'FooBar'; |
cf083cf9 |
40 | is( refaddr($r), $addr, "blessed with overload $n"); |
9850bf21 |
41 | is( ref($r), 'FooBar', $n); |
60f3865b |
42 | } |
43 | |
4579700c |
44 | { |
45 | my $z = '77'; |
46 | my $y = \$z; |
47 | my $a = '78'; |
48 | my $b = \$a; |
49 | tie my %x, 'Hash3', {}; |
50 | $x{$y} = 22; |
51 | $x{$b} = 23; |
52 | my $xy = $x{$y}; |
53 | my $xb = $x{$b}; |
cf083cf9 |
54 | ok(ref($x{$y})); |
55 | ok(ref($x{$b})); |
56 | ok(refaddr($xy) == refaddr($y)); |
57 | ok(refaddr($xb) == refaddr($b)); |
58 | ok(refaddr($x{$y})); |
59 | ok(refaddr($x{$b})); |
4579700c |
60 | } |
2ff28616 |
61 | { |
62 | my $z = bless {}, '0'; |
63 | ok(refaddr($z)); |
64 | @{"0::ISA"} = qw(FooBar); |
65 | my $a = {}; |
66 | my $r = refaddr($a); |
67 | $z = bless $a, '0'; |
68 | ok(refaddr($z) > 10); |
69 | is(refaddr($z),$r,"foo"); |
70 | } |
4579700c |
71 | |
60f3865b |
72 | package FooBar; |
73 | |
74 | use overload '0+' => sub { 10 }, |
2ff28616 |
75 | '+' => sub { 10 + $_[1] }, |
76 | '"' => sub { "10" }; |
60f3865b |
77 | |
78 | package MyTie; |
79 | |
80 | sub TIEHANDLE { bless {} } |
81 | sub DESTROY {} |
82 | |
83 | sub AUTOLOAD { |
84 | warn "$AUTOLOAD called"; |
85 | exit 1; # May be in an eval |
86 | } |
4579700c |
87 | |
88 | package Hash3; |
89 | |
90 | use Scalar::Util qw(refaddr); |
91 | |
92 | sub TIEHASH |
93 | { |
94 | my $pkg = shift; |
95 | return bless [ @_ ], $pkg; |
96 | } |
97 | sub FETCH |
98 | { |
99 | my $self = shift; |
100 | my $key = shift; |
101 | my ($underlying) = @$self; |
102 | return $underlying->{refaddr($key)}; |
103 | } |
104 | sub STORE |
105 | { |
106 | my $self = shift; |
107 | my $key = shift; |
108 | my $value = shift; |
109 | my ($underlying) = @$self; |
110 | return ($underlying->{refaddr($key)} = $key); |
111 | } |