--- /dev/null
+package Base;
+use Any::Moose;
+
+has [qw(aaa bbb ccc)] => (
+ is => 'rw',
+);
+
+package D1;
+use Any::Moose;
+extends qw(Base);
+has [qw(ddd eee fff)] => (
+ is => 'rw',
+);
+
+package D2;
+use Any::Moose;
+extends qw(D1);
+has [qw(ggg hhh iii)] => (
+ is => 'rw',
+);
+
+package main;
+use Test::More;
+use Test::Mouse;
+
+with_immutable {
+ my $attrs_list = join ",",
+ map { $_->name } D2->meta->get_all_attributes;
+ is $attrs_list, join ",", qw(aaa bbb ccc ddd eee fff ggg hhh iii);
+} qw(Base D1 D2);
+done_testing;
sub get_read_method_ref{
my($self) = @_;
- return $self->{_read_method_ref}
+ return $self->{_mouse_cache_read_method_ref}
||= $self->_get_accessor_method_ref('get_read_method', '_generate_reader');
}
sub get_write_method_ref{
my($self) = @_;
- return $self->{_write_method_ref}
+ return $self->{_mouse_cache_write_method_ref}
||= $self->_get_accessor_method_ref('get_write_method', '_generate_writer');
}
# remove temporary caches
foreach my $attr(keys %{$args}){
- if($attr =~ /\A _/xms){
+ if($attr =~ /\A _mouse_cache_/xms){
delete $args->{$attr};
}
}
sub has_value {
my($self, $object) = @_;
- my $accessor_ref = $self->{_predicate_ref}
+ my $accessor_ref = $self->{_mouse_cache_predicate_ref}
||= $self->_get_accessor_method_ref('predicate', '_generate_predicate');
return $accessor_ref->($object);
sub clear_value {
my($self, $object) = @_;
- my $accessor_ref = $self->{_crealer_ref}
+ my $accessor_ref = $self->{_mouse_cache_crealer_ref}
||= $self->_get_accessor_method_ref('clearer', '_generate_clearer');
return $accessor_ref->($object);
package Mouse::Meta::Class;
use Mouse::Util qw/:meta/; # enables strict and warnings
-use Scalar::Util qw/blessed weaken/;
+use Scalar::Util ();
use Mouse::Meta::Module;
our @ISA = qw(Mouse::Meta::Module);
}
-sub find_method_by_name{
+sub find_method_by_name {
my($self, $method_name) = @_;
defined($method_name)
or $self->throw_error('You must define a method name to find');
$self->linearized_isa;
}
-sub find_attribute_by_name{
+sub find_attribute_by_name {
my($self, $name) = @_;
- my $attr;
- foreach my $class($self->linearized_isa){
- my $meta = Mouse::Util::get_metaclass_by_name($class) or next;
- $attr = $meta->get_attribute($name) and last;
+ defined($name)
+ or $self->throw_error('You must define an attribute name to find');
+ foreach my $attr($self->get_all_attributes) {
+ return $attr if $attr->name eq $name;
}
- return $attr;
+ return undef;
}
sub add_attribute {
my($attr, $name);
- if(blessed $_[0]){
+ if(Scalar::Util::blessed($_[0])){
$attr = $_[0];
$attr->isa('Mouse::Meta::Attribute')
}
}
- weaken( $attr->{associated_class} = $self );
+ Scalar::Util::weaken( $attr->{associated_class} = $self );
# install accessors first
$attr->install_accessors();
# then register the attribute to the metaclass
- $attr->{insertion_order} = keys %{ $self->{attributes} };
- $self->{attributes}{$attr->name} = $attr;
+ $attr->{insertion_order} = keys %{ $self->{attributes} };
+ $self->{attributes}{$name} = $attr;
+ delete $self->{_mouse_cache}; # clears internal cache
if(!$attr->{associated_methods} && ($attr->{is} || '') ne 'bare'){
Carp::carp(qq{Attribute ($name) of class }.$self->name
.qq{ has no associated methods (did you mean to provide an "is" argument?)});
}
+ return $attr;
+}
- if(!Mouse::Util::MOUSE_XS) {
- # in Mouse::PurePerl, attribute initialization code is cached, so it
- # must be clear here. See _initialize_object() in Mouse::PurePerl.
- delete $self->{_initialize_object};
+sub _calculate_all_attributes {
+ my($self) = @_;
+ my %seen;
+ my @all_attrs;
+ foreach my $class($self->linearized_isa) {
+ my $meta = Mouse::Util::get_metaclass_by_name($class) or next;
+ my @attrs = grep { !$seen{$_->name}++ } values %{$meta->{attributes}};
+ @attrs = sort {
+ $b->{insertion_order} <=> $a->{insertion_order}
+ } @attrs;
+ push @all_attrs, @attrs;
}
- return $attr;
+ return [reverse @all_attrs];
}
sub linearized_isa;
}
elsif(defined $constraint){
$accessor .= "my \$tmp = $value;\n";
-
$accessor .= "\$compiled_type_constraint->(\$tmp)";
$accessor .= " || \$attribute->_throw_type_constraint_error(\$tmp, \$constraint);\n";
$accessor .= "$slot = \$tmp;\n";
my $buildall = $class->_generate_BUILDALL($metaclass);
my $buildargs = $class->_generate_BUILDARGS($metaclass);
- my $initializer = $metaclass->{_initialize_object} ||= do {
+ my $initializer = $metaclass->{_mouse_cache}{_initialize_object} ||=
$class->_generate_initialize_object($metaclass);
- };
my $source = sprintf(<<'EOT', __FILE__, $metaclass->name, $buildargs, $buildall);
#line 1 "%s"
package %s;
package Mouse::Meta::Module;
-use Mouse::Util qw/:meta get_code_package get_code_ref not_supported/; # enables strict and warnings
+use Mouse::Util qw/:meta/; # enables strict and warnings
use Carp ();
use Scalar::Util ();
sub _code_is_mine{
# my($self, $code) = @_;
- return !exists $foreign{ get_code_package($_[1]) };
+ return !exists $foreign{ Mouse::Util::get_code_package($_[1]) };
}
sub add_method;
or $self->throw_error('You must define a method name');
return defined($self->{methods}{$method_name}) || do{
- my $code = get_code_ref($self->{package}, $method_name);
+ my $code = Mouse::Util::get_code_ref($self->{package}, $method_name);
$code && $self->_code_is_mine($code);
};
}
or $self->throw_error('You must define a method name');
return $self->{methods}{$method_name} ||= do{
- my $code = get_code_ref($self->{package}, $method_name);
+ my $code = Mouse::Util::get_code_ref($self->{package}, $method_name);
$code && $self->_code_is_mine($code) ? $code : undef;
};
}
package Mouse::Meta::TypeConstraint;
use Mouse::Util qw(:meta); # enables strict and warnings
-use Scalar::Util ();
sub new {
my $class = shift;
$args{name} = '__ANON__' if !defined $args{name};
- if($args{parent}) {
+ if(defined $args{parent}) {
%args = (%{$args{parent}}, %args);
# a child type must not inherit 'compiled_type_constraint'
# and 'hand_optimized_type_constraint' from the parent
sub _add_type_coercions { # ($self, @pairs)
my $self = shift;
+ if(exists $self->{type_constraints}){ # union type
+ $self->throw_error(
+ "Cannot add additional type coercions to Union types '$self'");
+ }
+
my $coercions = ($self->{coercion_map} ||= []);
my %has = map{ $_->[0] => undef } @{$coercions};
push @{$coercions}, [ $type => $action ];
}
- # compile
- if(exists $self->{type_constraints}){ # union type
- $self->throw_error(
- "Cannot add additional type coercions to Union types");
- }
- else{
- $self->_compile_type_coercion();
- }
+ $self->_compile_type_coercion();
return;
}
sub coerce {
my $self = shift;
-
- my $coercion = $self->_compiled_type_coercion;
- if(!$coercion){
- $self->throw_error("Cannot coerce without a type coercion");
- }
-
return $_[0] if $self->check(@_);
+ my $coercion = $self->{_compiled_type_coercion}
+ or $self->throw_error("Cannot coerce without a type coercion");
return $coercion->(@_);
}
}
}
-sub is_a_type_of{
+sub is_a_type_of {
my($self, $other) = @_;
# ->is_a_type_of('__ANON__') is always false
}
sub _as_string { $_[0]->name } # overload ""
-sub _identity { Scalar::Util::refaddr($_[0]) } # overload 0+
+sub _identity; # overload 0+
sub _unite { # overload infix:<|>
my($lhs, $rhs) = @_;
package Mouse::Util::TypeConstraints;
-use Scalar::Util qw(blessed looks_like_number openhandle);
+use Scalar::Util ();
sub Any { 1 }
sub Item { 1 }
sub Undef { !defined($_[0]) }
sub Defined { defined($_[0]) }
sub Value { defined($_[0]) && !ref($_[0]) }
-sub Num { looks_like_number($_[0]) }
-sub Int {
- my($value) = @_;
- looks_like_number($value) && $value =~ /\A [+-]? [0-9]+ \z/xms;
-}
+sub Num { Scalar::Util::looks_like_number($_[0]) }
sub Str {
+ # We need to use a copy here to flatten MAGICs, for instance as in
+ # Str( substr($_, 0, 42) ).
my($value) = @_;
return defined($value) && ref(\$value) eq 'SCALAR';
}
+sub Int {
+ # We need to use a copy here to save the original internal SV flags.
+ my($value) = @_;
+ return defined($value) && $value =~ /\A -? [0-9]+ \z/xms;
+}
sub Ref { ref($_[0]) }
sub ScalarRef {
sub GlobRef { ref($_[0]) eq 'GLOB' }
sub FileHandle {
- return openhandle($_[0]) || (blessed($_[0]) && $_[0]->isa("IO::Handle"))
+ my($value) = @_;
+ return Scalar::Util::openhandle($value)
+ || (Scalar::Util::blessed($value) && $value->isa("IO::Handle"))
}
-sub Object { blessed($_[0]) && blessed($_[0]) ne 'Regexp' }
+sub Object { Scalar::Util::blessed($_[0]) && ref($_[0]) ne 'Regexp' }
sub ClassName { Mouse::Util::is_class_loaded($_[0]) }
sub RoleName { (Mouse::Util::class_of($_[0]) || return 0)->isa('Mouse::Meta::Role') }
sub linearized_isa { @{ Mouse::Util::get_linear_isa($_[0]->{package}) } }
-sub get_all_attributes {
- my($self) = @_;
- my %attrs = map { %{ $self->initialize($_)->{attributes} } } reverse $self->linearized_isa;
- return values %attrs;
-}
-
sub new_object {
my $meta = shift;
my %args = (@_ == 1 ? %{$_[0]} : @_);
my $object = shift;
my $args = $object->Mouse::Object::BUILDARGS(@_);
- (blessed($object) && $object->isa($class->name))
+ (Scalar::Util::blessed($object) && $object->isa($class->name))
|| $class->throw_error("You must pass an instance of the metaclass (" . $class->name . "), not ($object)");
my $cloned = bless { %$object }, ref $object;
my($self, $object, $args, $is_cloning) = @_;
# The initializer, which is used everywhere, must be clear
# when an attribute is added. See Mouse::Meta::Class::add_attribute.
- my $initializer = $self->{_initialize_object} ||= do {
+ my $initializer = $self->{_mouse_cache}{_initialize_object} ||=
Mouse::Util::load_class($self->constructor_class)
->_generate_initialize_object($self);
- };
goto &{$initializer};
}
+sub get_all_attributes {
+ my($self) = @_;
+ return @{ $self->{_mouse_cache}{all_attributes}
+ ||= $self->_calculate_all_attributes };
+}
+
sub is_immutable { $_[0]->{is_immutable} }
sub strict_constructor;
sub parent { $_[0]->{parent} }
sub message { $_[0]->{message} }
+sub _identity { Scalar::Util::refaddr($_[0]) } # overload 0+
+
sub type_parameter { $_[0]->{type_parameter} }
sub _compiled_type_constraint{ $_[0]->{compiled_type_constraint} }
sub _compiled_type_coercion { $_[0]->{_compiled_type_coercion} }
use Carp qw(confess);
use Scalar::Util qw(blessed);
-use Mouse::Util qw(not_supported);
-use Mouse::Meta::Role;
use Mouse ();
Mouse::Exporter->setup_import_methods(
}
sub excludes {
- not_supported;
+ Mouse::Util::not_supported();
}
sub init_meta{
sub not_supported{
my($feature) = @_;
- $feature ||= ( caller(1) )[3]; # subroutine name
+ $feature ||= ( caller(1) )[3] . '()'; # subroutine name
local $Carp::CarpLevel = $Carp::CarpLevel + 1;
Carp::confess("Mouse does not currently support $feature");
$block->();
$_->meta->make_immutable for @_;
$block->();
+ return if not defined wantarray;
my $num_tests = $Test->current_test - $before;
-
return !grep{ !$_ } ($Test->summary)[-$num_tests .. -1];
}
Tests if a class or object has a certain attribute, similar to what C<can_ok>
does for the methods.
-=back
+=item B<with_immutable { CODE } @class_names>
-=head1 SEE ALSO
-
-=over 4
-
-=item L<Test::More>
+Runs I<CODE> *which should contain normal tests) twice, and make each
+class in I<@class_names> immutable between the two runs.
=back
L<Test::Moose>
+L<Test::More>
+
=cut
writer => 'write_attr',
);
};
-
-ok(!Class->can('x'), "No accessor is injected if 'is' has no value");
-can_ok('Class', 'y', 'z');
-
-has_attribute_ok 'Class', 'x';
-has_attribute_ok 'Class', 'y';
-has_attribute_ok 'Class', 'z';
-
-my $object = Class->new;
-
-ok(!$object->can('x'), "No accessor is injected if 'is' has no value");
-can_ok($object, 'y', 'z');
-
-is($object->y, undef);
-
-throws_ok {
- $object->y(10);
-} qr/Cannot assign a value to a read-only accessor/;
-
-is($object->y, undef);
-
-is($object->z, undef);
-is($object->z(10), 10);
-is($object->z, 10);
-
-can_ok($object, qw(rw_attr read_attr write_attr));
-$object->write_attr(42);
-is $object->rw_attr, 42;
-is $object->read_attr, 42;
-$object->rw_attr(100);
-is $object->rw_attr, 100;
-is $object->read_attr, 100;
-
-is $object->write_attr("piyo"), "piyo";
-is $object->rw_attr("yopi"), "yopi";
-
-dies_ok {
- Class->rw_attr();
-};
-dies_ok {
- Class->read_attr();
-};
-dies_ok {
- Class->write_attr(42);
-};
-
-my @attrs = map { $_->name }
- sort { $a->insertion_order <=> $b->insertion_order } $object->meta->get_all_attributes;
-is join(' ', @attrs), 'x y z attr', 'insertion_order';
-
+with_immutable {
+ ok(!Class->can('x'), "No accessor is injected if 'is' has no value");
+ can_ok('Class', 'y', 'z');
+
+ has_attribute_ok 'Class', 'x';
+ has_attribute_ok 'Class', 'y';
+ has_attribute_ok 'Class', 'z';
+
+ my $object = Class->new;
+
+ ok(!$object->can('x'), "No accessor is injected if 'is' has no value");
+ can_ok($object, 'y', 'z');
+
+ is($object->y, undef);
+
+ throws_ok {
+ $object->y(10);
+ } qr/Cannot assign a value to a read-only accessor/;
+
+ is($object->y, undef);
+
+ is($object->z, undef);
+ is($object->z(10), 10);
+ is($object->z, 10);
+
+ can_ok($object, qw(rw_attr read_attr write_attr));
+ $object->write_attr(42);
+ is $object->rw_attr, 42;
+ is $object->read_attr, 42;
+ $object->rw_attr(100);
+ is $object->rw_attr, 100;
+ is $object->read_attr, 100;
+
+ is $object->write_attr("piyo"), "piyo";
+ is $object->rw_attr("yopi"), "yopi";
+
+ dies_ok {
+ Class->rw_attr();
+ };
+ dies_ok {
+ Class->read_attr();
+ };
+ dies_ok {
+ Class->write_attr(42);
+ };
+
+ my @attrs = map { $_->name }
+ sort { $a->insertion_order <=> $b->insertion_order } $object->meta->get_all_attributes;
+ is join(' ', @attrs), 'x y z attr', 'insertion_order';
+} qw(Class);
done_testing;
#!/usr/bin/env perl
use strict;
use warnings;
-use Test::More tests => 11;
-
+use Test::More;
+use Test::Mouse;
do {
package Class;
use Mouse;
is => 'rw',
isa => 'Bool',
);
-};
-my $obj = Child->new(class => 1, child => 1);
-ok($obj->child, "local attribute set in constructor");
-ok($obj->class, "inherited attribute set in constructor");
-
-is_deeply([sort(Child->meta->get_all_attributes)], [sort(
- Child->meta->get_attribute('child'),
- Class->meta->get_attribute('class'),
-)], "correct get_all_attributes");
+ package CA;
+ use Mouse;
+ extends qw(Class);
+ has ca => (is => 'rw');
+ package CB;
+ use Mouse;
+ extends qw(Class);
+ has cb => (is => 'rw');
+ package CC;
+ use Mouse;
+ extends qw(CB CA);
+ has cc => (is => 'rw');
+};
+with_immutable {
+ my $obj = Child->new(class => 1, child => 1);
+ ok($obj->child, "local attribute set in constructor");
+ ok($obj->class, "inherited attribute set in constructor");
+
+ is_deeply([sort(Child->meta->get_all_attributes)], [sort(
+ Child->meta->get_attribute('child'),
+ Class->meta->get_attribute('class'),
+ )], "correct get_all_attributes");
+
+ is_deeply([sort(CC->meta->get_all_attributes)], [sort(
+ CC->meta->get_attribute('cc'),
+ CB->meta->get_attribute('cb'),
+ CA->meta->get_attribute('ca'),
+ Class->meta->get_attribute('class'),
+ )], "correct get_all_attributes");
+} qw(Class CA CB CC);
do {
package Foo;
);
};
-my $foo = Foo->new;
-is($foo->attr, 'Foo', 'subclass does not affect parent attr');
+with_immutable {
+ my $foo = Foo->new;
+ is($foo->attr, 'Foo', 'subclass does not affect parent attr');
+
+ my $bar = Bar->new;
+ is($bar->attr, undef, 'new attribute does not have the new default');
-my $bar = Bar->new;
-is($bar->attr, undef, 'new attribute does not have the new default');
+ is(Foo->meta->get_attribute('attr')->default, 'Foo');
+ is(Foo->meta->get_attribute('attr')->_is_metadata, 'ro');
-is(Foo->meta->get_attribute('attr')->default, 'Foo');
-is(Foo->meta->get_attribute('attr')->_is_metadata, 'ro');
+ is(Bar->meta->get_attribute('attr')->default, undef);
+ is(Bar->meta->get_attribute('attr')->_is_metadata, 'rw');
-is(Bar->meta->get_attribute('attr')->default, undef);
-is(Bar->meta->get_attribute('attr')->_is_metadata, 'rw');
+ is_deeply([Foo->meta->get_all_attributes], [
+ Foo->meta->get_attribute('attr'),
+ ], "correct get_all_attributes");
-is_deeply([Foo->meta->get_all_attributes], [
- Foo->meta->get_attribute('attr'),
-], "correct get_all_attributes");
+ is_deeply([Bar->meta->get_all_attributes], [
+ Bar->meta->get_attribute('attr'),
+ ], "correct get_all_attributes");
+} qw(Foo Bar);
-is_deeply([Bar->meta->get_all_attributes], [
- Bar->meta->get_attribute('attr'),
-], "correct get_all_attributes");
+done_testing;
static MGVTBL mouse_xc_vtbl; /* for identity */
-static void
-mouse_class_push_attribute_list(pTHX_ SV* const metaclass, AV* const attrall, HV* const seen){
- dSP;
- I32 n;
-
- /* $meta->get_attribute_list */
- PUSHMARK(SP);
- XPUSHs(metaclass);
- PUTBACK;
-
- n = call_sv(mouse_get_attribute_list, G_ARRAY | G_METHOD);
- for(NOOP; n > 0; n--){
- SV* name;
-
- SPAGAIN;
- name = POPs;
- PUTBACK;
-
- if(hv_exists_ent(seen, name, 0U)){
- continue;
- }
- (void)hv_store_ent(seen, name, &PL_sv_undef, 0U);
-
- av_push(attrall, newSVsv( mcall1(metaclass, mouse_get_attribute, name) ));
+static AV*
+mouse_calculate_all_attributes(pTHX_ SV* const metaclass) {
+ SV* const avref = mcall0s(metaclass, "_calculate_all_attributes");
+ if(!(SvROK(avref) && SvTYPE(SvRV(avref)) == SVt_PVAV)) {
+ croak("$meta->_calculate_all_attributes did not return an ARRAY reference");
}
+ return (AV*)SvRV(avref);
}
XS(XS_Mouse__Object_BUILDARGS); /* prototype */
static void
mouse_class_update_xc(pTHX_ SV* const metaclass PERL_UNUSED_DECL, HV* const stash, AV* const xc) {
AV* const linearized_isa = mro_get_linear_isa(stash);
- I32 const len = AvFILLp(linearized_isa);
+ I32 const len = AvFILLp(linearized_isa) + 1;
I32 i;
U32 flags = 0x00;
- AV* const attrall = newAV();
AV* const buildall = newAV();
AV* const demolishall = newAV();
- HV* const seen = newHV(); /* for attributes */
+ AV* attrall;
ENTER;
SAVETMPS;
- sv_2mortal((SV*)seen);
-
/* old data will be delete at the end of the perl scope */
av_delete(xc, MOUSE_XC_DEMOLISHALL, 0x00);
av_delete(xc, MOUSE_XC_BUILDALL, 0x00);
/* update */
+ av_store(xc, MOUSE_XC_BUILDALL, (SV*)buildall);
+ av_store(xc, MOUSE_XC_DEMOLISHALL, (SV*)demolishall);
+
+ attrall = mouse_calculate_all_attributes(aTHX_ metaclass);
+ SvREFCNT_inc_simple_void_NN(attrall);
+ av_store(xc, MOUSE_XC_ATTRALL, (SV*)attrall);
+
if(predicate_calls(metaclass, "is_immutable")){
flags |= MOUSEf_XC_IS_IMMUTABLE;
}
}
av_store(xc, MOUSE_XC_FLAGS, newSVuv(flags));
- av_store(xc, MOUSE_XC_ATTRALL, (SV*)attrall);
- av_store(xc, MOUSE_XC_BUILDALL, (SV*)buildall);
- av_store(xc, MOUSE_XC_DEMOLISHALL, (SV*)demolishall);
for(i = 0; i < len; i++){
SV* const klass = MOUSE_av_at(linearized_isa, i);
HV* const st = gv_stashsv(klass, TRUE);
- SV* meta;
GV* gv;
gv = stash_fetchs(st, "BUILD", FALSE);
if(gv && GvCVu(gv)){
av_push(demolishall, newRV_inc((SV*)GvCV(gv)));
}
-
- /* ATTRIBUTES */
- meta = get_metaclass(klass);
- if(!SvOK(meta)){
- continue; /* skip non-Mouse classes */
- }
-
- mouse_class_push_attribute_list(aTHX_ meta, attrall, seen);
}
FREETMPS;
else{
I32 i;
- args = newHV_mortal();
-
if( (items % 2) != 0 ){
if(!metaclass){ metaclass = get_metaclass(klass); }
mouse_throw_error(metaclass, NULL, "Odd number of parameters to new()");
}
+ args = newHV_mortal();
for(i = 0; i < items; i += 2){
(void)hv_store_ent(args, ST(i), newSVsv(ST(i+1)), 0U);
}
I32 const len = AvFILLp(attrs) + 1;
I32 i;
AV* triggers_queue = NULL;
- U32 used = 0;
+ I32 used = 0;
assert(meta || object);
assert(args);
}
} /* for each attribute */
- if(MOUSE_xc_flags(xc) & MOUSEf_XC_CONSTRUCTOR_IS_STRICT && used < HvUSEDKEYS(args)){
+ if(MOUSE_xc_flags(xc) & MOUSEf_XC_CONSTRUCTOR_IS_STRICT
+ && used < (I32)HvUSEDKEYS(args)){
mouse_report_unknown_args(aTHX_ meta, attrs, args);
}
if(MOUSE_xc_flags(xc) & MOUSEf_XC_IS_ANON){
(void)set_slot(object, newSVpvs_flags("__METACLASS__", SVs_TEMP), meta);
}
-
}
-static SV*
+STATIC_INLINE SV*
mouse_initialize_metaclass(pTHX_ SV* const klass) {
- SV* meta = get_metaclass(klass);
-
- if(!SvOK(meta)){
- meta = mcall1s(newSVpvs_flags("Mouse::Meta::Class", SVs_TEMP), "initialize", klass);
+ SV* const meta = get_metaclass(klass);
+ if(LIKELY(SvOK(meta))){
+ return meta;
}
-
- return meta;
+ return mcall1s(newSVpvs_flags("Mouse::Meta::Class", SVs_TEMP),
+ "initialize", klass);
}
static void
ENTER;
SAVETMPS;
- xa = newAV();
+ xa = newAV();
mg = sv_magicext(SvRV(attr), (SV*)xa, PERL_MAGIC_ext, &mouse_xa_vtbl, NULL, 0);
SvREFCNT_dec(xa); /* refcnt++ in sv_magicext */
"without a default, builder, or an init_arg", name);
}
- /* taken from Mouse::Meta::Attribute->new and ->_process_args */
+ /* taken from Mouse::Meta::Attribute->new and ->_process_args */
svp = hv_fetchs(args, "is", FALSE);
if(svp){
sv_setsv(*svp, name);
}
else if(strEQ(is, "bare")){
- /* do nothing, but don't complain (later) about missing methods */
+ /* do nothing, but might complain later about missing methods */
}
else{
mouse_throw_error(klass, NULL,
code_ref );
}
+UV
+_identity(SV* self, ...)
+CODE:
+{
+ if(!SvROK(self)) {
+ croak("Invalid object instance: '%"SVf"'", self);
+ }
+ RETVAL = PTR2UV(SvRV(self));
+}
+OUTPUT:
+ RETVAL
void
compile_type_constraint(SV* self)
projects / gitmo/Mouse.git / commitdiff