Skip tests for strict constructor on Moose
[gitmo/Mouse.git] / t / 001_mouse / 050-inherited-immutable-constructor-bug.t
CommitLineData
ae7bec5e 1#!/usr/bin/perl
2use strict;
3use warnings;
4use Test::More tests => 8;
5
6{
7 package Sausage;
8 use Mouse::Role;
9
10 has gristle => (is => 'rw');
11}
12
13{
14 package Dog;
15 use Mouse;
16
17 has tail => (is => 'rw');
18
19 __PACKAGE__->meta->make_immutable;
20}
21
22{
23 package SausageDog;
24 use Mouse;
25 extends 'Dog';
26 with 'Sausage';
27
28 has yap => (is => 'rw');
29
30# This class is mutable, but derives from an immutable base, and so
31# used to inherit an immutable constructor compiled for the wrong
32# class. It is composed with a Role, and should acquire both the
33# attributes in that role, and the initialisers. Likewise for it's own
34# attributes. (In the bug this test exhibited, it wasn't acquiring an
35# initialiser for 'gristle' or 'yap').
36#
37# This has now been fixed by adding a check in the immutable
38# constructor that the invoking class is the right one, else it
39# redispatches to Mouse::Object::new.
40}
41
42
43
44
45my $fritz = SausageDog->new(gristle => 1,
46 tail => 1,
47 yap => 1);
48
49
50isa_ok $fritz, 'SausageDog';
51isa_ok $fritz, 'Dog';
52ok !$fritz->isa('Sausage'), "Fritz is not a Sausage";
53ok $fritz->does('Sausage'), "Fritz does Sausage";
54
55can_ok $fritz, qw(tail gristle yap);
56
57ok $fritz->gristle, "Fritz has gristle";
58ok $fritz->tail, "Fritz has a tail";
59ok $fritz->yap, "Fritz has a yap";
60
61
62