From: Yuval Kogman Date: Tue, 19 Aug 2008 19:49:16 +0000 (+0000) Subject: moose X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4c6fbfb1a882a0fc85735be5d9bd1337f9e3379f;p=gitmo%2FMoose.git moose --- diff --git a/Moose.xs b/Moose.xs index bc7974f..50696e2 100644 --- 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 --- 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);