t/extends-non-moo.t

   1 use strictures 1;
   2 use Test::More;
   3
   4 {
   5     package t::moo::extends_non_moo::base;
   6
   7     sub new {
   8         my ($proto, $args) = @_;
   9         bless $args, $proto;
  10     }
  11
  12     sub to_app {
  13         (shift)->{app};
  14     }
  15
  16     package t::moo::extends_non_moo::middle;
  17     use base qw(t::moo::extends_non_moo::base);
  18
  19     sub wrap {
  20         my($class, $app) = @_;
  21         $class->new({app => $app})
  22               ->to_app;
  23     }
  24
  25     package t::moo::extends_non_moo::moo;
  26     use Moo;
  27     extends 't::moo::extends_non_moo::middle';
  28
  29     package t::moo::extends_non_moo::moo_with_attr;
  30     use Moo;
  31     extends 't::moo::extends_non_moo::middle';
  32     has 'attr' => (is=>'ro');
  33 }
  34
  35 ok my $app = 100,
  36   'prepared $app';
  37
  38 ok $app = t::moo::extends_non_moo::middle->wrap($app),
  39   '$app from $app';
  40
  41 is $app, 100,
  42   '$app still 100';
  43
  44 ok $app = t::moo::extends_non_moo::moo->wrap($app),
  45   '$app from $app';
  46
  47 is $app, 100,
  48   '$app still 100';
  49
  50 ok $app = t::moo::extends_non_moo::moo_with_attr->wrap($app),
  51   '$app from $app';
  52
  53 is $app, 100,
  54   '$app still 100';
  55
  56 done_testing();