Commit | Line | Data |
cada430e |
1 | use strict; |
2 | use warnings; |
3 | use Test::More; |
4 | |
707f101c |
5 | my $codified = 0; |
cada430e |
6 | { |
7 | package Dark::Side; |
8 | use overload |
707f101c |
9 | q[&{}] => sub { $codified++; shift->to_code }, |
cada430e |
10 | fallback => 1; |
11 | sub new { |
12 | my $class = shift; |
235b63fc |
13 | my $code = shift; |
14 | bless \$code, $class; |
cada430e |
15 | } |
16 | sub to_code { |
17 | my $self = shift; |
18 | eval "sub { $$self }"; |
19 | } |
20 | } |
21 | |
22 | { |
23 | package The::Force; |
24 | use Sub::Quote; |
25 | use base 'Dark::Side'; |
26 | sub to_code { |
27 | my $self = shift; |
28 | return quote_sub $$self; |
29 | } |
30 | } |
31 | |
32 | my $darkside = Dark::Side->new('my $dummy = "join the dark side"; $_[0] * 2'); |
33 | is($darkside->(6), 12, 'check Dark::Side coderef'); |
34 | |
35 | my $theforce = The::Force->new('my $dummy = "use the force Luke"; $_[0] * 2'); |
36 | is($theforce->(6), 12, 'check The::Force coderef'); |
37 | |
1f07812d |
38 | my $luke = The::Force->new('my $z = "I am your father"'); |
cada430e |
39 | { |
40 | package Doubleena; |
41 | use Moo; |
707f101c |
42 | has a => (is => "rw", coerce => $darkside, isa => sub { 1 }); |
1f07812d |
43 | has b => (is => "rw", coerce => $theforce, isa => $luke); |
cada430e |
44 | } |
45 | |
46 | my $o = Doubleena->new(a => 11, b => 12); |
47 | is($o->a, 22, 'non-Sub::Quoted inlined coercion overload works'); |
48 | is($o->b, 24, 'Sub::Quoted inlined coercion overload works'); |
707f101c |
49 | my $codified_before = $codified; |
50 | $o->a(5); |
51 | is($codified_before, $codified, "repeated calls to accessor don't re-trigger overload"); |
cada430e |
52 | |
53 | use B::Deparse; |
54 | my $constructor = B::Deparse->new->coderef2text(Doubleena->can('new')); |
55 | |
56 | like($constructor, qr{use the force Luke}, 'Sub::Quoted coercion got inlined'); |
57 | unlike($constructor, qr{join the dark side}, 'non-Sub::Quoted coercion was not inlined'); |
58 | like($constructor, qr{I am your father}, 'Sub::Quoted isa got inlined'); |
59 | |
1f07812d |
60 | require Scalar::Util; |
61 | is( |
62 | Scalar::Util::refaddr($luke), |
63 | Scalar::Util::refaddr( |
64 | Moo->_constructor_maker_for("Doubleena")->all_attribute_specs->{"b"}{"isa"} |
65 | ), |
66 | '$spec->{isa} reference is not mutated', |
67 | ); |
68 | is( |
69 | Scalar::Util::refaddr($theforce), |
70 | Scalar::Util::refaddr( |
71 | Moo->_constructor_maker_for("Doubleena")->all_attribute_specs->{"b"}{"coerce"} |
72 | ), |
73 | '$spec->{coerce} reference is not mutated', |
74 | ); |
75 | |
cada430e |
76 | done_testing; |