Fix type composition
[gitmo/Mouse.git] / Moose-t-failing / 100_bugs / 006_handles_foreign_class_bug.t
CommitLineData
4c98ebb0 1#!/usr/bin/perl
c47cf415 2# This is automatically generated by author/import-moose-test.pl.
3# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
4use t::lib::MooseCompat;
4c98ebb0 5
6use strict;
7use warnings;
8
c47cf415 9use Test::More;
10$TODO = q{Mouse is not yet completed};
4c98ebb0 11use Test::Exception;
12
13{
14 package Foo;
15
16 sub new {
17 bless({}, 'Foo')
18 }
19
20 sub a { 'Foo::a' }
21}
22
23{
24 package Bar;
25 use Mouse;
26
27 ::lives_ok {
28 has 'baz' => (
29 is => 'ro',
30 isa => 'Foo',
31 lazy => 1,
32 default => sub { Foo->new() },
33 handles => qr/^a$/,
34 );
35 } '... can create the attribute with delegations';
36
37}
38
39my $bar;
40lives_ok {
41 $bar = Bar->new;
42} '... created the object ok';
43isa_ok($bar, 'Bar');
44
45is($bar->a, 'Foo::a', '... got the right delgated value');
46
47my @w;
48$SIG{__WARN__} = sub { push @w, "@_" };
49{
50 package Baz;
51 use Mouse;
52
53 ::lives_ok {
54 has 'bar' => (
55 is => 'ro',
56 isa => 'Foo',
57 lazy => 1,
58 default => sub { Foo->new() },
59 handles => qr/.*/,
60 );
61 } '... can create the attribute with delegations';
62
63}
64
65is(@w, 0, "no warnings");
66
67
68my $baz;
69lives_ok {
70 $baz = Baz->new;
71} '... created the object ok';
72isa_ok($baz, 'Baz');
73
74is($baz->a, 'Foo::a', '... got the right delgated value');
75
76
77
78
79
80@w = ();
81
82{
83 package Blart;
84 use Mouse;
85
86 ::lives_ok {
87 has 'bar' => (
88 is => 'ro',
89 isa => 'Foo',
90 lazy => 1,
91 default => sub { Foo->new() },
92 handles => [qw(a new)],
93 );
94 } '... can create the attribute with delegations';
95
96}
97
98{
99 local $TODO = "warning not yet implemented";
100
101 is(@w, 1, "one warning");
102 like($w[0], qr/not delegating.*new/i, "warned");
103}
104
105
106
107my $blart;
108lives_ok {
109 $blart = Blart->new;
110} '... created the object ok';
111isa_ok($blart, 'Blart');
112
113is($blart->a, 'Foo::a', '... got the right delgated value');
114
c47cf415 115done_testing;