#include "perl.h"
#include "XSUB.h"
+#define NEED_grok_number
+#define NEED_grok_numeric_radix
#define NEED_newRV_noinc
#define NEED_newSVpvn_share
#define NEED_sv_2pv_flags
TC_CHECK tc_check; /* see TC_CHECK*/
SV *type_constraint; /* Moose::Meta::TypeConstraint object */
- CV *initializer; /* TODO */
- CV *trigger; /* TODO */
+ CV *trigger;
+ CV *initializer;
+ CV *writer; /* used by the initializer */
SV *meta_attr; /* the Moose::Meta::Attribute */
AV *cvs; /* an array of CVs which use this attr, see delete_mi */
if (!sv)
return 0;
+ SvGETMAGIC(sv);
+
switch (type) {
case Any:
return 1;
if ( SvIOK(sv) ) {
return 1;
} else if ( SvPOK(sv) ) {
- /* FIXME i really don't like this */
- int i;
STRLEN len;
char *pv = SvPV(sv, len);
- char *end = pv + len;
- char *tail = end;
-
- errno = 0;
- i = strtol(pv, &tail, 0);
-
- if ( errno ) return 0;
-
- while ( tail != end ) {
- if ( !isspace(*tail++) ) return 0;
- }
-
- return 1;
+ int flags = grok_number(pv, len, NULL);
+ return ( flags && !(flags & IS_NUMBER_NOT_INT) );
}
return 0;
break;
break;
case RegexpRef:
case Object:
- if ( sv_isobject(sv) ) {
- char *name = HvNAME_get(SvSTASH(SvRV(sv)));
- bool is_regexp = strEQ("Regexp", name);
- return ( type == RegexpRef ? is_regexp : !is_regexp );
+ /* not using sv_isobject to avoid repeated get magic */
+ if ( SvROK(sv) ) {
+ SV *rv = SvRV(sv);
+ if ( SvOBJECT(rv) ) {
+ char *name = HvNAME_get(SvSTASH(SvRV(sv)));
+ if ( name ) {
+ bool is_regexp = strEQ("Regexp", name);
+ return ( (type == RegexpRef) ^ !is_regexp );
+ }
+ }
}
return 0;
break;
/* invoke a CV on an SV and return SvTRUE of the result */
STATIC bool check_sv_cv (pTHX_ SV *cv, SV *sv) {
+ SV *ret_sv;
bool ret;
dSP;
call_sv(cv, G_SCALAR);
SPAGAIN;
- ret = SvTRUE(POPs);
+ ret_sv = POPs;
+ ret = SvTRUE(ret_sv);
PUTBACK;
FREETMPS;
- attr->trigger = SvROK(params[6]) ? (CV *)SvRV(params[6]) : NULL;
+ attr->trigger = SvROK(params[8]) ? (CV *)SvRV(params[8]) : NULL;
if ( attr->trigger && SvTYPE(attr->trigger) != SVt_PVCV )
croak("trigger is not a coderef");
- attr->initializer = SvROK(params[7]) ? (CV *)SvRV(params[7]) : NULL;
+ attr->initializer = SvROK(params[9]) ? (CV *)SvRV(params[9]) : NULL;
if ( attr->initializer && SvTYPE(attr->initializer) != SVt_PVCV )
croak("initializer is not a coderef");
-
-
/* now that we're done preparing/checking args and shit, so we finalize the
* attr, increasing refcounts for any referenced data, and creating the CV
* array */
attr->type_constraint = newSVsv(tc);
/* increase the refcount for auxillary structures */
- SvREFCNT_inc(attr->trigger);
- SvREFCNT_inc(attr->initializer);
- if ( flags & ATTR_TCREFCNT ) SvREFCNT_inc(attr->tc_check.sv);
- if ( flags & ATTR_DEFREFCNT ) SvREFCNT_inc(attr->def.sv);
+ SvREFCNT_inc_simple_void(attr->trigger);
+ SvREFCNT_inc_simple_void(attr->initializer);
+ if ( flags & ATTR_TCREFCNT ) SvREFCNT_inc_simple_void_NN(attr->tc_check.sv);
+ if ( flags & ATTR_DEFREFCNT ) SvREFCNT_inc_simple_void_NN(attr->def.sv);
attr->slot_sv = newSVpvn_share(slot_pv, slot_len, slot_hash);
attr->slot_u32 = slot_hash;
Newxz(mi->attrs, num_attrs, ATTR);
- SvREFCNT_inc_simple(stash);
+ SvREFCNT_inc_simple_void_NN(stash);
mi->stash = stash;
mi->type = 0; /* nothing else implemented yet */
/* initialize attributes */
- for ( ; mi->num_attrs < num_attrs; mi->num_attrs++ ) {
+ for ( mi->num_attrs = 0; mi->num_attrs < num_attrs; mi->num_attrs++ ) {
SV **desc = av_fetch(attrs, mi->num_attrs, 0);
if ( !desc || !*desc || !SvROK(*desc) || !(SvTYPE(SvRV(*desc)) == SVt_PVAV) ) {
SvREFCNT_dec(attr->type_constraint);
if ( attr->flags & ATTR_TCREFCNT ) SvREFCNT_dec(attr->tc_check.sv);
if ( attr->flags & ATTR_DEFREFCNT ) SvREFCNT_dec(attr->def.sv);
- SvREFCNT_dec(attr->initializer);
SvREFCNT_dec(attr->trigger);
+ SvREFCNT_dec(attr->initializer);
+ SvREFCNT_dec(attr->writer);
SvREFCNT_dec(attr->meta_attr);
}
* $attr->associated_class->get_meta_instance */
STATIC SV *attr_to_meta_instance(pTHX_ SV *meta_attr) {
dSP;
- I32 count;
SV *mi;
if ( !meta_attr )
XPUSHs(meta_attr);
PUTBACK;
- count = call_pv("Moose::XS::attr_to_meta_instance", G_SCALAR);
-
- if ( count != 1 )
- croak("attr_to_meta_instance borked (%d args returned, expecting 1)", (int)count);
+ call_pv("Moose::XS::attr_to_meta_instance", G_SCALAR);
SPAGAIN;
mi = POPs;
- SvREFCNT_inc(mi);
+ SvREFCNT_inc_simple_void(mi);
PUTBACK;
FREETMPS;
stash = gv_stashsv(class, 0);
mi = new_mi(aTHX_ stash, (AV *)SvRV(attrs));
- SvREFCNT_inc(mi);
+ SvREFCNT_inc_simple_void_NN(mi);
FREETMPS;
LEAVE;
XSANY.any_i32 = PTR2IV(attr);
- SvREFCNT_inc(cv);
+ SvREFCNT_inc_simple_void(cv);
av_push( attr->cvs, (SV *)cv );
return attr;
*
* 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;
* $obj->$coderef etc, for that we need to use 'default' */
PUTBACK;
call_method(SvPV_nolen(attr->def.sv), G_SCALAR);
- SPAGAIN;
/* the value is a mortal with a refcount of 1, so we need to keep it around */
+ SPAGAIN;
sv = POPs;
- SvREFCNT_inc(sv);
+ SvREFCNT_inc_simple_void(sv);
PUTBACK;
FREETMPS;
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;
}
/* $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_sv((SV *)attr->trigger, G_VOID);
- if ( !set_slot_value(aTHX_ self, attr, copy) ) {
- SvREFCNT_dec(copy);
- croak("Hash store failed.");
+ FREETMPS;
+ LEAVE;
}
}
+/* generate a new attribute method */
+STATIC CV *new_attr_method (pTHX_ SV *attr, XSPROTO(body), char *name) {
+ CV *cv = newXS(name, body, __FILE__);
+
+ if (cv == NULL)
+ croak("Oi vey!");
+
+ /* associate CV with meta attr */
+ stash_in_mg(aTHX_ (SV *)cv, attr);
+
+ /* this will be set on first call */
+ XSANY.any_i32 = 0;
+
+ return cv;
+}
+
+
+
+
/* This macro is used in the XS subs to set up the 'attr' variable.
*
* if XSANY is NULL then define_attr is called on the CV, to set the pointer
XSRETURN_NO;
}
+
+
+
+
+
+
enum xs_body {
xs_body_reader = 0,
xs_body_writer,
PROTOTYPES: ENABLE
CV *
-new_sub(attr, name)
+new_attr_method(attr, name)
INPUT:
SV *attr;
SV *name;
PROTOTYPE: $;$
+ PREINIT:
+ char *pv = SvOK(name) ? SvPV_nolen(name) : NULL;
ALIAS:
new_reader = xs_body_reader
new_writer = xs_body_writer
new_accessor = xs_body_accessor
new_predicate = xs_body_predicate
- PREINIT:
- CV * cv;
CODE:
if ( ix >= max_xs_body )
croak("Unknown Moose::XS body type");
if ( !sv_isobject(attr) )
croak("'attr' must be a Moose::Meta::Attribute");
- cv = newXS(SvOK(name) ? SvPV_nolen(name) : NULL, xs_bodies[ix], __FILE__);
-
- if (cv == NULL)
- croak("Oi vey!");
-
- /* associate CV with meta attr */
- stash_in_mg(aTHX_ (SV *)cv, attr);
-
- /* this will be set on first call */
- XSANY.any_i32 = 0;
-
- RETVAL = cv;
+ RETVAL = new_attr_method(aTHX_ attr, xs_bodies[ix], pv);
OUTPUT:
RETVAL
projects / gitmo/Moose.git / blobdiff