t/overloaded-coderefs.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4
   5 my $codified = 0;
   6 {
   7         package Dark::Side;
   8         use overload
   9                 q[&{}]   => sub { $codified++; shift->to_code },
  10                 fallback => 1;
  11         sub new {
  12                 my $class = shift;
  13                 my $code = shift;
  14                 bless \$code, $class;
  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
  38 my $luke = The::Force->new('my $z = "I am your father"');
  39 {
  40         package Doubleena;
  41         use Moo;
  42         has a => (is => "rw", coerce => $darkside, isa => sub { 1 });
  43         has b => (is => "rw", coerce => $theforce, isa => $luke);
  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');
  49 my $codified_before = $codified;
  50 $o->a(5);
  51 is($codified_before, $codified, "repeated calls to accessor don't re-trigger overload");
  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
  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
  76 done_testing;