t-failing/060_compat/003_foreign_inheritence.t

   1 #!/usr/bin/perl
   2 # This is automatically generated by author/import-moose-test.pl.
   3 # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
   4 use t::lib::MooseCompat;
   5
   6 use strict;
   7 use warnings;
   8
   9 use Test::More;
  10 $TODO = q{Mouse is not yet completed};
  11 use Test::Exception;
  12
  13
  14 {
  15
  16     package Elk;
  17     use strict;
  18     use warnings;
  19
  20     sub new {
  21         my $class = shift;
  22         bless { no_moose => "Elk" } => $class;
  23     }
  24
  25     sub no_moose { $_[0]->{no_moose} }
  26
  27     package Foo::Mouse;
  28     use Mouse;
  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     __PACKAGE__->meta->make_immutable( inline_constructor => 0, debug => 0 );
  41
  42     package Bucket;
  43     use metaclass 'Mouse::Meta::Class';
  44
  45     __PACKAGE__->meta->add_attribute(
  46         'squeegee' => ( accessor => 'squeegee' ) );
  47
  48     package Old::Bucket::Nose;
  49
  50     # see http://www.moosefoundation.org/moose_facts.htm
  51     use Mouse;
  52
  53     extends 'Bucket';
  54
  55     package MyBase;
  56     sub foo { }
  57
  58     package Custom::Meta1;
  59     use base qw(Mouse::Meta::Class);
  60
  61     package Custom::Meta2;
  62     use base qw(Mouse::Meta::Class);
  63
  64     package SubClass1;
  65     use metaclass 'Custom::Meta1';
  66     use Mouse;
  67
  68     extends 'MyBase';
  69
  70     package SubClass2;
  71     use metaclass 'Custom::Meta2';
  72     use Mouse;
  73
  74     # XXX FIXME subclassing meta-attrs and immutable-ing the subclass fails
  75 }
  76
  77 my $foo_moose = Foo::Mouse->new();
  78 isa_ok( $foo_moose, 'Foo::Mouse' );
  79 isa_ok( $foo_moose, 'Elk' );
  80
  81 is( $foo_moose->no_moose, 'Elk',
  82     '... got the right value from the Elk method' );
  83 is( $foo_moose->moose, 'Foo',
  84     '... got the right value from the Foo::Mouse method' );
  85
  86 lives_ok {
  87     Old::Bucket::Nose->meta->make_immutable( debug => 0 );
  88 }
  89 'Immutability on Mouse class extending Mouse::Meta class ok';
  90
  91 lives_ok {
  92     SubClass2->meta->superclasses('MyBase');
  93 }
  94 'Can subclass the same non-Mouse class twice with different metaclasses';
  95
  96 done_testing;