set_initial_value and set_value split

diff --git a/Moose.xs b/Moose.xs
index 2807256..6241b9d 100644 (file)
--- 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 (file)
--- 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" );