From: Yuval Kogman Date: Fri, 22 Aug 2008 08:30:42 +0000 (+0000) Subject: set_initial_value and set_value split X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7bc5b9a9b9c535b0e0c92049e7d19dd681d3759e;p=gitmo%2FMoose.git set_initial_value and set_value split --- diff --git a/Moose.xs b/Moose.xs index 2807256..6241b9d 100644 --- a/Moose.xs +++ b/Moose.xs @@ -976,7 +976,37 @@ STATIC SV *create_instance(pTHX_ MI *mi) { * * These functions return mortal copiess and save copies (handling refcounting). */ -STATIC void attr_set_value(pTHX_ SV *self, ATTR *attr, SV *value); +STATIC void attr_set_common(pTHX_ SV *self, ATTR *attr, SV *value) { + SV *copy; + + if ( !value ) { + /* FIXME croak if required ? */ + return; + } + + if ( ATTR_TYPE(attr) ) { + if ( !check_type_constraint(aTHX_ ATTR_TYPE(attr), attr->tc_check, attr->type_constraint, value) ) + croak("Bad param"); + } + + copy = newSVsv(value); + + if ( ATTR_ISWEAK(attr) && SvROK(copy) ) + weaken(aTHX_ copy); + + if ( !set_slot_value(aTHX_ self, attr, copy) ) { + SvREFCNT_dec(copy); + croak("Hash store failed."); + } +} + +STATIC void attr_set_initial_value(pTHX_ SV *self, ATTR *attr, SV *value) { + if ( attr->initializer ) { + croak("todo"); + } else { + attr_set_common(aTHX_ self, attr, value); + } +} STATIC SV *call_builder (pTHX_ SV *self, ATTR *attr) { SV *sv; @@ -1041,7 +1071,7 @@ STATIC SV *attr_get_value(pTHX_ SV *self, ATTR *attr) { return sv_mortalcopy(value); } else if ( ATTR_ISLAZY(attr) ) { value = get_default(aTHX_ self, attr); - attr_set_value(aTHX_ self, attr, value); + attr_set_initial_value(aTHX_ self, attr, value); return value; } @@ -1050,26 +1080,27 @@ STATIC SV *attr_get_value(pTHX_ SV *self, ATTR *attr) { /* $attr->set_value($self) */ STATIC void attr_set_value(pTHX_ SV *self, ATTR *attr, SV *value) { - SV *copy; + attr_set_common(aTHX_ self, attr, value); - if ( !value ) { - /* FIXME croak if required ? */ - return; - } + if ( attr->trigger ) { + dSP; - if ( ATTR_TYPE(attr) ) { - if ( !check_type_constraint(aTHX_ ATTR_TYPE(attr), attr->tc_check, attr->type_constraint, value) ) - croak("Bad param"); - } + ENTER; + SAVETMPS; + PUSHMARK(SP); - copy = newSVsv(value); + /* FIXME copy self & meta attr? */ + XPUSHs(self); + XPUSHs(sv_2mortal(newSVsv(value))); + XPUSHs(attr->meta_attr); - if ( ATTR_ISWEAK(attr) && SvROK(copy) ) - weaken(aTHX_ copy); + /* we invoke the builder as a stringified method. This will not work for + * $obj->$coderef etc, for that we need to use 'default' */ + PUTBACK; + call_method(SvPV_nolen(attr->def.sv), G_VOID); - if ( !set_slot_value(aTHX_ self, attr, copy) ) { - SvREFCNT_dec(copy); - croak("Hash store failed."); + FREETMPS; + LEAVE; } } diff --git a/t/700_xs/001_basic.t b/t/700_xs/001_basic.t index 27d3460..b96a6f6 100644 --- a/t/700_xs/001_basic.t +++ b/t/700_xs/001_basic.t @@ -18,6 +18,8 @@ BEGIN { plan 'no_plan'; } +my $i; + { package Moose::XS; @@ -128,6 +130,7 @@ ok( defined &Moose::XS::new_predicate, "new_predicate" ); has c => ( isa => "ClassName", is => "rw" ); has b => ( is => "ro", lazy_build => 1 ); # fixme type constraint checking has tc => ( is => "rw", isa => "FiveChars" ); + has t => ( is => "rw", trigger => sub { $i++ } ); sub _build_b { "builded!" } @@ -147,7 +150,7 @@ ok( defined &Moose::XS::new_predicate, "new_predicate" ); } { - my ( $x, $y, $z, $ref, $a, $s, $i, $o, $f, $c, $b ) = map { Foo->meta->get_attribute($_) } qw(x y z ref a s i o f c b); + my ( $x, $y, $z, $ref, $a, $s, $i, $o, $f, $c, $b, $tc, $t ) = map { Foo->meta->get_attribute($_) } qw(x y z ref a s i o f c b tc t); $x->Moose::XS::new_accessor("Foo::x"); $x->Moose::XS::new_predicate("Foo::has_x"); $y->Moose::XS::new_reader("Foo::y"); @@ -161,6 +164,8 @@ ok( defined &Moose::XS::new_predicate, "new_predicate" ); $f->Moose::XS::new_accessor("Foo::f"); $c->Moose::XS::new_accessor("Foo::c"); $b->Moose::XS::new_accessor("Foo::b"); + $tc->Moose::XS::new_accessor("Foo::tc"); + $t->Moose::XS::new_accessor("Foo::t"); } @@ -207,6 +212,10 @@ is( $foo->ref, $ref, "attr set" ); undef $ref; is( $foo->ref(), undef, "weak ref destroyed" ); +is( $i, undef, "trigger not yet called" ); +is( $foo->t, undef, "no value in t" ); +is( $i, undef, "trigger not yet called" ); + ok( !eval { $foo->a("not a ref"); 1 }, "ArrayRef" ); ok( !eval { $foo->a(3); 1 }, "ArrayRef" ); ok( !eval { $foo->a({}); 1 }, "ArrayRef" );