- 'has' now dies if you don't pass in name
value pairs
- added the 'make_immutable' keyword as a shortcut
- to __PACKAGE__->meta->make_immutable
+ to make_immutable
* Moose::Meta::Class
Moose::Meta::Method::Constructor
package MooseImmutable;
use Moose;
has foo => (is => 'rw');
- __PACKAGE__->meta->make_immutable();
+ make_immutable();
}
{
package MooseImmutable::NoConstructor;
use Moose;
has foo => (is => 'rw');
- __PACKAGE__->meta->make_immutable(inline_constructor => 0);
+ make_immutable(inline_constructor => 0);
}
{
package ClassAccessorFast;
my $type_constraint_obj = $attr->type_constraint;
my $type_constraint_name = $type_constraint_obj && $type_constraint_obj->name;
- my $type_constraint = $type_constraint_obj
- ? $type_constraint_obj->_compiled_type_constraint
- : undef;
+ my $type_constraint = $type_constraint_obj
+ ? $type_constraint_obj->_compiled_type_constraint
+ : undef;
my $sub = eval $code;
confess "Could not create writer for '$attr_name' because $@ \n code: $code" if $@;
$code .= ' ($type_constraint->($default))' .
' || confess "Attribute (" . $attr_name . ") does not pass the type constraint ("' .
' . $type_constraint_name . ") with " . (defined($default) ? overload::StrVal($default) : "undef")' .
- ' if defined($default);' . "\n" .
- ' ' . $slot_access . ' = $default; ' . "\n";
+ ' if defined($default);' . "\n";
+ $code .= ' ' . $self->_inline_init_slot($attr, $inv, $slot_access, '$default') . "\n";
}
else {
- $code .= ' ' . $slot_access . " = undef; \n";
+ $code .= ' ' . $self->_inline_init_slot($attr, $inv, $slot_access, 'undef') . "\n";
}
} else {
if ($attr->has_default) {
- $code .= ' '.$slot_access.' = $attr->default(' . $inv . ');'."\n";
+ $code .= ' ' . $self->_inline_init_slot($attr, $inv, $slot_access, ('$attr->default(' . $inv . ')')) . "\n";
}
elsif ($attr->has_builder) {
- $code .= ' if(my $builder = '.$inv.'->can($attr->builder)){ '."\n".
- ' '.$slot_access.' = '.$inv.'->$builder; '. "\n } else {\n" .
+ $code .= ' if (my $builder = '.$inv.'->can($attr->builder)) { ' . "\n"
+ . ' ' . $self->_inline_init_slot($attr, $inv, $slot_access, ($inv . '->$builder'))
+ . "\n } else {\n" .
' confess(Scalar::Util::blessed('.$inv.')." does not support builder method '.
'\'".$attr->builder."\' for attribute \'" . $attr->name . "\'");'. "\n }";
}
else {
- $code .= ' ' . $slot_access . " = undef; \n";
+ $code .= ' ' . $self->_inline_init_slot($attr, $inv, $slot_access, 'undef') . "\n";
}
}
$code .= "}\n";
return $code;
}
+sub _inline_init_slot {
+ my ($self, $attr, $inv, $slot_access, $value) = @_;
+ if ($attr->has_initializer) {
+ return ('$attr->set_initial_value(' . $inv . ', ' . $value . ');');
+ }
+ else {
+ return ($slot_access . ' = ' . $value . ';');
+ }
+}
sub _inline_store {
my ($self, $instance, $value) = @_;
'$val'
);
}
- push @source => $self->_generate_slot_assignment($attr, '$val');
+ push @source => $self->_generate_slot_assignment($attr, '$val', $index);
push @source => "} else {";
}
('$type_constraints[' . $index . ']'),
'$val'
) if ($is_moose && $attr->has_type_constraint);
- push @source => $self->_generate_slot_assignment($attr, $default);
+ push @source => $self->_generate_slot_assignment($attr, $default, $index);
push @source => '}'; # close - wrap this to avoid my $val overrite warnings
push @source => "}" if defined $attr->init_arg;
'$val'
);
}
- push @source => $self->_generate_slot_assignment($attr, '$val');
+ push @source => $self->_generate_slot_assignment($attr, '$val', $index);
push @source => "}";
}
}
sub _generate_slot_assignment {
- my ($self, $attr, $value) = @_;
- my $source = (
- $self->meta_instance->inline_set_slot_value(
- '$instance',
- ("'" . $attr->name . "'"),
- $value
- ) . ';'
- );
-
- my $is_moose = $attr->isa('Moose::Meta::Attribute'); # XXX FIXME
+ my ($self, $attr, $value, $index) = @_;
+
+ my $source;
+
+ if ($attr->has_initializer) {
+ $source = (
+ '$attrs->[' . $index . ']->set_initial_value($instance, ' . $value . ');'
+ );
+ }
+ else {
+ $source = (
+ $self->meta_instance->inline_set_slot_value(
+ '$instance',
+ ("'" . $attr->name . "'"),
+ $value
+ ) . ';'
+ );
+ }
+
+ my $is_moose = $attr->isa('Moose::Meta::Attribute'); # XXX FIXME
if ($is_moose && $attr->is_weak_ref) {
$source .= (
$self->y(0);
}
- __PACKAGE__->meta->make_immutable(debug => 0);
+ make_immutable(debug => 0);
}{
package Point3D;
use Moose;
$self->{z} = 0;
};
- __PACKAGE__->meta->make_immutable(debug => 0);
+ make_immutable(debug => 0);
}
my $point = Point->new(x => 1, y => 2);
$self->balance($current_balance - $amount);
}
- __PACKAGE__->meta->make_immutable(debug => 0);
+ make_immutable(debug => 0);
}{
package CheckingAccount;
use Moose;
}
};
- __PACKAGE__->meta->make_immutable(debug => 0);
+ make_immutable(debug => 0);
}
my $savings_account = BankAccount->new(balance => 250);
$tree->parent($self) if defined $tree;
};
- __PACKAGE__->meta->make_immutable(debug => 0);
+ make_immutable(debug => 0);
}
my $root = BinaryTree->new(node => 'root');
has 'state' => (is => 'rw', isa => 'USState');
has 'zip_code' => (is => 'rw', isa => 'USZipCode');
- __PACKAGE__->meta->make_immutable(debug => 0);
+ make_immutable(debug => 0);
}{
package Company;
}
};
- __PACKAGE__->meta->make_immutable(debug => 0);
+ make_immutable(debug => 0);
}{
package Person;
$self->last_name;
}
- __PACKAGE__->meta->make_immutable(debug => 0);
+ make_immutable(debug => 0);
}{
package Employee;
super() . ', ' . $self->title
};
- __PACKAGE__->meta->make_immutable(debug => 0);
+ make_immutable(debug => 0);
}
my $ii;
default => sub { HTTP::Headers->new }
);
- __PACKAGE__->meta->make_immutable(debug => 0);
+ make_immutable(debug => 0);
}
my $r = Request->new;
sprintf '$%0.2f USD' => $self->amount
}
- __PACKAGE__->meta->make_immutable(debug => 0);
+ make_immutable(debug => 0);
}
ok(US::Currency->does('Comparable'), '... US::Currency does Comparable');
use strict;
use warnings;
-use Test::More tests => 4;
+use Test::More tests => 21;
use Test::Exception;
BEGIN {
writer => 'set_foo',
initializer => sub {
my ($self, $value, $callback, $attr) = @_;
+
+ ::isa_ok($attr, 'Moose::Meta::Attribute');
+ ::is($attr->name, 'foo', '... got the right name');
+
$callback->($value * 2);
},
);
has 'lazy_foo' => (
- reader => 'get_lazy_foo',
- default => 10,
+ reader => 'get_lazy_foo',
+ lazy => 1,
+ default => 10,
initializer => sub {
my ($self, $value, $callback, $attr) = @_;
+
+ ::isa_ok($attr, 'Moose::Meta::Attribute');
+ ::is($attr->name, 'lazy_foo', '... got the right name');
+
$callback->($value * 2);
},
);
+
+ has 'lazy_foo_w_type' => (
+ reader => 'get_lazy_foo_w_type',
+ isa => 'Int',
+ lazy => 1,
+ default => 20,
+ initializer => sub {
+ my ($self, $value, $callback, $attr) = @_;
+
+ ::isa_ok($attr, 'Moose::Meta::Attribute');
+ ::is($attr->name, 'lazy_foo_w_type', '... got the right name');
+
+ $callback->($value * 2);
+ },
+ );
+
+ has 'lazy_foo_builder' => (
+ reader => 'get_lazy_foo_builder',
+ builder => 'get_foo_builder',
+ initializer => sub {
+ my ($self, $value, $callback, $attr) = @_;
+
+ ::isa_ok($attr, 'Moose::Meta::Attribute');
+ ::is($attr->name, 'lazy_foo_builder', '... got the right name');
+
+ $callback->($value * 2);
+ },
+ );
+
+ has 'lazy_foo_builder_w_type' => (
+ reader => 'get_lazy_foo_builder_w_type',
+ builder => 'get_foo_builder_w_type',
+ initializer => sub {
+ my ($self, $value, $callback, $attr) = @_;
+
+ ::isa_ok($attr, 'Moose::Meta::Attribute');
+ ::is($attr->name, 'lazy_foo_builder_w_type', '... got the right name');
+
+ $callback->($value * 2);
+ },
+ );
+
+ sub get_foo_builder { 100 }
+ sub get_foo_builder_w_type { 1000 }
}
{
my $foo = Foo->new(foo => 10);
isa_ok($foo, 'Foo');
- is($foo->get_foo, 20, 'initial value set to 2x given value');
- is($foo->get_lazy_foo, 20, 'initial lazy value set to 2x given value');
+ is($foo->get_foo, 20, 'initial value set to 2x given value');
+ is($foo->get_lazy_foo, 20, 'initial lazy value set to 2x given value');
+ is($foo->get_lazy_foo_w_type, 40, 'initial lazy value with type set to 2x given value');
+ is($foo->get_lazy_foo_builder, 200, 'initial lazy value with builder set to 2x given value');
+ is($foo->get_lazy_foo_builder_w_type, 2000, 'initial lazy value with builder and type set to 2x given value');
+}
+
+{
+ package Bar;
+ use Moose;
+
+ has 'foo' => (
+ reader => 'get_foo',
+ writer => 'set_foo',
+ initializer => sub {
+ my ($self, $value, $callback, $attr) = @_;
+
+ ::isa_ok($attr, 'Moose::Meta::Attribute');
+ ::is($attr->name, 'foo', '... got the right name');
+
+ $callback->($value * 2);
+ },
+ );
+
+ make_immutable;
}
+{
+ my $bar = Bar->new(foo => 10);
+ isa_ok($bar, 'Bar');
+
+ is($bar->get_foo, 20, 'initial value set to 2x given value');
+}
+
+
+
+
sub boo { 'BarClass::boo' }
sub foo { 'BarClass::foo' } # << the role overrides this ...
- __PACKAGE__->meta->make_immutable(debug => 0);
+ make_immutable(debug => 0);
}{
package FooClass;
sub goo { 'FooClass::goo' } # << overrides the one from the role ...
- __PACKAGE__->meta->make_immutable(debug => 0);
+ make_immutable(debug => 0);
}{
package FooBarClass;
return $class->meta->new_object('__INSTANCE__' => $super, @_);
}
- __PACKAGE__->meta->make_immutable(debug => 0);
+ make_immutable(debug => 0);
package Bucket;
use metaclass 'Class::MOP::Class';
sub baz { 'Foo::baz' }
- __PACKAGE__->meta->make_immutable(debug => 0);
+ make_immutable(debug => 0);
}
my $foo = Foo->new;