Changelogging

[gitmo/Mouse.git] / t-failing / 060_compat / 003_foreign_inheritence.t

#!/usr/bin/perl
# This is automatically generated by author/import-moose-test.pl.
# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
use t::lib::MooseCompat;

use strict;
use warnings;

use Test::More;
$TODO = q{Mouse is not yet completed};
use Test::Exception;


{

    package Elk;
    use strict;
    use warnings;

    sub new {
        my $class = shift;
        bless { no_moose => "Elk" } => $class;
    }

    sub no_moose { $_[0]->{no_moose} }

    package Foo::Mouse;
    use Mouse;

    extends 'Elk';

    has 'moose' => ( is => 'ro', default => 'Foo' );

    sub new {
        my $class = shift;
        my $super = $class->SUPER::new(@_);
        return $class->meta->new_object( '__INSTANCE__' => $super, @_ );
    }

    __PACKAGE__->meta->make_immutable( inline_constructor => 0, debug => 0 );

    package Bucket;
    use metaclass 'Mouse::Meta::Class';

    __PACKAGE__->meta->add_attribute(
        'squeegee' => ( accessor => 'squeegee' ) );

    package Old::Bucket::Nose;

    # see http://www.moosefoundation.org/moose_facts.htm
    use Mouse;

    extends 'Bucket';

    package MyBase;
    sub foo { }

    package Custom::Meta1;
    use base qw(Mouse::Meta::Class);

    package Custom::Meta2;
    use base qw(Mouse::Meta::Class);

    package SubClass1;
    use metaclass 'Custom::Meta1';
    use Mouse;

    extends 'MyBase';

    package SubClass2;
    use metaclass 'Custom::Meta2';
    use Mouse;

    # XXX FIXME subclassing meta-attrs and immutable-ing the subclass fails
}

my $foo_moose = Foo::Mouse->new();
isa_ok( $foo_moose, 'Foo::Mouse' );
isa_ok( $foo_moose, 'Elk' );

is( $foo_moose->no_moose, 'Elk',
    '... got the right value from the Elk method' );
is( $foo_moose->moose, 'Foo',
    '... got the right value from the Foo::Mouse method' );

lives_ok {
    Old::Bucket::Nose->meta->make_immutable( debug => 0 );
}
'Immutability on Mouse class extending Mouse::Meta class ok';

lives_ok {
    SubClass2->meta->superclasses('MyBase');
}
'Can subclass the same non-Mouse class twice with different metaclasses';

done_testing;