Skip to content

Commit

Permalink
Avoid bug with immutable / around new in Moose by using BUILD method …
Browse files Browse the repository at this point in the history
…instead. Test constructing objects in various ways / in various lineages to demonstrate the issue.
  • Loading branch information
bobtfish committed Jul 29, 2008
1 parent d21c4ca commit 144866f
Show file tree
Hide file tree
Showing 3 changed files with 82 additions and 10 deletions.
5 changes: 4 additions & 1 deletion Changes
@@ -1,6 +1,9 @@
0.00300 Jul XX, 2008
- Replace around 'new' with a BUILD method. Faster and avoids Moose
bug with around/immutable and sub-classes.
0.00200 Mar 28, 2008
- Extend BUILDALL to store constructor keys in the obj. hashref
- Minor fix to make sure Adopt doesn't trip PAUSE perms
- Bye bye auto_install.
0.00100 Mar 15, 2008
- Initial Release!
- Initial Release!
16 changes: 7 additions & 9 deletions lib/MooseX/Emulate/Class/Accessor/Fast.pm
Expand Up @@ -2,7 +2,7 @@ package MooseX::Emulate::Class::Accessor::Fast;

use Moose::Role;

our $VERSION = '0.00200';
our $VERSION = '0.00300';

=head1 NAME
Expand All @@ -12,7 +12,7 @@ MooseX::Emulate::Class::Accessor::Fast -
=head1 SYNOPSYS
package MyClass;
Use Moose;
use Moose;
with 'MooseX::Emulate::Class::Accessor::Fast';
Expand Down Expand Up @@ -60,27 +60,25 @@ methods in L<Class::MOP::Attribute>. Example
=head1 METHODS
=head2 new %args
=head2 BUILD $self %args
Extend the default Moose constructor to emulate the behavior of C::A::F and
Change the default Moose class building to emulate the behavior of C::A::F and
store arguments in the instance hashref.
=cut

around new => sub{
my $orig = shift;
my $class = shift;
sub BUILD {
my $self = shift;
my %args;
if (scalar @_ == 1 && defined $_[0] && ref($_[0]) eq 'HASH') {
%args = %{$_[0]};
} else {
%args = @_;
}
my $self = $class->$orig(@_);
my @extra = grep { !exists($self->{$_}) } keys %args;
@{$self}{@extra} = @args{@extra};
return $self;
};
}

=head2 mk_accessors @field_names
Expand Down
71 changes: 71 additions & 0 deletions t/construction.t
@@ -0,0 +1,71 @@
#!perl
use strict;
use Test::More tests => 9;

#1
require_ok("MooseX::Emulate::Class::Accessor::Fast");

{
package MyClass;
use Moose;
with 'MooseX::Emulate::Class::Accessor::Fast';
}

{
package MyClass::MooseChild;
use Moose;
extends 'MyClass';
}

{
package MyClass::ImmutableMooseChild;
use Moose;
extends 'MyClass';
__PACKAGE__->meta->make_immutable;
}

{
package MyClass::TraditionalChild;
use base qw(MyClass);
}

{
package MyImmutableClass;
use Moose;
with 'MooseX::Emulate::Class::Accessor::Fast';
__PACKAGE__->meta->make_immutable;
}

{
package MyImmutableClass::MooseChild;
use Moose;
extends 'MyImmutableClass';
}

{
package MyImmutableClass::ImmutableMooseChild;
use Moose;
extends 'MyImmutableClass';
__PACKAGE__->meta->make_immutable;
}

{
package MyImmutableClass::TraditionalChild;
use base qw(MyImmutableClass);
}

# 2-9
foreach my $class (qw/
MyClass
MyImmutableClass
MyClass::MooseChild
MyClass::ImmutableMooseChild
MyClass::TraditionalChild
MyImmutableClass::MooseChild
MyImmutableClass::ImmutableMooseChild
MyImmutableClass::TraditionalChild
/) {
my $instance = $class->new(foo => 'bar');
is($instance->{foo}, 'bar', $class . " has CAF construction behavior");
}

0 comments on commit 144866f

Please sign in to comment.