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     package t::moo::extends_non_moo::second_level_moo;
  35     use Moo;
  36     extends 't::moo::extends_non_moo::moo_with_attr';
  37     has 'attr2' => (is=>'ro');
  38 }
  39
  40 ok my $app = 100,
  41   'prepared $app';
  42
  43 ok $app = t::moo::extends_non_moo::middle->wrap($app),
  44   '$app from $app';
  45
  46 is $app, 100,
  47   '$app still 100';
  48
  49 ok $app = t::moo::extends_non_moo::moo->wrap($app),
  50   '$app from $app';
  51
  52 is $app, 100,
  53   '$app still 100';
  54
  55 ok $app = t::moo::extends_non_moo::moo_with_attr->wrap($app),
  56   '$app from $app';
  57
  58 is $app, 100,
  59   '$app still 100';
  60
  61 ok $app = t::moo::extends_non_moo::second_level_moo->wrap($app),
  62   '$app from $app';
  63
  64 is $app, 100,
  65   '$app still 100';
  66
  67 done_testing();