1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
BEGIN {
require Moose;
package Foo::Exporter::Class;
use Moose::Exporter;
Moose::Exporter->setup_import_methods(also => ['Moose']);
sub init_meta {
shift;
my %options = @_;
Moose->init_meta(%options);
Moose::Util::MetaRole::apply_metaroles(
for => $options{for_class},
class_metaroles => {
class => ['MooseX::NonMoose::Meta::Role::Class'],
},
);
return Class::MOP::class_of($options{for_class});
}
package Foo::Exporter::ClassAndConstructor;
use Moose::Exporter;
Moose::Exporter->setup_import_methods(also => ['Moose']);
sub init_meta {
shift;
my %options = @_;
Moose->init_meta(%options);
Moose::Util::MetaRole::apply_metaroles(
for => $options{for_class},
class_metaroles => {
class => ['MooseX::NonMoose::Meta::Role::Class'],
constructor =>
['MooseX::NonMoose::Meta::Role::Constructor'],
},
);
return Class::MOP::class_of($options{for_class});
}
}
package Foo;
sub new { bless {}, shift }
package Foo::Moose;
BEGIN { Foo::Exporter::Class->import }
extends 'Foo';
package Foo::Moose2;
BEGIN { Foo::Exporter::ClassAndConstructor->import }
extends 'Foo';
package main;
ok(Foo::Moose->meta->has_method('new'),
'using only the metaclass trait still installs the constructor');
isa_ok(Foo::Moose->new, 'Moose::Object');
isa_ok(Foo::Moose->new, 'Foo');
my $method = Foo::Moose->meta->get_method('new');
Foo::Moose->meta->make_immutable;
is(Foo::Moose->meta->get_method('new'), $method,
'inlining doesn\'t happen when the constructor trait isn\'t used');
ok(Foo::Moose2->meta->has_method('new'),
'using only the metaclass trait still installs the constructor');
isa_ok(Foo::Moose2->new, 'Moose::Object');
isa_ok(Foo::Moose2->new, 'Foo');
my $method2 = Foo::Moose2->meta->get_method('new');
Foo::Moose2->meta->make_immutable;
isnt(Foo::Moose2->meta->get_method('new'), $method2,
'inlining does happen when the constructor trait is used');
done_testing;
|
