t/overloaded-coderefs.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4
   5 {
   6         package Dark::Side;
   7         use overload
   8                 q[&{}]   => sub { shift->to_code },
   9                 fallback => 1;
  10         sub new {
  11                 my $class = shift;
  12                 bless \$_[0], $class;
  13         }
  14         sub to_code {
  15                 my $self = shift;
  16                 eval "sub { $$self }";
  17         }
  18 }
  19
  20 {
  21         package The::Force;
  22         use Sub::Quote;
  23         use base 'Dark::Side';
  24         sub to_code {
  25                 my $self = shift;
  26                 return quote_sub $$self;
  27         }
  28 }
  29
  30 my $darkside = Dark::Side->new('my $dummy = "join the dark side"; $_[0] * 2');
  31 is($darkside->(6), 12, 'check Dark::Side coderef');
  32
  33 my $theforce = The::Force->new('my $dummy = "use the force Luke"; $_[0] * 2');
  34 is($theforce->(6), 12, 'check The::Force coderef');
  35
  36 {
  37         package Doubleena;
  38         use Moo;
  39         has a => (is => "ro", coerce => $darkside, isa => sub { 1 });
  40         has b => (is => "ro", coerce => $theforce, isa => The::Force->new('my $z = "I am your father"'));
  41 }
  42
  43 my $o = Doubleena->new(a => 11, b => 12);
  44 is($o->a, 22, 'non-Sub::Quoted inlined coercion overload works');
  45 is($o->b, 24, 'Sub::Quoted inlined coercion overload works');
  46
  47 use B::Deparse;
  48 my $constructor = B::Deparse->new->coderef2text(Doubleena->can('new'));
  49
  50 like($constructor, qr{use the force Luke}, 'Sub::Quoted coercion got inlined');
  51 unlike($constructor, qr{join the dark side}, 'non-Sub::Quoted coercion was not inlined');
  52 like($constructor, qr{I am your father}, 'Sub::Quoted isa got inlined');
  53
  54 done_testing;