Commit | Line | Data |
32381de9 |
1 | use strictures 1; |
2 | use Test::More; |
e25e8acf |
3 | use Moo::_Utils; |
4 | |
5 | ok(Moo::_Utils::lt_5_8_3, "pretending to be pre-5.8.3") |
6 | if $ENV{MOO_TEST_PRE_583}; |
32381de9 |
7 | |
8 | { |
9 | package Foo; |
10 | |
11 | use Moo; |
12 | |
f3dc0ac6 |
13 | has one => (is => 'rw', weak_ref => 1); |
6998abed |
14 | |
15 | package Foo2; |
16 | |
17 | use Moo; |
18 | |
60769550 |
19 | our $preexist = {}; |
20 | has one => (is => 'rw', lazy => 1, weak_ref => 1, default => sub { $preexist }); |
21 | has two => (is => 'rw', lazy => 1, weak_ref => 1, default => sub { {} }); |
32381de9 |
22 | } |
23 | |
2215d4b9 |
24 | my $ref = {}; |
32381de9 |
25 | my $foo = Foo->new(one => $ref); |
2215d4b9 |
26 | is($foo->one, $ref, 'value present'); |
32381de9 |
27 | ok(Scalar::Util::isweak($foo->{one}), 'value weakened'); |
2215d4b9 |
28 | undef $ref; |
6998abed |
29 | ok(!defined $foo->{one}, 'weak value gone'); |
30 | |
31 | my $foo2 = Foo2->new; |
60769550 |
32 | ok(my $ref2 = $foo2->one, 'external value returned'); |
33 | is($foo2->one, $ref2, 'value maintained'); |
6998abed |
34 | ok(Scalar::Util::isweak($foo2->{one}), 'value weakened'); |
f3dc0ac6 |
35 | is($foo2->one($ref2), $ref2, 'value returned from setter'); |
6998abed |
36 | undef $ref2; |
37 | ok(!defined $foo->{one}, 'weak value gone'); |
2215d4b9 |
38 | |
60769550 |
39 | is($foo2->two, undef, 'weak+lazy ref not returned'); |
40 | is($foo2->{two}, undef, 'internal value not set'); |
41 | my $ref3 = {}; |
42 | is($foo2->two($ref3), $ref3, 'value returned from setter'); |
43 | undef $ref3; |
44 | ok(!defined $foo->{two}, 'weak value gone'); |
45 | |
f3dc0ac6 |
46 | |
2215d4b9 |
47 | # test readonly SVs |
48 | sub mk_ref { \ 'yay' }; |
49 | my $foo_ro = eval { Foo->new(one => mk_ref()) }; |
50 | if ($] < 5.008003) { |
51 | like( |
52 | $@, |
53 | qr/\QReference to readonly value in "one" can not be weakened on Perl < 5.8.3/, |
54 | 'Expected exception thrown on old perls' |
55 | ); |
56 | } |
5f578bd3 |
57 | elsif ($^O eq 'cygwin' and $] < 5.012000) { |
58 | SKIP: { skip 'Static coderef reaping seems nonfunctional on cygwin < 5.12', 1 } |
59 | } |
2215d4b9 |
60 | else { |
61 | is(${$foo_ro->one},'yay', 'value present'); |
62 | ok(Scalar::Util::isweak($foo_ro->{one}), 'value weakened'); |
63 | |
64 | { no warnings 'redefine'; *mk_ref = sub {} } |
65 | ok (!defined $foo_ro->{one}, 'optree reaped, ro static value gone'); |
66 | } |
32381de9 |
67 | |
68 | done_testing; |