Moo like

XS.xs

@@ -35,9 +35,11 @@ CAIXS_install_inherited_accessor(pTHX_ SV* full_name, SV* hash_key, SV* pkg_key,
 
     } else {
         info = CAIXS_install_accessor<ObjectOnly>(aTHX_ full_name, (AccessorOpts)opts);
+        /*
         SV* required = &PL_sv_yes;
         SV* default_val = &PL_sv_undef;
         caixs::meta::install(info.cv, hash_key, required, default_val);
+        */
     }
 
     STRLEN len;
@@ -159,6 +161,19 @@ PPCODE:
     XSRETURN_UNDEF;
 }
 
+void
+test_install_meta(SV* full_name, SV* hash_key, SV* required, SV* default_value)
+PPCODE:
+{
+    STRLEN len;
+    const char* name = SvPV_const(full_name, len);
+    CV* cv = get_cvn_flags(name, len, 0);
+    if (!cv) croak("Can't get cv");
+
+    caixs::meta::install(cv, hash_key, required, default_value);
+    XSRETURN_UNDEF;
+}
+
 MODULE = Class::Accessor::Inherited::XS     PACKAGE = Class::Accessor::Inherited::XS::Constants
 PROTOTYPES: DISABLE
 

meta.cc

@@ -82,12 +82,26 @@ void activate(PackageMeta meta, SV *sv) {
         STRLEN field_len;
         char* field_name = SvPV(field.name, field_len);
 
-        if (field.required == &PL_sv_yes) {
-            SV** ref = hv_fetch(hv, field_name, field_len, 0);
-            if (!ref) croak("key '%s' is required", field_name);
+        if (SvOK(field.default_value)) {
+            SV** value = hv_fetch(hv, field_name, field_len, 0);
+            if (!value) {
+                dSP;
+                PUSHMARK(SP);
+                int count = call_sv(fields->default_value, G_SCALAR | G_NOARGS);
+                SPAGAIN;
+
+                if (count != 1) croak("unexpected return from 'default': %d, expected: 1", count);
+
+                SV* new_val = POPs;
+                SvREFCNT_inc(new_val);
+                SV** ok = hv_store(hv, field_name, field_len, new_val, 0);
+                if (!ok) SvREFCNT_dec(new_val);
+                PUTBACK;
+            }
+        } else if (field.required == &PL_sv_yes) {
+            SV** value = hv_fetch(hv, field_name, field_len, 0);
+            if (!value) croak("key '%s' is required", field_name);
             return;
-        } else if (SvOK(field.default_value)) {
-            // ...
         }
     }
 }

t/xx-mine.t

@@ -1,13 +1,43 @@
 use strict;
 use Test::More;
+use Class::Accessor::Inherited::XS;
+use Class::Accessor::Inherited::XS::Constants;
 
-use Class::Accessor::Inherited::XS {
-    object      => 'foo',
-    constructor => 'new',
+sub install {
+    my ($package, $key, $required, $default) = @_;
+    Class::Accessor::Inherited::XS::install_constructor("${package}::new");
+    Class::Accessor::Inherited::XS::install_object_accessor("${package}::${key}", $key, None);
+    Class::Accessor::Inherited::XS::test_install_meta("${package}::${key}", $key, $required, $default);
+};
+
+subtest "check required" => sub {
+    subtest "required = 1" => sub {
+        my $package = 't::P' . __LINE__;
+        install($package, 'foo', 1, undef);
+        ok (eval { $package->new(foo => 'v'); 1 }, "when required key is supplied, all ok");
+        is (eval { $package->new(k => 'v'); 1 }, undef, "when required key is missing, die");
+        like $@, qr/key 'foo' is required/;
+    };
+
+    subtest "required = 0" => sub {
+        my $package = 't::P' . __LINE__;
+        install($package, 'foo', 0, undef);
+        ok (eval { $package->new(foo => 'v'); 1 }, "when required key is supplied, all ok");
+        ok (eval { $package->new(foo => 'v'); 1 }, "when required key is missing, all ok");
+    };
+};
+
+subtest "check default" => sub {
+    my $default = \"default-value";
+    my $sub = sub { return $$default } ;
+    my $package = 't::P' . __LINE__;
+    install($package, 'foo', 0, $sub);
+    is $package->new(foo => 'v')->{foo}, 'v';
+    is $package->new->{foo}, 'default-value';
+
+    $default = \undef;
+    is $package->new->{foo}, undef;
 };
 
-ok (eval { __PACKAGE__->new(foo => 'v'); 1 }, "when required key is supplied, all ok");
-is (eval { __PACKAGE__->new(k => 'v'); 1 }, undef, "when required key is missing, die");
-like $@, qr/key 'foo' is required/;
 
 done_testing;