Commit 9dbc5b36bbff7fe75fa69497b30604b7a06ff7e3 - libmoose-perl

+40

-0

Changes less more

0	0	Also see Moose::Manual::Delta for more details of, and workarounds
1	1	for, noteworthy changes.
	2
	3	0.80 Sat, Jun 6, 2009
	4	* Moose::Manual::FAQ
	5	- Add FAQ about the coercion change from 0.76 because it came up
	6	three times today (perigrin)
	7	- Win doy $10 dollars because Sartak didn't think anybody
	8	would document this fast enough (perigrin)
	9
	10	* Moose::Meta::Method::Destructor
	11	- Inline a DESTROY method even if there are no DEMOLISH methods
	12	to prevent unnecessary introspection in
	13	Moose::Object::DEMOLISHALL
	14
	15	* Moose::*
	16	- A role's required methods are now represented by
	17	Moose::Meta::Role::Method::Required objects. Conflicts are now
	18	represented by Moose::Meta::Role::Method::Conflicting
	19	objects. The benefit for end-users in that unresolved
	20	conflicts generate different, more instructive, errors,
	21	resolving Ovid's #44895. (Sartak)
	22
	23	* Moose::Role
	24	- Improve the error message of "extends" as suggested by Adam
	25	Kennedy and confound (Sartak)
	26	- Link to Moose::Manual::Roles from Moose::Role as we now have
	27	excellent documentation (Adam Kennedy)
	28
	29	* Tests
	30	- Update test suite for subname change in Class::MOP
	31	(nothingmuch)
	32	- Add TODO test for infinite recursion in Moose::Meta::Class
	33	(groditi)
2	34
3	35	0.79 Wed, May 13, 2009
4	36	* Tests

9	41	during global destruction. This method has been made more
10	42	resilient in the face of global destruction's random garbage
11	43	collection order.
	44
	45	* Moose::Exporter
	46	- If you "also" a module that isn't loaded, the error message
	47	now acknowledges that (Sartak)
	48
	49	* Moose
	50	- When your ->meta method does not return a Moose::Meta::Class,
	51	the error message gave the wrong output (Sartak)
12	52
13	53	0.78 Tue, May 12, 2009
14	54	* Moose::Cookbook::FAQ and Moose::Cookbook::WTF

+6

-1

MANIFEST less more

79	79	lib/Moose/Meta/Role/Application/ToRole.pm
80	80	lib/Moose/Meta/Role/Composite.pm
81	81	lib/Moose/Meta/Role/Method.pm
	82	lib/Moose/Meta/Role/Method/Conflicting.pm
82	83	lib/Moose/Meta/Role/Method/Required.pm
83	84	lib/Moose/Meta/TypeCoercion.pm
84	85	lib/Moose/Meta/TypeCoercion/Union.pm

280	281	t/100_bugs/021_DEMOLISHALL_shortcutted.t
281	282	t/100_bugs/022_role_caller.t
282	283	t/100_bugs/023_DEMOLISH_fails_without_metaclass.t
	284	t/100_bugs/024_anon_method_metaclass.t
	285	t/100_bugs/025_universal_methods_wrappable.t
	286	t/100_bugs/026_create_anon_recursion.t
283	287	t/200_examples/001_example.t
284	288	t/200_examples/002_example_Moose_POOP.t
285	289	t/200_examples/003_example.t

300	304	t/300_immutable/011_constructor_is_wrapped.t
301	305	t/300_immutable/012_default_values.t
302	306	t/300_immutable/013_immutable_roundtrip.t
	307	t/300_immutable/014_immutable_metaclass_with_traits.t
303	308	t/400_moose_util/001_moose_util.t
304	309	t/400_moose_util/002_moose_util_does_role.t
305	310	t/400_moose_util/003_moose_util_search_class_by_role.t

310	315	t/500_test_moose/003_test_moose_has_attribute_ok.t
311	316	t/500_test_moose/004_test_moose_meta_ok.t
312	317	t/600_todo_tests/001_exception_reflects_failed_constraint.t
313		t/600_todo_tests/002_various_role_shit.t
	318	t/600_todo_tests/002_various_role_features.t
314	319	t/600_todo_tests/003_immutable_n_around.t
315	320	t/600_todo_tests/005_moose_and_threads.t
316	321	t/600_todo_tests/006_moose_nonmoose_metatrait_init_order.t

+1

-1

META.yml less more

31	31	perl: 5.8.1
32	32	resources:
33	33	license: http://dev.perl.org/licenses/
34		version: 0.79
	34	version: 0.80

+1

-1

README less more

0		Moose version 0.79
	0	Moose version 0.80
1	1	===========================
2	2
3	3	See the individual module documentation for more information

+1

-1

lib/Moose/Error/Confess.pm less more

2	2	use strict;
3	3	use warnings;
4	4
5		our $VERSION = '0.79';
	5	our $VERSION = '0.80';
6	6	$VERSION = eval $VERSION;
7	7	our $AUTHORITY = 'cpan:STEVAN';
8	8

+1

-1

lib/Moose/Error/Croak.pm less more

2	2	use strict;
3	3	use warnings;
4	4
5		our $VERSION = '0.79';
	5	our $VERSION = '0.80';
6	6	$VERSION = eval $VERSION;
7	7	our $AUTHORITY = 'cpan:STEVAN';
8	8

+1

-1

lib/Moose/Error/Default.pm less more

2	2	use strict;
3	3	use warnings;
4	4
5		our $VERSION = '0.79';
	5	our $VERSION = '0.80';
6	6	$VERSION = eval $VERSION;
7	7	our $AUTHORITY = 'cpan:STEVAN';
8	8

+15

-10

lib/Moose/Exporter.pm less more

2	2	use strict;
3	3	use warnings;
4	4
5		our $VERSION = '0.79';
	5	our $VERSION = '0.80';
6	6	$VERSION = eval $VERSION;
7	7	our $AUTHORITY = 'cpan:STEVAN';
8	8

75	75	sub _follow_also_real {
76	76	my $exporting_package = shift;
77	77
78		die "Package in also ($exporting_package) does not seem to use Moose::Exporter"
79		unless exists $EXPORT_SPEC{$exporting_package};
	78	if (!exists $EXPORT_SPEC{$exporting_package}) {
	79	my $loaded = Class::MOP::is_class_loaded($exporting_package);
	80
	81	die "Package in also ($exporting_package) does not seem to "
	82	. "use Moose::Exporter"
	83	. ($loaded ? "" : " (is it loaded?)");
	84	}
80	85
81	86	my $also = $EXPORT_SPEC{$exporting_package}{also};
82	87

181	186	return sub {
182	187	my $caller = $CALLER;
183	188
184		my $wrapper = $self->_make_wrapper($caller, $sub, $fq_name);
	189	my $wrapper = $self->_curry_wrapper($sub, $fq_name, $caller);
185	190
186	191	my $sub = subname($fq_name => $wrapper);
187	192

191	196	};
192	197	}
193	198
194		sub _make_wrapper {
	199	sub _curry_wrapper {
195	200	my $class = shift;
196		my $caller = shift;
197	201	my $sub = shift;
198	202	my $fq_name = shift;
199
200		my $wrapper = sub { $sub->($caller, @_) };
	203	my @extra = @_;
	204
	205	my $wrapper = sub { $sub->(@extra, @_) };
201	206	if (my $proto = prototype $sub) {
202	207	# XXX - Perl's prototype sucks. Use & to make set_prototype
203		# ignore the fact that we're passing a "provate variable"
	208	# ignore the fact that we're passing "private variables"
204	209	&Scalar::Util::set_prototype($wrapper, $proto);
205	210	}
206	211	return $wrapper;

413	418
414	419	sub has_rw {
415	420	my ($caller, $name, %options) = @_;
416		Class::MOP::Class->initialize($caller)->add_attribute($name,
	421	Class::MOP::class_of($caller)->add_attribute($name,
417	422	is => 'rw',
418	423	%options,
419	424	);

+3

-3

lib/Moose/Manual/Attributes.pod less more

159	159	There are a couple caveats worth mentioning in regards to what
160	160	"required" actually means.
161	161
162		Basically, all it says is that this attribute (C<name>) must be provided
163		to the constructor. It does not say anything about its value, so it
164		could be C<undef>.
	162	Basically, all it says is that this attribute (C<name>) must be provided to
	163	the constructor, or be lazy with either a default or a builder. It does not
	164	say anything about its value, so it could be C<undef>.
165	165
166	166	If you define a clearer method on a required attribute, the clearer
167	167	I<will> work, so even a required attribute can be unset after object

+1

-1

lib/Moose/Manual/Delta.pod less more

184	184	C<< "replace_constructor => 1 >> to C<make_immutable>.
185	185
186	186	If you want to get rid of the warning, pass C<< inline_constructor =>
187		1 >>.
	187	0 >>.
188	188
189	189	=head1 Version 0.62
190	190

+13

-0

lib/Moose/Manual/FAQ.pod less more

279	279	=head3 Can I turn off type constraint checking?
280	280
281	281	Not yet. This option may come in a future release.
	282
	283	=head3 My coercions stopped working with recent Moose, why did you break it?
	284
	285	Moose 0.76 fixed a case where Coercions were being applied even if the original constraint passed. This has caused some edge cases to fail where people were doing something like
	286
	287	subtype Address => as 'Str';
	288	coerce Address => from Str => via { get_address($_) };
	289
	290	Which is not what they intended. The Type Constraint C<Address> is too loose in this case, it is saying that all Strings are Addresses, which is obviously not the case. The solution is to provide a where clause that properly restricts the Type Constraint.
	291
	292	subtype Address => as Str => where { looks_like_address($_) };
	293
	294	This will allow the coercion to apply only to strings that fail to look like an Address.
282	295
283	296	=head2 Roles
284	297

+2

-3

lib/Moose/Meta/Attribute.pm less more

6	6	use Scalar::Util 'blessed', 'weaken';
7	7	use overload ();
8	8
9		our $VERSION = '0.79';
	9	our $VERSION = '0.80';
10	10	our $AUTHORITY = 'cpan:STEVAN';
11	11
12	12	use Moose::Meta::Method::Accessor;

347	347	$class->throw_error("You can not use lazy_build and default for the same attribute ($name)", data => $options)
348	348	if exists $options->{default};
349	349	$options->{lazy} = 1;
350		$options->{required} = 1;
351	350	$options->{builder} \|\|= "_build_${name}";
352	351	if ($name =~ /^_/) {
353	352	$options->{clearer} \|\|= "_clear${name}";

627	626
628	627	return map { $_ => $_ } (
629	628	$role_meta->get_method_list,
630		$role_meta->get_required_method_list
	629	map { $_->name } $role_meta->get_required_method_list,
631	630	);
632	631	}
633	632	}

+1

-1

lib/Moose/Meta/Class/Immutable/Trait.pm less more

4	4
5	5	use Class::MOP;
6	6
7		our $VERSION = '0.79';
	7	our $VERSION = '0.80';
8	8	$VERSION = eval $VERSION;
9	9	our $AUTHORITY = 'cpan:STEVAN';
10	10

+1

-1

lib/Moose/Meta/Class.pm less more

10	10	use List::MoreUtils qw( any all uniq first_index );
11	11	use Scalar::Util 'weaken', 'blessed';
12	12
13		our $VERSION = '0.79';
	13	our $VERSION = '0.80';
14	14	$VERSION = eval $VERSION;
15	15	our $AUTHORITY = 'cpan:STEVAN';
16	16

+1

-1

lib/Moose/Meta/Instance.pm less more

3	3	use strict;
4	4	use warnings;
5	5
6		our $VERSION = '0.79';
	6	our $VERSION = '0.80';
7	7	$VERSION = eval $VERSION;
8	8	our $AUTHORITY = 'cpan:STEVAN';
9	9

+3

-3

lib/Moose/Meta/Method/Accessor.pm less more

3	3	use strict;
4	4	use warnings;
5	5
6		our $VERSION = '0.79';
	6	our $VERSION = '0.80';
7	7	$VERSION = eval $VERSION;
8	8	our $AUTHORITY = 'cpan:STEVAN';
9	9

290	290
291	291	=head1 DESCRIPTION
292	292
293		This class is a subclass of L<Class::MOP::Class::Accessor> that
	293	This class is a subclass of L<Class::MOP::Method::Accessor> that
294	294	provides additional Moose-specific functionality, all of which is
295	295	private.
296	296
297	297	To understand this class, you should read the the
298		L<Class::MOP::Class::Accessor> documentation.
	298	L<Class::MOP::Method::Accessor> documentation.
299	299
300	300	=head1 BUGS
301	301

+1

-1

lib/Moose/Meta/Method/Augmented.pm less more

2	2	use strict;
3	3	use warnings;
4	4
5		our $VERSION = '0.79';
	5	our $VERSION = '0.80';
6	6	$VERSION = eval $VERSION;
7	7	our $AUTHORITY = 'cpan:STEVAN';
8	8

+1

-1

lib/Moose/Meta/Method/Constructor.pm less more

5	5
6	6	use Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr';
7	7
8		our $VERSION = '0.79';
	8	our $VERSION = '0.80';
9	9	our $AUTHORITY = 'cpan:STEVAN';
10	10
11	11	use base 'Moose::Meta::Method',

+1

-1

lib/Moose/Meta/Method/Delegation.pm less more

6	6	use Carp 'confess';
7	7	use Scalar::Util 'blessed', 'weaken';
8	8
9		our $VERSION = '0.79';
	9	our $VERSION = '0.80';
10	10	$VERSION = eval $VERSION;
11	11	our $AUTHORITY = 'cpan:STEVAN';
12	12

+14

-10

lib/Moose/Meta/Method/Destructor.pm less more

5	5
6	6	use Scalar::Util 'blessed', 'weaken';
7	7
8		our $VERSION = '0.79';
	8	our $VERSION = '0.80';
9	9	$VERSION = eval $VERSION;
10	10	our $AUTHORITY = 'cpan:STEVAN';
11	11

56	56	\|\| $self->throw_error(
57	57	"The is_needed method expected a metaclass object as its arugment");
58	58
59		return $metaclass->find_method_by_name('DEMOLISH');
	59	return $metaclass->find_method_by_name("DEMOLISHALL");
60	60	}
61	61
62	62	sub initialize_body {

77	77
78	78	my @DEMOLISH_methods = $self->associated_metaclass->find_all_methods_by_name('DEMOLISH');
79	79
80		return unless @DEMOLISH_methods;
	80	my $source;
	81	if ( @DEMOLISH_methods ) {
	82	$source = 'sub {';
81	83
82		my $source = 'sub {';
	84	my @DEMOLISH_calls;
	85	foreach my $method (@DEMOLISH_methods) {
	86	push @DEMOLISH_calls => '$_[0]->' . $method->{class} . '::DEMOLISH()';
	87	}
83	88
84		my @DEMOLISH_calls;
85		foreach my $method (@DEMOLISH_methods) {
86		push @DEMOLISH_calls => '$_[0]->' . $method->{class} . '::DEMOLISH()';
	89	$source .= join ";\n" => @DEMOLISH_calls;
	90
	91	$source .= ";\n" . '}';
	92	} else {
	93	$source = 'sub { }';
87	94	}
88	95
89		$source .= join ";\n" => @DEMOLISH_calls;
90
91		$source .= ";\n" . '}';
92	96	warn $source if $self->options->{debug};
93	97
94	98	my $code = $self->_compile_code(

+1

-1

lib/Moose/Meta/Method/Overridden.pm less more

2	2	use strict;
3	3	use warnings;
4	4
5		our $VERSION = '0.79';
	5	our $VERSION = '0.80';
6	6	$VERSION = eval $VERSION;
7	7	our $AUTHORITY = 'cpan:STEVAN';
8	8

+1

-1

lib/Moose/Meta/Method.pm less more

2	2	use strict;
3	3	use warnings;
4	4
5		our $VERSION = '0.79';
	5	our $VERSION = '0.80';
6	6	$VERSION = eval $VERSION;
7	7	our $AUTHORITY = 'cpan:STEVAN';
8	8

+17

-11

lib/Moose/Meta/Role/Application/RoleSummation.pm less more

3	3	use warnings;
4	4	use metaclass;
5	5
6		use Scalar::Util 'blessed';
7		use List::MoreUtils qw(uniq);
	6	use Scalar::Util 'blessed';
8	7
9	8	use Moose::Meta::Role::Composite;
10	9
11		our $VERSION = '0.79';
	10	our $VERSION = '0.80';
12	11	$VERSION = eval $VERSION;
13	12	our $AUTHORITY = 'cpan:STEVAN';
14	13

88	87	sub check_required_methods {
89	88	my ($self, $c) = @_;
90	89
91		my %all_required_methods = map { $_ => undef } uniq(map {
92		$_->get_required_method_list
93		} @{$c->get_roles});
	90	my %all_required_methods =
	91	map { $_->name => $_ }
	92	map { $_->get_required_method_list }
	93	@{$c->get_roles};
94	94
95	95	foreach my $role (@{$c->get_roles}) {
96	96	foreach my $required (keys %all_required_methods) {

101	101	}
102	102	}
103	103
104		$c->add_required_methods(keys %all_required_methods);
	104	$c->add_required_methods(values %all_required_methods);
105	105	}
106	106
107	107	sub check_required_attributes {

166	166
167	167	my (%seen, %method_map);
168	168	foreach my $method (@all_methods) {
169		if (exists $seen{$method->{name}}) {
170		if ($seen{$method->{name}}->body != $method->{method}->body) {
171		$c->add_required_methods($method->{name});
	169	my $seen = $seen{$method->{name}};
	170
	171	if ($seen) {
	172	if ($seen->{method}->body != $method->{method}->body) {
	173	$c->add_conflicting_method(
	174	name => $method->{name},
	175	roles => [$method->{role}->name, $seen->{role}->name],
	176	);
	177
172	178	delete $method_map{$method->{name}};
173	179	next;
174	180	}
175	181	}
176	182
177		$seen{$method->{name}} = $method->{method};
	183	$seen{$method->{name}} = $method;
178	184	$method_map{$method->{name}} = $method->{method};
179	185	}
180	186

+20

-4

lib/Moose/Meta/Role/Application/ToClass.pm less more

6	6	use Moose::Util 'english_list';
7	7	use Scalar::Util 'weaken', 'blessed';
8	8
9		our $VERSION = '0.79';
	9	our $VERSION = '0.80';
10	10	$VERSION = eval $VERSION;
11	11	our $AUTHORITY = 'cpan:STEVAN';
12	12

57	57	# attribute accessors. However I am thinking
58	58	# that maybe those are somehow exempt from
59	59	# the require methods stuff.
60		foreach my $required_method_name ($role->get_required_method_list) {
	60	foreach my $required_method ($role->get_required_method_list) {
	61	my $required_method_name = $required_method->name;
61	62
62	63	if (!$class->find_method_by_name($required_method_name)) {
63	64
64	65	next if $self->is_aliased_method($required_method_name);
65	66
66		push @missing, $required_method_name;
	67	push @missing, $required_method;
67	68	}
68	69	}
69	70

71	72
72	73	my $error = '';
73	74
74		if (@missing) {
	75	my @conflicts = grep { $_->isa('Moose::Meta::Role::Method::Conflicting') } @missing;
	76
	77	if (@conflicts) {
	78	my $conflict = $conflicts[0];
	79	my $roles = Moose::Util::english_list( map { q{'} . $_ . q{'} } @{ $conflict->roles } );
	80
	81	$error
	82	.= "Due to a method name conflict in roles "
	83	. $roles
	84	. ", the method '"
	85	. $conflict->name
	86	. "' must be implemented or excluded by '"
	87	. $class->name
	88	. q{'};
	89	}
	90	elsif (@missing) {
75	91	my $noun = @missing == 1 ? 'method' : 'methods';
76	92
77	93	my $list

+1

-1

lib/Moose/Meta/Role/Application/ToInstance.pm less more

5	5
6	6	use Scalar::Util 'blessed';
7	7
8		our $VERSION = '0.79';
	8	our $VERSION = '0.80';
9	9	$VERSION = eval $VERSION;
10	10	our $AUTHORITY = 'cpan:STEVAN';
11	11

+8

-4

lib/Moose/Meta/Role/Application/ToRole.pm less more

5	5
6	6	use Scalar::Util 'blessed';
7	7
8		our $VERSION = '0.79';
	8	our $VERSION = '0.80';
9	9	$VERSION = eval $VERSION;
10	10	our $AUTHORITY = 'cpan:STEVAN';
11	11

34	34
35	35	sub check_required_methods {
36	36	my ($self, $role1, $role2) = @_;
37		foreach my $required_method_name ($role1->get_required_method_list) {
	37	foreach my $required_method ($role1->get_required_method_list) {
	38	my $required_method_name = $required_method->name;
38	39
39	40	next if $self->is_aliased_method($required_method_name);
40	41
41		$role2->add_required_methods($required_method_name)
	42	$role2->add_required_methods($required_method)
42	43	unless $role2->find_method_by_name($required_method_name);
43	44	}
44	45	}

104	105	$role2->get_method($method_name)->body != $role1->get_method($method_name)->body) {
105	106	# method conflicts between roles result
106	107	# in the method becoming a requirement
107		$role2->add_required_methods($method_name);
	108	$role2->add_conflicting_method(
	109	name => $method_name,
	110	roles => [$role1->name, $role2->name],
	111	);
108	112	}
109	113	else {
110	114	# add it, although it could be overridden

+1

-1

lib/Moose/Meta/Role/Application.pm less more

3	3	use warnings;
4	4	use metaclass;
5	5
6		our $VERSION = '0.79';
	6	our $VERSION = '0.80';
7	7	$VERSION = eval $VERSION;
8	8	our $AUTHORITY = 'cpan:STEVAN';
9	9

+1

-1

lib/Moose/Meta/Role/Composite.pm less more

5	5
6	6	use Scalar::Util 'blessed';
7	7
8		our $VERSION = '0.79';
	8	our $VERSION = '0.80';
9	9	$VERSION = eval $VERSION;
10	10	our $AUTHORITY = 'cpan:STEVAN';
11	11

+85

-0

lib/Moose/Meta/Role/Method/Conflicting.pm less more

	0
	1	package Moose::Meta::Role::Method::Conflicting;
	2
	3	use strict;
	4	use warnings;
	5
	6	use base qw(Moose::Meta::Role::Method::Required);
	7
	8	our $VERSION = '0.80';
	9	$VERSION = eval $VERSION;
	10	our $AUTHORITY = 'cpan:STEVAN';
	11
	12	__PACKAGE__->meta->add_attribute('roles' => (
	13	reader => 'roles',
	14	required => 1,
	15	));
	16
	17	1;
	18
	19	__END__
	20
	21	=pod
	22
	23	=head1 NAME
	24
	25	Moose::Meta::Role::Method::Conflicting - A Moose metaclass for conflicting methods in Roles
	26
	27	=head1 DESCRIPTION
	28
	29	=head1 INHERITANCE
	30
	31	C<Moose::Meta::Role::Method::Conflicting> is a subclass of
	32	L<Moose::Meta::Role::Method::Required>.
	33
	34	=head1 METHODS
	35
	36	=over 4
	37
	38	=item B<< Moose::Meta::Role::Method::Conflicting->new(%options) >>
	39
	40	This creates a new type constraint based on the provided C<%options>:
	41
	42	=over 8
	43
	44	=item * name
	45
	46	The method name. This is required.
	47
	48	=item * roles
	49
	50	The list of role names that generated the conflict. This is required.
	51
	52	=back
	53
	54	=item B<< $method->name >>
	55
	56	Returns the conflicting method's name, as provided to the constructor.
	57
	58	=item B<< $method->roles >>
	59
	60	Returns the roles that generated this conflicting method, as provided to the
	61	constructor.
	62
	63	=back
	64
	65	=head1 BUGS
	66
	67	All complex software has bugs lurking in it, and this module is no
	68	exception. If you find a bug please either email me, or add the bug
	69	to cpan-RT.
	70
	71	=head1 AUTHOR
	72
	73	Stevan Little E<lt>stevan@iinteractive.comE<gt>
	74
	75	=head1 COPYRIGHT AND LICENSE
	76
	77	Copyright 2006-2009 by Infinity Interactive, Inc.
	78
	79	L<http://www.iinteractive.com>
	80
	81	This library is free software; you can redistribute it and/or modify
	82	it under the same terms as Perl itself.
	83
	84	=cut

+44

-2

lib/Moose/Meta/Role/Method/Required.pm less more

2	2
3	3	use strict;
4	4	use warnings;
	5	use metaclass;
5	6
6		our $VERSION = '0.79';
	7	use overload '""' => sub { shift->name }, # stringify to method name
	8	fallback => 1;
	9
	10	use base qw(Class::MOP::Object);
	11
	12	our $VERSION = '0.80';
7	13	$VERSION = eval $VERSION;
8	14	our $AUTHORITY = 'cpan:STEVAN';
9	15
10		use base 'Moose::Meta::Role::Method';
	16	# This is not a Moose::Meta::Role::Method because it has no implementation, it
	17	# is just a name
	18
	19	__PACKAGE__->meta->add_attribute('name' => (
	20	reader => 'name',
	21	required => 1,
	22	));
	23
	24	sub new { shift->_new(@_) }
11	25
12	26	1;
13	27

20	34	Moose::Meta::Role::Method::Required - A Moose metaclass for required methods in Roles
21	35
22	36	=head1 DESCRIPTION
	37
	38	=head1 INHERITANCE
	39
	40	C<Moose::Meta::Role::Method::Required> is a subclass of L<Class::MOP::Object>.
	41	It is B<not> a subclass of C<Moose::Meta::Role::Method> since it does not
	42	provide an implementation of the method.
	43
	44	=head1 METHODS
	45
	46	=over 4
	47
	48	=item B<< Moose::Meta::Role::Method::Required->new(%options) >>
	49
	50	This creates a new type constraint based on the provided C<%options>:
	51
	52	=over 8
	53
	54	=item * name
	55
	56	The method name. This is required.
	57
	58	=back
	59
	60	=item B<< $method->name >>
	61
	62	Returns the required method's name, as provided to the constructor.
	63
	64	=back
23	65
24	66	=head1 BUGS
25	67

+1

-1

lib/Moose/Meta/Role/Method.pm less more

3	3	use strict;
4	4	use warnings;
5	5
6		our $VERSION = '0.79';
	6	our $VERSION = '0.80';
7	7	$VERSION = eval $VERSION;
8	8	our $AUTHORITY = 'cpan:STEVAN';
9	9

+65

-15

lib/Moose/Meta/Role.pm less more

9	9	use Sub::Name 'subname';
10	10	use Devel::GlobalDestruction 'in_global_destruction';
11	11
12		our $VERSION = '0.79';
	12	our $VERSION = '0.80';
13	13	$VERSION = eval $VERSION;
14	14	our $AUTHORITY = 'cpan:STEVAN';
15	15
16	16	use Moose::Meta::Class;
17	17	use Moose::Meta::Role::Method;
18	18	use Moose::Meta::Role::Method::Required;
	19	use Moose::Meta::Role::Method::Conflicting;
19	20
20	21	use base 'Class::MOP::Module';
21	22

56	57	attr_reader => 'get_excluded_roles_map' ,
57	58	methods => {
58	59	add => 'add_excluded_roles',
59		get_list => 'get_excluded_roles_list',
	60	get_keys => 'get_excluded_roles_list',
60	61	existence => 'excludes_role',
61	62	}
62	63	},

64	65	name => 'required_methods',
65	66	attr_reader => 'get_required_methods_map',
66	67	methods => {
67		add => 'add_required_methods',
68		remove => 'remove_required_methods',
69		get_list => 'get_required_method_list',
70		existence => 'requires_method',
	68	remove => 'remove_required_methods',
	69	get_values => 'get_required_method_list',
	70	existence => 'requires_method',
71	71	}
72	72	},
73	73	{

75	75	attr_reader => 'get_attribute_map',
76	76	methods => {
77	77	get => 'get_attribute',
78		get_list => 'get_attribute_list',
	78	get_keys => 'get_attribute_list',
79	79	existence => 'has_attribute',
80	80	remove => 'remove_attribute',
81	81	}

97	97	$self->$attr_reader->{$_} = undef foreach @values;
98	98	}) if exists $methods->{add};
99	99
100		$META->add_method($methods->{get_list} => sub {
	100	$META->add_method($methods->{get_keys} => sub {
101	101	my ($self) = @_;
102	102	keys %{$self->$attr_reader};
103		}) if exists $methods->{get_list};
	103	}) if exists $methods->{get_keys};
	104
	105	$META->add_method($methods->{get_values} => sub {
	106	my ($self) = @_;
	107	values %{$self->$attr_reader};
	108	}) if exists $methods->{get_values};
104	109
105	110	$META->add_method($methods->{get} => sub {
106	111	my ($self, $name) = @_;

122	127	'method_metaclass',
123	128	reader => 'method_metaclass',
124	129	default => 'Moose::Meta::Role::Method',
	130	);
	131
	132	$META->add_attribute(
	133	'required_method_metaclass',
	134	reader => 'required_method_metaclass',
	135	default => 'Moose::Meta::Role::Method::Required',
	136	);
	137
	138	$META->add_attribute(
	139	'conflicting_method_metaclass',
	140	reader => 'conflicting_method_metaclass',
	141	default => 'Moose::Meta::Role::Method::Conflicting',
125	142	);
126	143
127	144	## some things don't always fit, so they go here ...

141	158	$attr_desc = { @_ };
142	159	}
143	160	$self->get_attribute_map->{$name} = $attr_desc;
	161	}
	162
	163	sub add_required_methods {
	164	my $self = shift;
	165
	166	for (@_) {
	167	my $method = $_;
	168	if (!blessed($method)) {
	169	$method = $self->required_method_metaclass->new(
	170	name => $method,
	171	);
	172	}
	173	$self->get_required_methods_map->{$method->name} = $method;
	174	}
	175	}
	176
	177	sub add_conflicting_method {
	178	my $self = shift;
	179
	180	my $method;
	181	if (@_ == 1 && blessed($_[0])) {
	182	$method = shift;
	183	}
	184	else {
	185	$method = $self->conflicting_method_metaclass->new(@_);
	186	}
	187
	188	$self->add_required_methods($method);
144	189	}
145	190
146	191	## ------------------------------------------------------------------

600	645	# has 'roles' => (
601	646	# metaclass => 'Collection::Array',
602	647	# reader => 'get_roles',
603		# isa => 'ArrayRef[Moose::Meta::Roles]',
	648	# isa => 'ArrayRef[Moose::Meta::Role]',
604	649	# default => sub { [] },
605	650	# provides => {
606	651	# 'push' => 'add_role',

636	681	# has 'required_methods' => (
637	682	# metaclass => 'Collection::Hash',
638	683	# reader => 'get_required_methods_map',
639		# isa => 'HashRef[Str]',
	684	# isa => 'HashRef[Moose::Meta::Role::Method::Required]',
640	685	# provides => {
641	686	# # not exactly set, or delete since it works for multiple
642	687	# 'set' => 'add_required_methods',

897	942
898	943	Returns true if the role requires the named method.
899	944
900		=item B<< $metarole->add_required_methods(@names >>
901
902		Adds the named methods to the roles list of required methods.
	945	=item B<< $metarole->add_required_methods(@names) >>
	946
	947	Adds the named methods to the role's list of required methods.
903	948
904	949	=item B<< $metarole->remove_required_methods(@names) >>
905	950
906		Removes the named methods to the roles list of required methods.
	951	Removes the named methods from the role's list of required methods.
	952
	953	=item B<< $metarole->add_conflicting_method(%params) >>
	954
	955	Instantiate the parameters as a L<Moose::Meta::Role::Method::Conflicting>
	956	object, then add it to the required method list.
907	957
908	958	=back
909	959

+1

-1

lib/Moose/Meta/TypeCoercion/Union.pm less more

6	6
7	7	use Scalar::Util 'blessed';
8	8
9		our $VERSION = '0.79';
	9	our $VERSION = '0.80';
10	10	$VERSION = eval $VERSION;
11	11	our $AUTHORITY = 'cpan:STEVAN';
12	12

+1

-1

lib/Moose/Meta/TypeCoercion.pm less more

7	7	use Moose::Meta::Attribute;
8	8	use Moose::Util::TypeConstraints ();
9	9
10		our $VERSION = '0.79';
	10	our $VERSION = '0.80';
11	11	$VERSION = eval $VERSION;
12	12	our $AUTHORITY = 'cpan:STEVAN';
13	13

+1

-1

lib/Moose/Meta/TypeConstraint/Class.pm less more

6	6	use Scalar::Util 'blessed';
7	7	use Moose::Util::TypeConstraints ();
8	8
9		our $VERSION = '0.79';
	9	our $VERSION = '0.80';
10	10	$VERSION = eval $VERSION;
11	11	our $AUTHORITY = 'cpan:STEVAN';
12	12

+1

-1

lib/Moose/Meta/TypeConstraint/Enum.pm less more

5	5
6	6	use Moose::Util::TypeConstraints ();
7	7
8		our $VERSION = '0.79';
	8	our $VERSION = '0.80';
9	9	$VERSION = eval $VERSION;
10	10	our $AUTHORITY = 'cpan:STEVAN';
11	11

+1

-1

lib/Moose/Meta/TypeConstraint/Parameterizable.pm less more

3	3	use warnings;
4	4	use metaclass;
5	5
6		our $VERSION = '0.79';
	6	our $VERSION = '0.80';
7	7	$VERSION = eval $VERSION;
8	8	our $AUTHORITY = 'cpan:STEVAN';
9	9

+1

-1

lib/Moose/Meta/TypeConstraint/Parameterized.pm less more

7	7	use Moose::Util::TypeConstraints;
8	8	use Moose::Meta::TypeConstraint::Parameterizable;
9	9
10		our $VERSION = '0.79';
	10	our $VERSION = '0.80';
11	11	$VERSION = eval $VERSION;
12	12	our $AUTHORITY = 'cpan:STEVAN';
13	13

+1

-1

lib/Moose/Meta/TypeConstraint/Registry.pm less more

6	6
7	7	use Scalar::Util 'blessed';
8	8
9		our $VERSION = '0.79';
	9	our $VERSION = '0.80';
10	10	$VERSION = eval $VERSION;
11	11	our $AUTHORITY = 'cpan:STEVAN';
12	12

+1

-1

lib/Moose/Meta/TypeConstraint/Role.pm less more

6	6	use Scalar::Util 'blessed';
7	7	use Moose::Util::TypeConstraints ();
8	8
9		our $VERSION = '0.79';
	9	our $VERSION = '0.80';
10	10	$VERSION = eval $VERSION;
11	11	our $AUTHORITY = 'cpan:STEVAN';
12	12

+1

-1

lib/Moose/Meta/TypeConstraint/Union.pm less more

6	6
7	7	use Moose::Meta::TypeCoercion::Union;
8	8
9		our $VERSION = '0.79';
	9	our $VERSION = '0.80';
10	10	$VERSION = eval $VERSION;
11	11	our $AUTHORITY = 'cpan:STEVAN';
12	12

+1

-1

lib/Moose/Meta/TypeConstraint.pm less more

12	12
13	13	use base qw(Class::MOP::Object);
14	14
15		our $VERSION = '0.79';
	15	our $VERSION = '0.80';
16	16	$VERSION = eval $VERSION;
17	17	our $AUTHORITY = 'cpan:STEVAN';
18	18

+1

-1

lib/Moose/Object.pm less more

10	10	use if ( not our $__mx_is_compiled ), 'Moose::Meta::Class';
11	11	use if ( not our $__mx_is_compiled ), metaclass => 'Moose::Meta::Class';
12	12
13		our $VERSION = '0.79';
	13	our $VERSION = '0.80';
14	14	$VERSION = eval $VERSION;
15	15	our $AUTHORITY = 'cpan:STEVAN';
16	16

+4

-9

lib/Moose/Role.pm less more

5	5
6	6	use Sub::Exporter;
7	7
8		our $VERSION = '0.79';
	8	our $VERSION = '0.80';
9	9	$VERSION = eval $VERSION;
10	10	our $AUTHORITY = 'cpan:STEVAN';
11	11

17	17	use Moose::Util::TypeConstraints;
18	18
19	19	sub extends {
20		croak "Roles do not currently support 'extends'";
	20	croak "Roles do not support 'extends' (you can use 'with' to specialize a role)";
21	21	}
22	22
23	23	sub with {

173	173
174	174	=head1 DESCRIPTION
175	175
176		Role support in Moose is pretty solid at this point. However, the best
177		documentation is still the the test suite. It is fairly safe to assume Perl 6
178		style behavior and then either refer to the test suite, or ask questions on
179		#moose if something doesn't quite do what you expect.
180
181		We are planning writing some more documentation in the near future, but nothing
182		is ready yet, sorry.
	176	The concept of roles is documented in L<Moose::Manual::Role>. This document
	177	serves as API documentation.
183	178
184	179	=head1 EXPORTED FUNCTIONS
185	180

+1

-4

lib/Moose/Util/MetaRole.pm less more

2	2	use strict;
3	3	use warnings;
4	4
5		our $VERSION = '0.79';
	5	our $VERSION = '0.80';
6	6	$VERSION = eval $VERSION;
7	7	our $AUTHORITY = 'cpan:STEVAN';
8	8

151	151
152	152	=head1 DESCRIPTION
153	153
154		B<The whole concept behind this module is still considered
155		experimental, and it could go away in the future!>
156
157	154	This utility module is designed to help authors of Moose extensions
158	155	write extensions that are able to cooperate with other Moose
159	156	extensions. To do this, you must write your extensions as roles, which

+1

-1

lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm less more

5	5	use Class::MOP;
6	6	use Scalar::Util 'blessed', 'looks_like_number';
7	7
8		our $VERSION = '0.79';
	8	our $VERSION = '0.80';
9	9	$VERSION = eval $VERSION;
10	10	our $AUTHORITY = 'cpan:STEVAN';
11	11

+2

-2

lib/Moose/Util/TypeConstraints.pm less more

5	5	use Scalar::Util qw( blessed reftype );
6	6	use Moose::Exporter;
7	7
8		our $VERSION = '0.79';
	8	our $VERSION = '0.80';
9	9	$VERSION = eval $VERSION;
10	10	our $AUTHORITY = 'cpan:STEVAN';
11	11

505	505	my $type = find_type_constraint($type_name);
506	506	( defined $type )
507	507	\|\| __PACKAGE__->_throw_error(
508		"Cannot find type '$type_name', perhaps you forgot to load it.");
	508	"Cannot find type '$type_name', perhaps you forgot to load it");
509	509	if ( $type->has_coercion ) {
510	510	$type->coercion->add_type_coercions(@$coercion_map);
511	511	}

+1

-1

lib/Moose/Util.pm less more

7	7	use Scalar::Util 'blessed';
8	8	use Class::MOP 0.60;
9	9
10		our $VERSION = '0.79';
	10	our $VERSION = '0.80';
11	11	$VERSION = eval $VERSION;
12	12	our $AUTHORITY = 'cpan:STEVAN';
13	13

+8

-6

lib/Moose.pm less more

2	2
3	3	use 5.008;
4	4
5		our $VERSION = '0.79';
	5	our $VERSION = '0.80';
6	6	$VERSION = eval $VERSION;
7	7	our $AUTHORITY = 'cpan:STEVAN';
8	8

66	66	my $name = shift;
67	67
68	68	Moose->throw_error('Usage: has \'name\' => ( key => value, ... )')
69		if @_ == 1;
	69	if @_ % 2 == 1;
70	70
71	71	my %options = ( definition_context => _caller_info(), @_ );
72	72	my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ];

208	208	my $method_meta = $class->meta;
209	209
210	210	( blessed($method_meta) && $method_meta->isa('Moose::Meta::Class') )
211		\|\| Moose->throw_error("$class already has a &meta function, but it does not return a Moose::Meta::Class ($meta)");
	211	\|\| Moose->throw_error("$class already has a &meta function, but it does not return a Moose::Meta::Class ($method_meta)");
212	212
213	213	$meta = $method_meta;
214	214	}

263	263	Moose::Meta::Role
264	264	Moose::Meta::Role::Method
265	265	Moose::Meta::Role::Method::Required
	266	Moose::Meta::Role::Method::Conflicting
266	267
267	268	Moose::Meta::Role::Composite
268	269

436	437
437	438	=item I<required =E<gt> (1\|0)>
438	439
439		This marks the attribute as being required. This means a I<defined> value must be
440		supplied during class construction, and the attribute may never be set to
441		C<undef> with an accessor.
	440	This marks the attribute as being required. This means a value must be
	441	supplied during class construction, I<or> the attribute must be lazy
	442	and have either a default or a builder. Note that c<required> does not
	443	say anything about the attribute's value, which can be C<undef>.
442	444
443	445	=item I<weak_ref =E<gt> (1\|0)>
444	446

+1

-1

lib/Test/Moose.pm less more

7	7
8	8	use Moose::Util 'does_role', 'find_meta';
9	9
10		our $VERSION = '0.79';
	10	our $VERSION = '0.80';
11	11	$VERSION = eval $VERSION;
12	12	our $AUTHORITY = 'cpan:STEVAN';
13	13

+1

-1

lib/oose.pm less more

4	4
5	5	use Class::MOP;
6	6
7		our $VERSION = '0.79';
	7	our $VERSION = '0.80';
8	8	$VERSION = eval $VERSION;
9	9	our $AUTHORITY = 'cpan:STEVAN';
10	10

+13

-2

t/020_attributes/012_misc_attribute_tests.t less more

214	214	my $_foo_attr = $meta->get_attribute("_foo");
215	215
216	216	ok($foo_attr->is_lazy, "foo is lazy");
217		ok($foo_attr->is_required, "foo is required");
218	217	ok($foo_attr->is_lazy_build, "foo is lazy_build");
219	218
220	219	ok($foo_attr->has_clearer, "foo has clearer");

227	226	is($foo_attr->predicate, "has_foo", ".. and it's named has_foo");
228	227
229	228	ok($_foo_attr->is_lazy, "_foo is lazy");
230		ok($_foo_attr->is_required, "_foo is required");
	229	ok(!$_foo_attr->is_required, "lazy_build attributes are no longer automatically required");
231	230	ok($_foo_attr->is_lazy_build, "_foo is lazy_build");
232	231
233	232	ok($_foo_attr->has_clearer, "_foo has clearer");

261	260
262	261	ok(OutOfClassTest->meta->get_attribute('foo'), 'attr created from sub call');
263	262	ok(OutOfClassTest->meta->get_attribute('bar'), 'attr created from can');
	263
	264
	265	{
	266	{
	267	package Foo;
	268	use Moose;
	269
	270	::throws_ok { has 'foo' => ( 'ro', isa => 'Str' ) }
	271	qr/^Usage/, 'has throws error with odd number of attribute options';
	272	}
	273
	274	}

+26

-4

t/030_roles/005_role_conflict_detection.t less more

2	2	use strict;
3	3	use warnings;
4	4
5		use Test::More tests => 87; # it's really 124 with kolibrie's tests;
	5	use Test::More tests => 88;
6	6	use Test::Exception;
7	7
8	8	=pod

99	99
100	100	::throws_ok {
101	101	with 'Role::Bling', 'Role::Bling::Bling';
102		} qr/requires the method \'bling\' to be implemented/, '... role methods conflicted and method was required';
	102	} qr/Due to a method name conflict in roles 'Role::Bling' and 'Role::Bling::Bling', the method 'bling' must be implemented or excluded by 'My::Test3'/, '... role methods conflict and method was required';
103	103
104	104	package My::Test4;
105	105	use Moose;

189	189	::throws_ok {
190	190	with 'Role::Boo', 'Role::Boo::Hoo';
191	191	} qr/We have encountered an attribute conflict/,
192		'... role attrs conflicted and method was required';
	192	'... role attrs conflict and method was required';
193	193
194	194	package My::Test8;
195	195	use Moose;

215	215	::throws_ok {
216	216	with 'Role::Boo', 'Role::Boo::Hoo';
217	217	} qr/We have encountered an attribute conflict/,
218		'... role attrs conflicted and cannot be manually disambiguted';
	218	'... role attrs conflict and cannot be manually disambiguted';
219	219
220	220	}
221	221

342	342	is(Role::Reality->meta->get_method('twist')->(),
343	343	'Role::Reality::twist',
344	344	'... the twist method returns the right value');
	345
	346	# Ovid's test case from rt.cpan.org #44
	347	{
	348	package Role1;
	349	use Moose::Role;
	350
	351	sub foo {}
	352	}
	353	{
	354	package Role2;
	355	use Moose::Role;
	356
	357	sub foo {}
	358	}
	359	{
	360	package Conflicts;
	361	use Moose;
	362
	363	::throws_ok {
	364	with qw(Role1 Role2);
	365	} qr/Due to a method name conflict in roles 'Role1' and 'Role2', the method 'foo' must be implemented or excluded by 'Conflicts'/;
	366	}
345	367
346	368	=pod
347	369

+3

-3

t/030_roles/011_overriding.t less more

48	48
49	49	{
50	50	# check that when a role is added to another role
51		# and they conflict and the method they conflicted
	51	# and they conflict and the method they conflict
52	52	# with is then required.
53	53
54	54	package Role::A::Conflict;

63	63
64	64	::throws_ok {
65	65	with 'Role::A::Conflict';
66		} qr/requires.*'bar'/, '... did not fufill the requirement of &bar method';
	66	} qr/Due to a method name conflict in roles 'Role::A' and 'Role::A::Conflict', the method 'bar' must be implemented or excluded by 'Class::A::Conflict'/, '... did not fufill the requirement of &bar method';
67	67
68	68	package Class::A::Resolved;
69	69	use Moose;

180	180
181	181	::throws_ok {
182	182	with qw(Role::I);
183		} qr/requires.*'foo'/, "defining class Class::C fails";
	183	} qr/Due to a method name conflict in roles 'Role::H' and 'Role::J', the method 'foo' must be implemented or excluded by 'Class::C'/, "defining class Class::C fails";
184	184
185	185	sub zot { 'Class::C::zot' }
186	186

+1

-1

t/030_roles/012_method_exclusion_in_composition.t less more

71	71	with 'Foo::Role',
72	72	'Bar::Role' => { excludes => 'foo' },
73	73	'Baz::Role';
74		} qr/\'Foo::Role\\|Bar::Role\\|Baz::Role\' requires the method \'foo\' to be implemented by \'My::Foo::Class::Broken\'/,
	74	} qr/Due to a method name conflict in roles 'Baz::Role' and 'Foo::Role', the method 'foo' must be implemented or excluded by 'My::Foo::Class::Broken'/,
75	75	'... composed our roles correctly';
76	76	}
77	77

+1

-1

t/030_roles/013_method_aliasing_in_composition.t less more

104	104	with 'Foo::Role' => { alias => { 'foo' => 'foo_foo' }, excludes => 'foo' },
105	105	'Bar::Role' => { alias => { 'foo' => 'foo_foo' }, excludes => 'foo' },
106	106	'Baz::Role';
107		} qr/\'Foo::Role\\|Bar::Role\\|Baz::Role\' requires the method \'foo_foo\' to be implemented by \'My::Foo::Class::Broken\'/,
	107	} qr/Due to a method name conflict in roles 'Bar::Role' and 'Foo::Role', the method 'foo_foo' must be implemented or excluded by 'My::Foo::Class::Broken'/,
108	108	'... composed our roles correctly';
109	109	}
110	110

+4

-2

t/030_roles/032_roles_and_method_cloning.t less more

2	2	use strict;
3	3	use warnings;
4	4
5		use Test::More tests => 16;
	5	use Test::More tests => 17;
6	6
7	7
8	8	{

70	70	'original fq name is Role::Foo::foo' );
71	71	}
72	72
73		is( ClassB->foo, 'ClassB::foo', 'ClassB::foo knows its name' );
	73	isnt( ClassA->foo, "ClassB::foo", "ClassA::foo is not confused with ClassB::foo");
	74
74	75	{
75	76	local $TODO =
76	77	"multiply-consumed roles' subs take on their most recently used name";
	78	is( ClassB->foo, 'ClassB::foo', 'ClassB::foo knows its name' );
77	79	is( ClassA->foo, 'ClassA::foo', 'ClassA::foo knows its name' );
78	80	}

+24

-3

t/050_metaclasses/012_moose_exporter.t less more

7	7	BEGIN {
8	8	eval "use Test::Output;";
9	9	plan skip_all => "Test::Output is required for this test" if $@;
10		plan tests => 45;
	10	plan tests => 47;
11	11	}
12	12
13	13

215	215	}
216	216
217	217	{
218		package MooseX::CircularAlso;
	218	package MooseX::NoAlso;
219	219
220	220	use Moose ();
221	221

230	230
231	231	::like(
232	232	$@,
233		qr/\QPackage in also (NoSuchThing) does not seem to use Moose::Exporter/,
	233	qr/\QPackage in also (NoSuchThing) does not seem to use Moose::Exporter (is it loaded?) at /,
	234	'got the expected error from a reference in also to a package which is not loaded'
	235	);
	236	}
	237
	238	{
	239	package MooseX::NotExporter;
	240
	241	use Moose ();
	242
	243	::dies_ok(
	244	sub {
	245	Moose::Exporter->setup_import_methods(
	246	also => [ 'Moose::Meta::Method' ],
	247	);
	248	},
	249	'a package which does not use Moose::Exporter in also dies with an error'
	250	);
	251
	252	::like(
	253	$@,
	254	qr/\QPackage in also (Moose::Meta::Method) does not seem to use Moose::Exporter at /,
234	255	'got the expected error from a reference in also to a package which does not use Moose::Exporter'
235	256	);
236	257	}

+7

-3

t/100_bugs/022_role_caller.t less more

10	10
11	11	package main;
12	12
13		use Test::More tests => 2;
	13	use Test::More tests => 4;
14	14
15	15	{
16		local $TODO = 'for rafl';
	16	local $TODO = 'Role composition does not clone methods yet';
17	17	is(MyClass1->foo, 'MyClass1::foo',
18	18	'method from role has correct name in caller()');
	19	is(MyClass2->foo, 'MyClass2::foo',
	20	'method from role has correct name in caller()');
19	21	}
20		is(MyClass2->foo, 'MyClass2::foo');
	22
	23	isnt(MyClass1->foo, "MyClass2::foo", "role method is not confused with other class" );
	24	isnt(MyClass2->foo, "MyClass1::foo", "role method is not confused with other class" );

+50

-0

t/100_bugs/024_anon_method_metaclass.t less more

	0	use strict;
	1	use warnings;
	2	use Test::More tests => 10;
	3
	4	{
	5	package Ball;
	6	use Moose;
	7	}
	8
	9	{
	10	package Arbitrary::Roll;
	11	use Moose::Role;
	12	}
	13
	14	my $method_meta = Moose::Meta::Class->create_anon_class(
	15	superclasses => ['Moose::Meta::Method'],
	16	roles => ['Arbitrary::Roll'],
	17	);
	18
	19	# For comparing identity without actually keeping $original_meta around
	20	my $original_meta = "$method_meta";
	21
	22	my $method_class = $method_meta->name;
	23
	24	my $method_object = $method_class->wrap(
	25	sub {'ok'},
	26	associated_metaclass => Ball->meta,
	27	package_name => 'Ball',
	28	name => 'bounce',
	29	);
	30
	31	Ball->meta->add_method( bounce => $method_object );
	32
	33	for ( 1, 2 ) {
	34	is( Ball->bounce, 'ok', "method still exists on Ball" );
	35	is( Ball->meta->get_method('bounce')->meta->name, $method_class,
	36	"method's package still exists" );
	37
	38	is( Ball->meta->get_method('bounce'), $method_object,
	39	'original method object is preserved' );
	40
	41	local $TODO = "method metaclass seems to be reinitialized" if !$method_meta;
	42
	43	is( Ball->meta->get_method('bounce')->meta . '', $original_meta,
	44	"method's metaclass still exists" );
	45	ok( Ball->meta->get_method('bounce')->meta->does_role('Arbitrary::Roll'),
	46	"method still does Arbitrary::Roll" );
	47
	48	undef $method_meta;
	49	}

+29

-0

t/100_bugs/025_universal_methods_wrappable.t less more

	0	use strict;
	1	use warnings;
	2
	3	use Test::Exception;
	4	use Test::More tests => 2;
	5
	6	{
	7
	8	package FakeBar;
	9	use Moose::Role;
	10
	11	around isa => sub {
	12	my ( $orig, $self, $v ) = @_;
	13	return 1 if $v eq 'Bar';
	14	return $orig->( $self, $v );
	15	};
	16
	17	package Foo;
	18	use Moose;
	19
	20	use Test::More; # for $TODO
	21
	22	local $TODO = 'UNIVERSAL methods should be wrappable';
	23
	24	::lives_ok { with 'FakeBar' } 'applied role';
	25
	26	my $foo = Foo->new;
	27	::isa_ok $foo, 'Bar';
	28	}

+23

-0

t/100_bugs/026_create_anon_recursion.t less more

	0	use strict;
	1	use warnings;
	2
	3	use Test::More tests => 1;
	4	use Test::Exception;
	5
	6	use Moose::Meta::Class;
	7
	8	$SIG{__WARN__} = sub { die if shift =~ /recurs/ };
	9
	10	TODO:
	11	{
	12	local $TODO
	13	= 'Loading Moose::Meta::Class without loading Moose.pm causes weird problems';
	14
	15	my $meta;
	16	lives_ok {
	17	$meta = Moose::Meta::Class->create_anon_class(
	18	superclasses => [ 'Moose::Object', ],
	19	);
	20	}
	21	'Class is created successfully';
	22	}

+34

-0

t/300_immutable/014_immutable_metaclass_with_traits.t less more

	0	#!/usr/bin/env perl
	1	use strict;
	2	use warnings;
	3	use Test::More tests => 10;
	4
	5	{
	6	package FooTrait;
	7	use Moose::Role;
	8	}
	9	{
	10	package Foo;
	11	use Moose -traits => ['FooTrait'];
	12	}
	13
	14	is(Class::MOP::class_of('Foo'), Foo->meta,
	15	"class_of and ->meta are the same on Foo");
	16	my $meta = Foo->meta;
	17	is(Class::MOP::class_of($meta), $meta->meta,
	18	"class_of and ->meta are the same on Foo's metaclass");
	19	isa_ok(Class::MOP::class_of($meta), 'Moose::Meta::Class');
	20	isa_ok($meta->meta, 'Moose::Meta::Class');
	21	Foo->meta->make_immutable;
	22	is(Class::MOP::class_of('Foo'), Foo->meta,
	23	"class_of and ->meta are the same on Foo (immutable)");
	24	$meta = Foo->meta;
	25	isa_ok($meta->meta, 'Moose::Meta::Class');
	26	ok(Class::MOP::class_of($meta)->is_immutable, "metaclass is immutable");
	27	TODO: {
	28	local $TODO = "immutable metaclasses with traits do weird things";
	29	is(Class::MOP::class_of($meta), $meta->meta,
	30	"class_of and ->meta are the same on Foo's metaclass (immutable)");
	31	isa_ok(Class::MOP::class_of($meta), 'Moose::Meta::Class');
	32	ok($meta->meta->is_immutable, "metaclass is immutable");
	33	}

+281

-0

t/600_todo_tests/002_various_role_features.t less more

	0	#!/usr/bin/perl
	1
	2	use strict;
	3	use warnings;
	4
	5	use Test::More tests => 39;
	6	use Test::Exception;
	7
	8	sub req_or_has ($$) {
	9	my ( $role, $method ) = @_;
	10	local $Test::Builder::Level = $Test::Builder::Level + 1;
	11	if ( $role ) {
	12	ok(
	13	$role->has_method($method) \|\| $role->requires_method($method),
	14	$role->name . " has or requires method $method"
	15	);
	16	} else {
	17	fail("role has or requires method $method");
	18	}
	19	}
	20
	21	{
	22	package Bar;
	23	use Moose::Role;
	24
	25	# this role eventually adds three methods, qw(foo bar xxy), but only one is
	26	# known when it's still a role
	27
	28	has foo => ( is => "rw" );
	29
	30	has gorch => ( reader => "bar" );
	31
	32	sub xxy { "BAAAD" }
	33
	34	package Gorch;
	35	use Moose::Role;
	36
	37	# similarly this role gives attr and gorch_method
	38
	39	has attr => ( is => "rw" );
	40
	41	sub gorch_method { "gorch method" }
	42
	43	around dandy => sub { shift->(@_) . "bar" };
	44
	45	package Quxx;
	46	use Moose;
	47
	48	sub dandy { "foo" }
	49
	50	# this object will be used in an attr of Foo to test that Foo can do the
	51	# Gorch interface
	52
	53	with qw(Gorch);
	54
	55	package Dancer;
	56	use Moose::Role;
	57
	58	requires "twist";
	59
	60	package Dancer::Ballerina;
	61	use Moose;
	62
	63	with qw(Dancer);
	64
	65	sub twist { }
	66
	67	sub pirouette { }
	68
	69	package Dancer::Robot;
	70	use Moose::Role;
	71
	72	# this doesn't fail but it produces a requires in the role
	73	# the order doesn't matter
	74	has twist => ( is => "rw" );
	75	::lives_ok { with qw(Dancer) };
	76
	77	package Dancer::Something;
	78	use Moose;
	79
	80	# this fail even though the method already exists
	81
	82	has twist => ( is => "rw" );
	83
	84	{
	85	::lives_ok { with qw(Dancer) };
	86	}
	87
	88	package Dancer::80s;
	89	use Moose;
	90
	91	# this should pass because ::Robot has the attribute to fill in the requires
	92	# but due to the deferrence logic that doesn't actually work
	93	{
	94	local our $TODO = "attribute accessor in role doesn't satisfy role requires";
	95	::lives_ok { with qw(Dancer::Robot) };
	96	}
	97
	98	package Foo;
	99	use Moose;
	100
	101	with qw(Bar);
	102
	103	has oink => (
	104	is => "rw",
	105	handles => "Gorch", # should handles take the same arguments as 'with'? Meta::Role::Application::Delegation?
	106	default => sub { Quxx->new },
	107	);
	108
	109	has dancer => (
	110	is => "rw",
	111	does => "Dancer",
	112	handles => "Dancer",
	113	default => sub { Dancer::Ballerina->new },
	114	);
	115
	116	sub foo { 42 }
	117
	118	sub bar { 33 }
	119
	120	sub xxy { 7 }
	121
	122	package Tree;
	123	use Moose::Role;
	124
	125	has bark => ( is => "rw" );
	126
	127	package Dog;
	128	use Moose::Role;
	129
	130	sub bark { warn "woof!" };
	131
	132	package EntPuppy;
	133	use Moose;
	134
	135	{
	136	local our $TODO = "attrs and methods from a role should clash";
	137	::dies_ok { with qw(Tree Dog) }
	138	}
	139	}
	140
	141	# these fail because of the deferral logic winning over actual methods
	142	# this might be tricky to fix due to the 'sub foo {}; has foo => ( )' hack
	143	# we've been doing for a long while, though I doubt people relied on it for
	144	# anything other than fulfilling 'requires'
	145	{
	146	local $TODO = "attributes from role overwrite class methods";
	147	is( Foo->new->foo, 42, "attr did not zap overriding method" );
	148	is( Foo->new->bar, 33, "attr did not zap overriding method" );
	149	}
	150	is( Foo->new->xxy, 7, "method did not zap overriding method" ); # duh
	151
	152	# these pass, simple delegate
	153	# mostly they are here to contrast the next blck
	154	can_ok( Foo->new->oink, "dandy" );
	155	can_ok( Foo->new->oink, "attr" );
	156	can_ok( Foo->new->oink, "gorch_method" );
	157
	158	ok( Foo->new->oink->does("Gorch"), "Quxx does Gorch" );
	159
	160
	161	# these are broken because 'attr' is not technically part of the interface
	162	can_ok( Foo->new, "gorch_method" );
	163	{
	164	local $TODO = "accessor methods from a role are omitted in handles role";
	165	can_ok( Foo->new, "attr" );
	166	}
	167
	168	{
	169	local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class";
	170	ok( Foo->new->does("Gorch"), "Foo does Gorch" );
	171	}
	172
	173
	174	# these work
	175	can_ok( Foo->new->dancer, "pirouette" );
	176	can_ok( Foo->new->dancer, "twist" );
	177
	178	can_ok( Foo->new, "twist" );
	179	ok( !Foo->new->can("pirouette"), "can't pirouette, not part of the iface" );
	180
	181	{
	182	local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class";
	183	ok( Foo->new->does("Dancer") );
	184	}
	185
	186
	187
	188
	189	my $gorch = Gorch->meta;
	190
	191	isa_ok( $gorch, "Moose::Meta::Role" );
	192
	193	ok( $gorch->has_attribute("attr"), "has attribute 'attr'" );
	194
	195	{
	196	local $TODO = "role attribute isn't a meta attribute yet";
	197	isa_ok( $gorch->get_attribute("attr"), "Moose::Meta::Attribute" );
	198	}
	199
	200	req_or_has($gorch, "gorch_method");
	201	ok( $gorch->has_method("gorch_method"), "has_method gorch_method" );
	202	ok( !$gorch->requires_method("gorch_method"), "requires gorch method" );
	203	isa_ok( $gorch->get_method("gorch_method"), "Moose::Meta::Method" );
	204
	205	{
	206	local $TODO = "method modifier doesn't yet create a method requirement or meta object";
	207	req_or_has($gorch, "dandy" );
	208
	209	# this specific test is maybe not backwards compat, but in theory it does
	210	# require that method to exist
	211	ok( $gorch->requires_method("dandy"), "requires the dandy method for the modifier" );
	212	}
	213
	214	{
	215	local $TODO = "attribute related methods are not yet known by the role";
	216	# we want this to be a part of the interface, somehow
	217	req_or_has($gorch, "attr");
	218	ok( $gorch->has_method("attr"), "has_method attr" );
	219	isa_ok( $gorch->get_method("attr"), "Moose::Meta::Method" );
	220	isa_ok( $gorch->get_method("attr"), "Moose::Meta::Method::Accessor" );
	221	}
	222
	223	my $robot = Dancer::Robot->meta;
	224
	225	isa_ok( $robot, "Moose::Meta::Role" );
	226
	227	ok( $robot->has_attribute("twist"), "has attr 'twist'" );
	228
	229	{
	230	local $TODO = "role attribute isn't a meta attribute yet";
	231	isa_ok( $robot->get_attribute("twist"), "Moose::Meta::Attribute" );
	232	}
	233
	234	{
	235	req_or_has($robot, "twist");
	236
	237	local $TODO = "attribute related methods are not yet known by the role";
	238	ok( $robot->has_method("twist"), "has twist method" );
	239	isa_ok( $robot->get_method("twist"), "Moose::Meta::Method" );
	240	isa_ok( $robot->get_method("twist"), "Moose::Meta::Method::Accessor" );
	241	}
	242
	243	__END__
	244
	245	I think Attribute needs to be refactored in some way to better support roles.
	246
	247	There are several possible ways to do this, all of them seem plausible to me.
	248
	249	The first approach would be to change the attribute class to allow it to be
	250	queried about the methods it would install.
	251
	252	Then we instantiate the attribute in the role, and instead of deferring the
	253	arguments, we just make an C<unpack>ish method.
	254
	255	Then we can interrogate the attr when adding it to the role, and generate stub
	256	methods for all the methods it would produce.
	257
	258	A second approach is kinda like the Immutable hack: wrap the attr in an
	259	anonmyous class that disables part of its interface.
	260
	261	A third method would be to create an Attribute::Partial object that would
	262	provide a more role-ish behavior, and to do this independently of the actual
	263	Attribute class.
	264
	265	Something similar can be done for method modifiers, but I think that's even simpler.
	266
	267
	268
	269	The benefits of doing this are:
	270
	271	* Much better introspection of roles
	272
	273	* More correctness in many cases (in my opinion anyway)
	274
	275	* More roles are more usable as interface declarations, without having to split
	276	them into two pieces (one for the interface with a bunch of requires(), and
	277	another for the actual impl with the problematic attrs (and stub methods to
	278	fix the accessors) and method modifiers (dunno if this can even work at all)
	279
	280

+0

-281

~~t/600_todo_tests/002_various_role_shit.t~~ less more

0		#!/usr/bin/perl
1
2		use strict;
3		use warnings;
4
5		use Test::More tests => 39;
6		use Test::Exception;
7
8		sub req_or_has ($$) {
9		my ( $role, $method ) = @_;
10		local $Test::Builder::Level = $Test::Builder::Level + 1;
11		if ( $role ) {
12		ok(
13		$role->has_method($method) \|\| $role->requires_method($method),
14		$role->name . " has or requires method $method"
15		);
16		} else {
17		fail("role has or requires method $method");
18		}
19		}
20
21		{
22		package Bar;
23		use Moose::Role;
24
25		# this role eventually adds three methods, qw(foo bar xxy), but only one is
26		# known when it's still a role
27
28		has foo => ( is => "rw" );
29
30		has gorch => ( reader => "bar" );
31
32		sub xxy { "BAAAD" }
33
34		package Gorch;
35		use Moose::Role;
36
37		# similarly this role gives attr and gorch_method
38
39		has attr => ( is => "rw" );
40
41		sub gorch_method { "gorch method" }
42
43		around dandy => sub { shift->(@_) . "bar" };
44
45		package Quxx;
46		use Moose;
47
48		sub dandy { "foo" }
49
50		# this object will be used in an attr of Foo to test that Foo can do the
51		# Gorch interface
52
53		with qw(Gorch);
54
55		package Dancer;
56		use Moose::Role;
57
58		requires "twist";
59
60		package Dancer::Ballerina;
61		use Moose;
62
63		with qw(Dancer);
64
65		sub twist { }
66
67		sub pirouette { }
68
69		package Dancer::Robot;
70		use Moose::Role;
71
72		# this doesn't fail but it produces a requires in the role
73		# the order doesn't matter
74		has twist => ( is => "rw" );
75		::lives_ok { with qw(Dancer) };
76
77		package Dancer::Something;
78		use Moose;
79
80		# this fail even though the method already exists
81
82		has twist => ( is => "rw" );
83
84		{
85		::lives_ok { with qw(Dancer) };
86		}
87
88		package Dancer::80s;
89		use Moose;
90
91		# this should pass because ::Robot has the attribute to fill in the requires
92		# but due to the deferrence logic that doesn't actually work
93		{
94		local our $TODO = "attribute accessor in role doesn't satisfy role requires";
95		::lives_ok { with qw(Dancer::Robot) };
96		}
97
98		package Foo;
99		use Moose;
100
101		with qw(Bar);
102
103		has oink => (
104		is => "rw",
105		handles => "Gorch", # should handles take the same arguments as 'with'? Meta::Role::Application::Delegation?
106		default => sub { Quxx->new },
107		);
108
109		has dancer => (
110		is => "rw",
111		does => "Dancer",
112		handles => "Dancer",
113		default => sub { Dancer::Ballerina->new },
114		);
115
116		sub foo { 42 }
117
118		sub bar { 33 }
119
120		sub xxy { 7 }
121
122		package Tree;
123		use Moose::Role;
124
125		has bark => ( is => "rw" );
126
127		package Dog;
128		use Moose::Role;
129
130		sub bark { warn "woof!" };
131
132		package EntPuppy;
133		use Moose;
134
135		{
136		local our $TODO = "attrs and methods from a role should clash";
137		::dies_ok { with qw(Tree Dog) }
138		}
139		}
140
141		# these fail because of the deferral logic winning over actual methods
142		# this might be tricky to fix due to the 'sub foo {}; has foo => ( )' hack
143		# we've been doing for a long while, though I doubt people relied on it for
144		# anything other than fulfilling 'requires'
145		{
146		local $TODO = "attributes from role overwrite class methods";
147		is( Foo->new->foo, 42, "attr did not zap overriding method" );
148		is( Foo->new->bar, 33, "attr did not zap overriding method" );
149		}
150		is( Foo->new->xxy, 7, "method did not zap overriding method" ); # duh
151
152		# these pass, simple delegate
153		# mostly they are here to contrast the next blck
154		can_ok( Foo->new->oink, "dandy" );
155		can_ok( Foo->new->oink, "attr" );
156		can_ok( Foo->new->oink, "gorch_method" );
157
158		ok( Foo->new->oink->does("Gorch"), "Quxx does Gorch" );
159
160
161		# these are broken because 'attr' is not technically part of the interface
162		can_ok( Foo->new, "gorch_method" );
163		{
164		local $TODO = "accessor methods from a role are omitted in handles role";
165		can_ok( Foo->new, "attr" );
166		}
167
168		{
169		local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class";
170		ok( Foo->new->does("Gorch"), "Foo does Gorch" );
171		}
172
173
174		# these work
175		can_ok( Foo->new->dancer, "pirouette" );
176		can_ok( Foo->new->dancer, "twist" );
177
178		can_ok( Foo->new, "twist" );
179		ok( !Foo->new->can("pirouette"), "can't pirouette, not part of the iface" );
180
181		{
182		local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class";
183		ok( Foo->new->does("Dancer") );
184		}
185
186
187
188
189		my $gorch = Gorch->meta;
190
191		isa_ok( $gorch, "Moose::Meta::Role" );
192
193		ok( $gorch->has_attribute("attr"), "has attribute 'attr'" );
194
195		{
196		local $TODO = "role attribute isn't a meta attribute yet";
197		isa_ok( $gorch->get_attribute("attr"), "Moose::Meta::Attribute" );
198		}
199
200		req_or_has($gorch, "gorch_method");
201		ok( $gorch->has_method("gorch_method"), "has_method gorch_method" );
202		ok( !$gorch->requires_method("gorch_method"), "requires gorch method" );
203		isa_ok( $gorch->get_method("gorch_method"), "Moose::Meta::Method" );
204
205		{
206		local $TODO = "method modifier doesn't yet create a method requirement or meta object";
207		req_or_has($gorch, "dandy" );
208
209		# this specific test is maybe not backwards compat, but in theory it does
210		# require that method to exist
211		ok( $gorch->requires_method("dandy"), "requires the dandy method for the modifier" );
212		}
213
214		{
215		local $TODO = "attribute related methods are not yet known by the role";
216		# we want this to be a part of the interface, somehow
217		req_or_has($gorch, "attr");
218		ok( $gorch->has_method("attr"), "has_method attr" );
219		isa_ok( $gorch->get_method("attr"), "Moose::Meta::Method" );
220		isa_ok( $gorch->get_method("attr"), "Moose::Meta::Method::Accessor" );
221		}
222
223		my $robot = Dancer::Robot->meta;
224
225		isa_ok( $robot, "Moose::Meta::Role" );
226
227		ok( $robot->has_attribute("twist"), "has attr 'twist'" );
228
229		{
230		local $TODO = "role attribute isn't a meta attribute yet";
231		isa_ok( $robot->get_attribute("twist"), "Moose::Meta::Attribute" );
232		}
233
234		{
235		req_or_has($robot, "twist");
236
237		local $TODO = "attribute related methods are not yet known by the role";
238		ok( $robot->has_method("twist"), "has twist method" );
239		isa_ok( $robot->get_method("twist"), "Moose::Meta::Method" );
240		isa_ok( $robot->get_method("twist"), "Moose::Meta::Method::Accessor" );
241		}
242
243		__END__
244
245		I think Attribute needs to be refactored in some way to better support roles.
246
247		There are several possible ways to do this, all of them seem plausible to me.
248
249		The first approach would be to change the attribute class to allow it to be
250		queried about the methods it would install.
251
252		Then we instantiate the attribute in the role, and instead of deferring the
253		arguments, we just make an C<unpack>ish method.
254
255		Then we can interrogate the attr when adding it to the role, and generate stub
256		methods for all the methods it would produce.
257
258		A second approach is kinda like the Immutable hack: wrap the attr in an
259		anonmyous class that disables part of its interface.
260
261		A third method would be to create an Attribute::Partial object that would
262		provide a more role-ish behavior, and to do this independently of the actual
263		Attribute class.
264
265		Something similar can be done for method modifiers, but I think that's even simpler.
266
267
268
269		The benefits of doing this are:
270
271		* Much better introspection of roles
272
273		* More correctness in many cases (in my opinion anyway)
274
275		* More roles are more usable as interface declarations, without having to split
276		them into two pieces (one for the interface with a bunch of requires(), and
277		another for the actual impl with the problematic attrs (and stub methods to
278		fix the accessors) and method modifiers (dunno if this can even work at all)
279
280

+1

-0

xt/author/pod_spell.t less more

151	151	runtime
152	152	stacktrace
153	153	subclassable
	154	subname
154	155	subtyping
155	156	TODO
156	157	unblessed