moose

diff --git a/Moose.xs b/Moose.xs
index bc7974f..50696e2 100644 (file)
--- a/Moose.xs
+++ b/Moose.xs
@@ -87,52 +87,49 @@ STATIC SV *get_stashed_in_mg(pTHX_ SV *sv) {
     return NULL;
 }
 
-
+/* this is a enum of checks */
 typedef enum {
-    Any = 0,
-    Item,
-        Bool,
-        Maybe, /* [`a] */
-        Undef,
-        Defined,
-            Value,
-                Num,
-                    Int,
-                Str,
-                    ClassName,
-            Ref,
-                ScalarRef,
-                ArrayRef, /* [`a] */
-                HashRef, /* [`a] */
-                CodeRef,
-                RegexpRef,
-                GlobRef,
-                    FileHandle,
-                Object,
-                    Role,
-
-    /* XS only types */
-    Class,
-
-    max_TC
+    Any, /* or item, or bool */
+    Undef,
+    Defined,
+    Str, /* or value */
+    Num,
+    Int,
+    GlobRef, /* SVt_PVGV */
+    ArrayRef, /* SVt_PVAV */
+    HashRef, /* SVt_PVHV */
+    CodeRef, /* SVt_PVCV */
+    Ref,
+    ScalarRef,
+    FileHandle,
+    RegexpRef,
+    Object,
+    /* complex checks */
+    Role,
+    ClassName,
+    Enum,
 } TC;
 
-typedef union {
-    TC type;
-    CV *cv;
-    HV *stash;
-    OP *op;
-} TC_CHECK;
-
 typedef enum {
     tc_none = 0,
     tc_type,
     tc_cv,
-    tc_stash,
     tc_op,
+    tc_stash,
+    tc_classname,
+    tc_fptr,
 } tc_kind;
 
 typedef union {
+    TC type;
+    CV *cv;
+    OP *op;
+    HV *stash;
+    char *classname;
+    bool (*fptr)(pTHX_ SV *type_constraint, SV *sv);
+} TC_CHECK;
+
+typedef union {
     char *builder;
     SV *value;
     CV *sub;
@@ -245,6 +242,152 @@ typedef struct mi {
 } MI;
 
 
+
+
+STATIC bool check_is_scalar_ref(SV *sv) {
+    if( SvROK(sv) ) {
+        switch (SvTYPE(SvRV(sv))) {
+            case SVt_IV:
+            case SVt_NV:
+            case SVt_PV:
+            case SVt_NULL:
+                return 1;
+                break;
+            default:
+                return 0;
+        }
+    }
+    return 0;
+}
+
+STATIC bool check_reftype(TC type, SV *sv) {
+    int svt;
+
+    if ( !SvROK(sv) )
+        return 0;
+
+    switch (type) {
+        case GlobRef:
+            svt = SVt_PVGV;
+            break;
+        case ArrayRef:
+            svt = SVt_PVAV;
+            break;
+        case HashRef:
+            svt = SVt_PVHV;
+            break;
+        case CodeRef:
+            svt = SVt_PVCV;
+            break;
+    }
+
+    return SvTYPE(sv) == svt;
+}
+
+STATIC bool check_sv_class (pTHX_ HV *stash, SV *sv) {
+    dSP;
+    bool ret;
+
+    if (!sv)
+        return 0;
+    SvGETMAGIC(sv);
+    if (!SvROK(sv))
+        return 0;
+    sv = (SV*)SvRV(sv);
+    if (!SvOBJECT(sv))
+        return 0;
+    if (SvSTASH(sv) == stash)
+        return 1;
+
+    ENTER;
+    SAVETMPS;
+    PUSHMARK(SP);
+    XPUSHs(sv);
+    XPUSHs(newSVpv(HvNAME_get(SvSTASH(sv)), 0));
+    PUTBACK;
+
+    call_method("isa", G_SCALAR);
+
+    SPAGAIN;
+    ret = SvTRUE(TOPs);
+
+    FREETMPS;
+    LEAVE;
+
+    return ret;
+}
+
+STATIC bool check_sv_type (TC type, SV *sv) {
+    if (!sv)
+        return 0;
+    switch (type) {
+        case Any:
+            return 1;
+            break;
+        case Undef:
+            return !SvOK(sv);
+            break;
+        case Defined:
+            return SvOK(sv);
+            break;
+        case Str:
+            return (SvOK(sv) && !SvROK(sv));
+        case Ref:
+            return SvROK(sv);
+            break;
+        case ScalarRef:
+            return check_is_scalar_ref(sv);
+            break;
+        case ArrayRef:
+        case HashRef:
+        case CodeRef:
+        case GlobRef:
+            return check_reftype(type, sv);
+            break;
+        case Object:
+            return sv_isobject(sv);
+            break;
+        case RegexpRef:
+            return sv_isa(sv, "Regexp");
+            break;
+        case FileHandle:
+            croak("todo");
+            break;
+        default:
+            croak("todo");
+    }
+
+    return 0;
+}
+
+STATIC bool check_sv_type_constraint(pTHX_ tc_kind kind, TC_CHECK tc_check, SV *type_constraint, SV *sv) {
+    switch (kind) {
+        case tc_none:
+            return 1;
+            break;
+        case tc_type:
+            return check_sv_type(tc_check.type, sv);
+            break;
+        case tc_stash:
+            return check_class(aTHX_ tc_check.stash, sv);
+            break;
+        case tc_classname:
+            return ( gv_stashpv(tc_check.classname, 0) != NULL );
+            break;
+        case tc_fptr:
+            return tc_check.fptr(aTHX_ type_constraint, sv);
+            break;
+        case tc_cv:
+        case tc_op:
+            croak("todo");
+            break;
+    }
+
+    croak("todo");
+    return 0;
+}
+
+
 STATIC void init_attr (MI *mi, ATTR *attr, HV *desc) {
     U32 hash;
     STRLEN len;
@@ -455,6 +598,7 @@ STATIC SV *get_slot_value(pTHX_ SV *self, ATTR *attr) {
 
 STATIC void set_slot_value(pTHX_ SV *self, ATTR *attr, SV *value) {
     HE *he;
+    SV *copy;
 
     assert(self);
     assert(SvROK(self));
@@ -462,13 +606,15 @@ STATIC void set_slot_value(pTHX_ SV *self, ATTR *attr, SV *value) {
 
     assert( ATTR_DUMB_INSTANCE(attr) );
 
-    SvREFCNT_inc(value);
+    copy = newSVsv(value);
+
+    he = hv_store_ent((HV*)SvRV(self), attr->slot_sv, copy, attr->slot_u32);
 
-    he = hv_store_ent((HV*)SvRV(self), attr->slot_sv, value, attr->slot_u32);
     if (he != NULL) {
         if ( ATTR_ISWEAK(attr) )
-            weaken(aTHX_ HeVAL(he)); /* actually only needed once at HE creation time */
+            weaken(aTHX_ HeVAL(he));
     } else {
+        SvREFCNT_dec(copy);
         croak("Hash store failed.");
     }
 }

diff --git a/t/700_xs/001_basic.t b/t/700_xs/001_basic.t
index 284192e..9ea2ef1 100644 (file)
--- a/t/700_xs/001_basic.t
+++ b/t/700_xs/001_basic.t
@@ -52,16 +52,22 @@ ok( defined &Moose::XS::new_predicate );
     has y => ( is => "ro" );
     has z => ( reader => "z", setter => "set_z" );
     has ref => ( is => "rw", weak_ref => 1 );
+    has i => ( isa => "Int", is => "rw" );
+    has s => ( isa => "Str", is => "rw" );
+    has a => ( isa => "ArrayRef", is => "rw" );
 }
 
 {
-    my ( $x, $y, $z, $ref ) = map { Foo->meta->get_attribute($_) } qw(x y z ref);
+    my ( $x, $y, $z, $ref, $a, $s, $i ) = map { Foo->meta->get_attribute($_) } qw(x y z ref a s i);
     $x->Moose::XS::new_accessor("Foo::x");
     $x->Moose::XS::new_predicate("Foo::has_x");
     $y->Moose::XS::new_getter("Foo::y");
     $z->Moose::XS::new_getter("Foo::z");
     $z->Moose::XS::new_setter("Foo::set_z");
     $ref->Moose::XS::new_accessor("Foo::ref");
+    $a->Moose::XS::new_accessor("Foo::a");
+    $s->Moose::XS::new_accessor("Foo::s");
+    $i->Moose::XS::new_accessor("Foo::i");
 }
 
 
@@ -108,5 +114,13 @@ undef $ref;
 
 is( $foo->ref(), undef );
 
+ok( !eval { $foo->a("not a ref"); 1 } );
+ok( !eval { $foo->i(1.3); 1 } );
+ok( !eval { $foo->s(undef); 1 } );
+
+ok( eval { $foo->a([]); 1 } );
+ok( eval { $foo->i(3); 1 } );
+ok( eval { $foo->s("foo"); 1 } );
+
 use Data::Dumper;
 warn Dumper($foo);