From: gfx Date: Sun, 25 Oct 2009 08:44:15 +0000 (+0900) Subject: Implement XS accessor generators X-Git-Tag: 0.40_01~17 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=935400114c35ad1b2481c48ff471e180e9c93d93;p=gitmo%2FMouse.git Implement XS accessor generators --- diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index 764abbb..2eb2b6b 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -360,19 +360,16 @@ sub _canonicalize_handles { } } - sub associate_method{ my ($attribute, $method) = @_; $attribute->{associated_methods}++; return; } -sub accessor_metaclass(){ 'Mouse::Meta::Method::Accessor' } - sub install_accessors{ my($attribute) = @_; - my $metaclass = $attribute->{associated_class}; + my $metaclass = $attribute->associated_class; my $accessor_class = $attribute->accessor_metaclass; foreach my $type(qw(accessor reader writer predicate clearer)){ diff --git a/lib/Mouse/Meta/TypeConstraint.pm b/lib/Mouse/Meta/TypeConstraint.pm index 9b1acc7..3eb6eb6 100644 --- a/lib/Mouse/Meta/TypeConstraint.pm +++ b/lib/Mouse/Meta/TypeConstraint.pm @@ -2,7 +2,7 @@ package Mouse::Meta::TypeConstraint; use Mouse::Util qw(:meta); # enables strict and warnings use overload - '""' => sub { shift->{name} }, # stringify to tc name + '""' => sub { $_[0]->name }, # stringify to tc name fallback => 1; use Carp qw(confess); @@ -183,13 +183,11 @@ sub check { sub coerce { my $self = shift; - if(!$self->{_compiled_type_coercion}){ - confess("Cannot coerce without a type coercion ($self)"); - } return $_[0] if $self->_compiled_type_constraint->(@_); - return $self->{_compiled_type_coercion}->(@_); + my $coercion = $self->_compiled_type_coercion; + return $coercion ? $coercion->(@_) : $_[0]; } sub get_message { diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index 2faf498..8644c93 100644 --- a/lib/Mouse/PurePerl.pm +++ b/lib/Mouse/PurePerl.pm @@ -186,6 +186,8 @@ sub has_builder { exists $_[0]->{builder} } sub has_documentation { exists $_[0]->{documentation} } +sub accessor_metaclass(){ 'Mouse::Meta::Method::Accessor' } + package Mouse::Meta::TypeConstraint; @@ -195,10 +197,10 @@ sub message { $_[0]->{message} } sub _compiled_type_constraint{ $_[0]->{compiled_type_constraint} } -sub has_coercion{ exists $_[0]->{_compiled_type_coercion} } +sub _compiled_type_coercion { $_[0]->{_compiled_type_coercion} } -package - Mouse::Meta::Method::Accessor; + +sub has_coercion{ exists $_[0]->{_compiled_type_coercion} } 1; __END__ diff --git a/mouse.h b/mouse.h index 0ebe38c..21e45c3 100644 --- a/mouse.h +++ b/mouse.h @@ -35,6 +35,14 @@ AV* mouse_mro_get_linear_isa(pTHX_ HV* const stash) extern SV* mouse_package; extern SV* mouse_namespace; +void +mouse_throw_error(SV* const metaobject, SV* const data /* not used */, const char* const fmt, ...) +#ifdef __attribute__format__ + __attribute__format__(__printf__, 3, 4); +#else + ; +#endif + #define is_class_loaded(sv) mouse_is_class_loaded(aTHX_ sv) bool mouse_is_class_loaded(pTHX_ SV*); @@ -54,7 +62,25 @@ SV* mouse_call1(pTHX_ SV *const self, SV *const method, SV* const arg1); #define MOUSEf_DIE_ON_FAIL 0x01 MAGIC* mouse_mg_find(pTHX_ SV* const sv, const MGVTBL* const vtbl, I32 const flags); -#define dMOUSE_self SV* const self = mouse_accessor_get_self(aTHX_ ax, items, cv) +/* MOUSE_av_at(av, ix) is the safer version of AvARRAY(av)[ix] if perl is compiled with -DDEBUGGING */ +#ifdef DEBUGGING +#define MOUSE_av_at(av, ix) *mouse_av_at_safe(aTHX_ (av) , (ix)) +SV** mouse_av_at_safe(pTHX_ AV* const mi, I32 const ix); +#else +#define MOUSE_av_at(av, ix) AvARRAY(av)[ix] +#endif + +#define dMOUSE_self SV* const self = mouse_accessor_get_self(aTHX_ ax, items, cv) +SV* mouse_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv); + +#define MOUSE_mg_obj(mg) ((mg)->mg_obj) +#define MOUSE_mg_ptr(mg) ((mg)->mg_ptr) +#define MOUSE_mg_flags(mg) ((mg)->mg_private) +#define MOUSE_mg_virtual(mg) ((mg)->mg_virtual) + +#define MOUSE_mg_slot(mg) MOUSE_mg_obj(mg) +#define MOUSE_mg_xa(mg) ((AV*)MOUSE_mg_ptr(mg)) + /* mouse_instance.xs stuff */ SV* mouse_instance_create (pTHX_ HV* const stash); @@ -80,8 +106,15 @@ CV* mouse_install_simple_accessor(pTHX_ const char* const fq_name, const char* c XS(mouse_xs_simple_reader); XS(mouse_xs_simple_writer); +XS(mouse_xs_simple_clearer); XS(mouse_xs_simple_predicate); +CV* mouse_instantiate_xs_accessor(pTHX_ SV* const attr, XSUBADDR_t const accessor_impl); + +XS(mouse_xs_accessor); +XS(mouse_xs_reader); +XS(mouse_xs_writer); + typedef enum mouse_tc{ MOUSE_TC_ANY, MOUSE_TC_ITEM, diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs index 12bcf89..ed97592 100644 --- a/xs-src/Mouse.xs +++ b/xs-src/Mouse.xs @@ -204,6 +204,9 @@ BOOT: INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_builder, builder); INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_documentation, documentation); + newCONSTSUB(gv_stashpvs("Mouse::Meta::Attribute", TRUE), "accessor_metaclass", + newSVpvs("Mouse::Meta::Method::Accessor::XS")); + MODULE = Mouse PACKAGE = Mouse::Meta::TypeConstraint BOOT: @@ -215,3 +218,64 @@ BOOT: INSTALL_SIMPLE_READER(TypeConstraint, _compiled_type_coercion); /* Mouse specific */ INSTALL_SIMPLE_PREDICATE_WITH_KEY(TypeConstraint, has_coercion, _compiled_type_coercion); + + +MODULE = Mouse PACKAGE = Mouse::Meta::Method::Accessor::XS + +BOOT: +{ + AV* const isa = get_av("Mouse::Meta::Method::Accessor::XS::ISA", TRUE); + av_push(isa, newSVpvs("Mouse::Meta::Method::Accessor")); +} + +CV* +_generate_accessor(klass, SV* attr, metaclass) +CODE: +{ + RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, mouse_xs_accessor); +} +OUTPUT: + RETVAL + +CV* +_generate_reader(klass, SV* attr, metaclass) +CODE: +{ + RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, mouse_xs_reader); +} +OUTPUT: + RETVAL + +CV* +_generate_writer(klass, SV* attr, metaclass) +CODE: +{ + RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, mouse_xs_writer); +} +OUTPUT: + RETVAL + +CV* +_generate_clearer(klass, SV* attr, metaclass) +CODE: +{ + SV* const slot = mcall0s(attr, "name"); + STRLEN len; + const char* const pv = SvPV_const(slot, len); + RETVAL = mouse_install_simple_accessor(aTHX_ NULL, pv, len, mouse_xs_simple_clearer); +} +OUTPUT: + RETVAL + +CV* +_generate_predicate(klass, SV* attr, metaclass) +CODE: +{ + SV* const slot = mcall0s(attr, "name"); + STRLEN len; + const char* const pv = SvPV_const(slot, len); + RETVAL = mouse_install_simple_accessor(aTHX_ NULL, pv, len, mouse_xs_simple_predicate); +} +OUTPUT: + RETVAL + diff --git a/xs-src/mouse_accessor.xs b/xs-src/mouse_accessor.xs new file mode 100644 index 0000000..54c2db6 --- /dev/null +++ b/xs-src/mouse_accessor.xs @@ -0,0 +1,375 @@ +#include "mouse.h" + +/* Moose XS Attribute object */ +enum mouse_xa_ix_t{ + MOUSE_XA_ATTRIBUTE, + MOUSE_XA_TC, + MOUSE_XA_TC_CODE, + + MOUSE_XA_last +}; + +#define MOUSE_xa_attribute(m) MOUSE_av_at(m, MOUSE_XA_ATTRIBUTE) +#define MOUSE_xa_tc(m) MOUSE_av_at(m, MOUSE_XA_TC) +#define MOUSE_xa_tc_code(m) MOUSE_av_at(m, MOUSE_XA_TC_CODE) + +#define MOUSE_mg_attribute(mg) MOUSE_xa_attribute(MOUSE_mg_xa(mg)) + +enum mouse_xa_flags_t{ + MOUSEf_ATTR_HAS_TC = 0x0001, + MOUSEf_ATTR_HAS_DEFAULT = 0x0002, + MOUSEf_ATTR_HAS_BUILDER = 0x0004, + MOUSEf_ATTR_HAS_INITIALIZER = 0x0008, /* not used in Mouse */ + MOUSEf_ATTR_HAS_TRIGGER = 0x0010, + + MOUSEf_ATTR_IS_LAZY = 0x0020, + MOUSEf_ATTR_IS_WEAK_REF = 0x0040, + MOUSEf_ATTR_IS_REQUIRED = 0x0080, + + MOUSEf_ATTR_SHOULD_COERCE = 0x0100, + + MOUSEf_ATTR_SHOULD_AUTO_DEREF + = 0x0200, + MOUSEf_TC_IS_ARRAYREF = 0x0400, + MOUSEf_TC_IS_HASHREF = 0x0800, + + MOUSEf_OTHER1 = 0x1000, + MOUSEf_OTHER2 = 0x2000, + MOUSEf_OTHER3 = 0x4000, + MOUSEf_OTHER4 = 0x8000, + + MOUSEf_MOUSE_MASK = 0xFFFF /* not used */ +}; + +static MGVTBL mouse_accessor_vtbl; /* MAGIC identity */ + +CV* +mouse_instantiate_xs_accessor(pTHX_ SV* const attr, XSUBADDR_t const accessor_impl){ + SV* const slot = mcall0s(attr, "name"); + AV* const xa = newAV(); + CV* xsub; + MAGIC* mg; + U16 flags = 0; + + sv_2mortal((SV*)xa); + + xsub = newXS(NULL, accessor_impl, __FILE__); + sv_2mortal((SV*)xsub); + + mg = sv_magicext((SV*)xsub, slot, PERL_MAGIC_ext, &mouse_accessor_vtbl, (char*)xa, HEf_SVKEY); + + /* NOTE: + * although we use MAGIC for gc, we also store mg to CvXSUBANY for efficiency (gfx) + */ + CvXSUBANY(xsub).any_ptr = (void*)mg; + + av_extend(xa, MOUSE_XA_last - 1); + + av_store(xa, MOUSE_XA_ATTRIBUTE, newSVsv(attr)); + + /* prepare attribute status */ + /* XXX: making it lazy is a good way? */ + + if(SvTRUEx(mcall0s(attr, "has_type_constraint"))){ + SV* tc; + flags |= MOUSEf_ATTR_HAS_TC; + + ENTER; + SAVETMPS; + + tc = mcall0s(attr, "type_constraint"); + av_store(xa, MOUSE_XA_TC, newSVsv(tc)); + + if(SvTRUEx(mcall0s(attr, "should_auto_deref"))){ + flags |= MOUSEf_ATTR_SHOULD_AUTO_DEREF; + if( SvTRUEx(mcall1s(tc, "is_a_type_of", newSVpvs_flags("ArrayRef", SVs_TEMP))) ){ + flags |= MOUSEf_TC_IS_ARRAYREF; + } + else if( SvTRUEx(mcall1s(tc, "is_a_type_of", newSVpvs_flags("HashRef", SVs_TEMP))) ){ + flags |= MOUSEf_TC_IS_HASHREF; + } + else{ + mouse_throw_error(attr, tc, + "Can not auto de-reference the type constraint '%"SVf"'", + mcall0s(tc, "name")); + } + } + + if(SvTRUEx(mcall0s(attr, "should_coerce"))){ + flags |= MOUSEf_ATTR_SHOULD_COERCE; + } + + FREETMPS; + LEAVE; + } + + if(SvTRUEx(mcall0s(attr, "has_trigger"))){ + flags |= MOUSEf_ATTR_HAS_TRIGGER; + } + + if(SvTRUEx(mcall0s(attr, "is_lazy"))){ + flags |= MOUSEf_ATTR_IS_LAZY; + + if(SvTRUEx(mcall0s(attr, "has_builder"))){ + flags |= MOUSEf_ATTR_HAS_BUILDER; + } + else if(SvTRUEx(mcall0s(attr, "has_default"))){ + flags |= MOUSEf_ATTR_HAS_DEFAULT; + } + } + + if(SvTRUEx(mcall0s(attr, "is_weak_ref"))){ + flags |= MOUSEf_ATTR_IS_WEAK_REF; + } + + if(SvTRUEx(mcall0s(attr, "is_required"))){ + flags |= MOUSEf_ATTR_IS_REQUIRED; + } + + MOUSE_mg_flags(mg) = flags; + + return xsub; +} + +static SV* +mouse_apply_type_constraint(pTHX_ AV* const xa, SV* value, U16 const flags){ + SV* const tc = MOUSE_xa_tc(xa); + SV* tc_code; + int ok; + + if(flags & MOUSEf_ATTR_SHOULD_COERCE){ + value = mcall1s(tc, "coerce", value); + } + + if(!SvOK(MOUSE_xa_tc_code(xa))){ + XS(XS_Mouse__Util__TypeConstraints_Item); /* prototype defined in Mouse.xs */ + + tc_code = mcall0s(tc, "_compiled_type_constraint"); + + if(SvROK(tc_code) && SvTYPE(SvRV(tc_code)) + && CvXSUB((CV*)SvRV(tc_code)) == XS_Mouse__Util__TypeConstraints_Item){ + /* built-in type constraints */ + mouse_tc const id = CvXSUBANY((CV*)SvRV(tc_code)).any_i32; + av_store(xa, MOUSE_XA_TC_CODE, newSViv(id)); + } + else{ + av_store(xa, MOUSE_XA_TC_CODE, newSVsv(tc_code)); + } + } + else{ + tc_code = MOUSE_xa_tc_code(xa); + } + + if(SvIOK(tc_code)){ /* built-in type constraints */ + ok = mouse_tc_check(aTHX_ SvIVX(tc_code), value); + } + else { + dSP; + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + XPUSHs(value); + PUTBACK; + + call_sv(tc_code, G_SCALAR); + + SPAGAIN; + ok = SvTRUEx(POPs); + PUTBACK; + + FREETMPS; + LEAVE; + } + + if(!ok){ + mouse_throw_error(MOUSE_xa_attribute(xa), value, + "Attribute (%"SVf") does not pass the type constraint because: %"SVf, + mcall0s(MOUSE_xa_attribute(xa), "name"), + mcall1s(tc, "get_message", value)); + } + + return value; +} + + +/* pushes return values, does auto-deref if needed */ +static void +mouse_push_values(pTHX_ AV* const xa, SV* const value, U16 const flags){ + dSP; + PERL_UNUSED_ARG(xa); + + if(flags & MOUSEf_ATTR_SHOULD_AUTO_DEREF && GIMME_V == G_ARRAY){ + if(!(value && SvOK(value))){ + return; + } + + if(flags & MOUSEf_TC_IS_ARRAYREF){ + AV* const av = (AV*)SvRV(value); + I32 len; + I32 i; + + if(SvTYPE(av) != SVt_PVAV){ + croak("Mouse-panic: Not an ARRAY reference"); + } + + len = av_len(av) + 1; + EXTEND(SP, len); + for(i = 0; i < len; i++){ + SV** const svp = av_fetch(av, i, FALSE); + PUSHs(svp ? *svp : &PL_sv_undef); + } + } + else if(flags & MOUSEf_TC_IS_HASHREF){ + HV* const hv = (HV*)SvRV(value); + HE* he; + + if(SvTYPE(hv) != SVt_PVHV){ + croak("Mouse-panic: Not a HASH reference"); + } + + hv_iterinit(hv); + while((he = hv_iternext(hv))){ + EXTEND(SP, 2); + PUSHs(hv_iterkeysv(he)); + PUSHs(hv_iterval(hv, he)); + } + } + } + else{ + XPUSHs(value ? value : &PL_sv_undef); + } + + PUTBACK; +} + +static void +mouse_attr_get(pTHX_ SV* const self, MAGIC* const mg){ + AV* const xa = MOUSE_mg_xa(mg); + U16 const flags = MOUSE_mg_flags(mg); + SV* const slot = MOUSE_mg_slot(mg); + SV* value; + + value = mouse_instance_get_slot(aTHX_ self, slot); + + /* check_lazy */ + if( !value && flags & MOUSEf_ATTR_IS_LAZY ){ + SV* const attr = MOUSE_xa_attribute(xa); + /* get default value by $attr->default or $attr->builder */ + if(flags & MOUSEf_ATTR_HAS_DEFAULT){ + value = mcall0s(attr, "default"); + + if(SvROK(value) && SvTYPE(SvRV(value)) == SVt_PVCV){ + value = mcall0(self, value); + } + } + else if(flags & MOUSEf_ATTR_HAS_BUILDER){ + SV* const builder = mcall0s(attr, "builder"); + value = mcall0(self, builder); + } + + if(!value){ + value = sv_newmortal(); + } + + /* apply coerce and type constraint */ + if(flags & MOUSEf_ATTR_HAS_TC){ + value = mouse_apply_type_constraint(aTHX_ xa, value, flags); + } + + /* store value to slot */ + value = mouse_instance_set_slot(aTHX_ self, slot, value); + } + + mouse_push_values(aTHX_ xa, value, flags); +} + +static void +mouse_attr_set(pTHX_ SV* const self, MAGIC* const mg, SV* value){ + AV* const xa = MOUSE_mg_xa(mg); + U16 const flags = MOUSE_mg_flags(mg); + SV* const slot = MOUSE_mg_slot(mg); + + if(flags & MOUSEf_ATTR_HAS_TC){ + value = mouse_apply_type_constraint(aTHX_ xa, value, flags); + } + + mouse_instance_set_slot(aTHX_ self, slot, value); + + if(flags & MOUSEf_ATTR_IS_WEAK_REF){ + mouse_instance_weaken_slot(aTHX_ self, slot); + } + + if(flags & MOUSEf_ATTR_HAS_TRIGGER){ + SV* const trigger = mcall0s(MOUSE_xa_attribute(xa), "trigger"); + dSP; + + PUSHMARK(SP); + EXTEND(SP, 2); + PUSHs(self); + PUSHs(value); + + PUTBACK; + call_sv(trigger, G_VOID | G_DISCARD); + /* need not SPAGAIN */ + } + + mouse_push_values(aTHX_ xa, value, flags); +} + +XS(mouse_xs_accessor) +{ + dVAR; dXSARGS; + dMOUSE_self; + MAGIC* const mg = (MAGIC*)XSANY.any_ptr; + + SP -= items; /* PPCODE */ + PUTBACK; + + if(items == 1){ /* reader */ + mouse_attr_get(aTHX_ self, mg); + } + else if (items == 2){ /* writer */ + mouse_attr_set(aTHX_ self, mg, ST(1)); + } + else{ + mouse_throw_error(MOUSE_mg_attribute(mg), NULL, + "Expected exactly one or two argument for an accessor"); + } +} + + +XS(mouse_xs_reader) +{ + dVAR; dXSARGS; + dMOUSE_self; + MAGIC* const mg = (MAGIC*)XSANY.any_ptr; + + if (items != 1) { + mouse_throw_error(MOUSE_mg_attribute(mg), NULL, + "Cannot assign a value to a read-only accessor"); + } + + SP -= items; /* PPCODE */ + PUTBACK; + + mouse_attr_get(aTHX_ self, mg); +} + +XS(mouse_xs_writer) +{ + dVAR; dXSARGS; + dMOUSE_self; + MAGIC* const mg = (MAGIC*)XSANY.any_ptr; + + if (items != 2) { + mouse_throw_error(MOUSE_mg_attribute(mg), NULL, + "Too few arguments for a write-only accessor"); + } + + SP -= items; /* PPCODE */ + PUTBACK; + + mouse_attr_set(aTHX_ self, mg, ST(1)); +} diff --git a/xs-src/mouse_simple_accessor.xs b/xs-src/mouse_simple_accessor.xs index cf835fb..285f3cb 100644 --- a/xs-src/mouse_simple_accessor.xs +++ b/xs-src/mouse_simple_accessor.xs @@ -1,14 +1,14 @@ -#include "mouse.h" - +#include "mouse.h" + static MGVTBL mouse_simple_accessor_vtbl; - + /* static MAGIC* mouse_accessor_get_mg(pTHX_ CV* const xsub){ return moose_mg_find(aTHX_ (SV*)xsub, &mouse_simple_accessor_vtbl, MOOSEf_DIE_ON_FAIL); -} -*/ - +} +*/ + CV* mouse_install_simple_accessor(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSUBADDR_t const accessor_impl){ CV* const xsub = newXS((char*)fq_name, accessor_impl, __FILE__); @@ -24,13 +24,13 @@ mouse_install_simple_accessor(pTHX_ const char* const fq_name, const char* const SvREFCNT_dec(slot); /* sv_magicext() increases refcnt in mg_obj */ /* NOTE: - * although we use MAGIC for gc, we also store slot to CvXSUBANY slot for efficiency (gfx) + * although we use MAGIC for gc, we also store mg to CvXSUBANY for efficiency (gfx) */ - CvXSUBANY(xsub).any_ptr = (void*)slot; + CvXSUBANY(xsub).any_ptr = (void*)mg; return xsub; } - + SV* mouse_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv) { SV* self; @@ -48,18 +48,18 @@ mouse_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv) { croak("Cant call %s as a class method", GvNAME(CvGV(cv))); } return self; -} +} XS(mouse_xs_simple_reader) { - dVAR; dXSARGS; + dVAR; dXSARGS; dMOUSE_self; - SV* const slot = (SV*)XSANY.any_ptr; + SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr); SV* value; if (items != 1) { - croak("Expected exactly one argument"); + croak("Expected exactly one argument for a reader for '%"SVf"'", slot); } value = mouse_instance_get_slot(self, slot); @@ -72,27 +72,42 @@ XS(mouse_xs_simple_writer) { dVAR; dXSARGS; dMOUSE_self; - SV* const slot = (SV*)XSANY.any_ptr; - + SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr); + if (items != 2) { - croak("Expected exactly two argument"); + croak("Expected exactly two argument for a writer for '%"SVf"'", slot); } ST(0) = mouse_instance_set_slot(self, slot, ST(1)); XSRETURN(1); } +XS(mouse_xs_simple_clearer) +{ + dVAR; dXSARGS; + dMOUSE_self; + SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr); + SV* value; + + if (items != 1) { + croak("Expected exactly one argument for a clearer for '%"SVf"'", slot); + } + + value = mouse_instance_delete_slot(aTHX_ self, slot); + ST(0) = value ? value : &PL_sv_undef; + XSRETURN(1); +} XS(mouse_xs_simple_predicate) { dVAR; dXSARGS; dMOUSE_self; - SV* const slot = (SV*)XSANY.any_ptr; - + SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr); + if (items != 1) { - croak("Expected exactly one argument"); + croak("Expected exactly one argument for a predicate for '%"SVf"'", slot); } ST(0) = boolSV( mouse_instance_has_slot(self, slot) ); XSRETURN(1); -} +} diff --git a/xs-src/mouse_util.xs b/xs-src/mouse_util.xs index 9df1f65..f041951 100644 --- a/xs-src/mouse_util.xs +++ b/xs-src/mouse_util.xs @@ -69,6 +69,49 @@ mouse_mro_get_linear_isa(pTHX_ HV* const stash){ } #endif /* !no_mor_get_linear_isa */ +#ifdef DEBUGGING +SV** +mouse_av_at_safe(pTHX_ AV* const av, I32 const ix){ + assert(av); + assert(SvTYPE(av) == SVt_PVAV); + assert(AvMAX(av) >= ix); + return &AvARRAY(av)[ix]; +} +#endif + +void +mouse_throw_error(SV* const metaobject, SV* const data /* not used */, const char* const fmt, ...){ + dTHX; + va_list args; + SV* message; + + PERL_UNUSED_ARG(data); /* for moose-compat */ + + assert(metaobject); + assert(fmt); + + va_start(args, fmt); + message = vnewSVpvf(fmt, &args); + va_end(args); + + { + dSP; + PUSHMARK(SP); + EXTEND(SP, 4); + + PUSHs(metaobject); + mPUSHs(message); + + mPUSHs(newSVpvs("depth")); + mPUSHi(-1); + + PUTBACK; + + call_method("throw_error", G_VOID); + croak("throw_error() did not throw the error (%"SVf")", message); + } +} + /* equivalent to "blessed($x) && $x->isa($klass)" */ bool