t/020_foreign_inheritence.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 5;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Moose');
  11 }
  12
  13 {
  14         package Elk;
  15         use strict;
  16         use warnings;
  17
  18         sub new {
  19                 my $class = shift;
  20                 bless { no_moose => "Elk" } => $class;
  21         }
  22
  23         sub no_moose { $_[0]->{no_moose} }
  24
  25         package Foo::Moose;
  26         use strict;
  27         use warnings;
  28         use Moose;
  29
  30         extends 'Elk';
  31
  32         has 'moose' => (is => 'ro', default => 'Foo');
  33
  34         sub new {
  35                 my $class = shift;
  36                 my $super = $class->SUPER::new(@_);
  37                 return $class->meta->new_object('__INSTANCE__' => $super, @_);
  38         }
  39 }
  40
  41 my $foo_moose = Foo::Moose->new();
  42 isa_ok($foo_moose, 'Foo::Moose');
  43 isa_ok($foo_moose, 'Elk');
  44
  45 is($foo_moose->no_moose, 'Elk', '... got the right value from the Elk method');
  46 is($foo_moose->moose, 'Foo', '... got the right value from the Foo::Moose method');