sub _immutable_options {
my ( $self, @args ) = @_;
- return (
+ $self->{_immutable_options} ||= {
inline_accessors => 1,
inline_constructor => 1,
inline_destructor => 0,
constructor_name => $self->constructor_name,
constructor_class => $self->constructor_class,
destructor_class => $self->destructor_class,
+ };
+ $self->{_immutable_options} = {
+ %{ $self->{_immutable_options} },
@args,
- );
+ };
+
+ return %{ $self->{_immutable_options} };
}
sub make_immutable {
my ( $self, @args ) = @_;
if ( $self->is_mutable ) {
- $self->_initialize_immutable( $self->_immutable_options(@args) );
- $self->_rebless_as_immutable(@args);
+ $self->_immutable_options(@args);
+ $self->_initialize_immutable;
+ $self->_rebless_as_immutable;
return $self;
}
else {
}
sub _rebless_as_immutable {
- my ( $self, @args ) = @_;
+ my ( $self ) = @_;
$self->{__immutable}{original_class} = ref $self;
- bless $self => $self->_immutable_metaclass(@args);
+ bless $self => $self->_immutable_metaclass(
+ %{ $self->{_immutable_options} }
+ );
}
sub _immutable_metaclass {
}
sub _initialize_immutable {
- my ( $self, %args ) = @_;
+ my ( $self ) = @_;
- $self->{__immutable}{options} = \%args;
- $self->_install_inlined_code(%args);
+ $self->{__immutable}{options} = $self->{_immutable_options};
+ $self->_install_inlined_code(%{ $self->{_immutable_options} });
}
sub _install_inlined_code {
$meta->make_mutable;
$meta->make_immutable;
-{ local $TODO = "make_immutable doesn't save options yet";
ok($meta->has_method('foo'),
"constructor is generated with correct name by default after roundtrip");
ok(!$meta->has_method('new'),
"constructor is not generated with incorrect name by default after roundtrip");
-}