X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=xs-src%2FMouse.xs;h=cad8f5a0f135793216864e320f619429fc055e77;hp=8e7700fbf6ab0111cef5669a8c8b8272edf61e76;hb=53f661ad85292817689ae0a2ac195019764765f0;hpb=adb5eb76f6875283f11d6f2b8d281568f0a4a688 diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs index 8e7700f..cad8f5a 100644 --- a/xs-src/Mouse.xs +++ b/xs-src/Mouse.xs @@ -1,12 +1,14 @@ #define NEED_newSVpvn_flags_GLOBAL #include "mouse.h" +/* keywords for methods/keys */ SV* mouse_package; SV* mouse_namespace; SV* mouse_methods; SV* mouse_name; SV* mouse_get_attribute; SV* mouse_get_attribute_list; +SV* mouse_coerce; #define MOUSE_xc_flags(a) SvUVX(MOUSE_av_at((a), MOUSE_XC_FLAGS)) #define MOUSE_xc_gen(a) MOUSE_av_at((a), MOUSE_XC_GEN) @@ -249,8 +251,9 @@ mouse_class_initialize_object(pTHX_ SV* const meta, SV* const object, HV* const assert(args); assert(SvTYPE(args) == SVt_PVHV); - ENTER; - SAVETMPS; + if(mg_find((SV*)args, PERL_MAGIC_tied)){ + croak("You cannot use tied HASH reference as initializing arguments"); + } if(!ignore_triggers){ triggers_queue = newAV_mortal(); @@ -270,7 +273,7 @@ mouse_class_initialize_object(pTHX_ SV* const meta, SV* const object, HV* const if(flags & MOUSEf_ATTR_HAS_TC){ value = mouse_xa_apply_type_constraint(aTHX_ xa, value, flags); } - set_slot(object, slot, value); + value = set_slot(object, slot, value); if(SvROK(value) && flags & MOUSEf_ATTR_IS_WEAK_REF){ weaken_slot(object, slot); } @@ -306,11 +309,9 @@ mouse_class_initialize_object(pTHX_ SV* const meta, SV* const object, HV* const } if(MOUSE_xc_flags(xc) & MOUSEf_XC_IS_ANON){ - set_slot(object, newSVpvs_flags("__METACLASS__", SVs_TEMP), meta); + (void)set_slot(object, newSVpvs_flags("__METACLASS__", SVs_TEMP), meta); } - FREETMPS; - LEAVE; } static SV* @@ -349,7 +350,12 @@ mouse_buildall(pTHX_ AV* const xc, SV* const object, SV* const args) { PUSHs(args); PUTBACK; - call_sv(AvARRAY(buildall)[i], G_VOID | G_DISCARD); + call_sv(AvARRAY(buildall)[i], G_VOID); + + /* discard a scalar which G_VOID returns */ + SPAGAIN; + (void)POPs; + PUTBACK; } } @@ -362,6 +368,7 @@ BOOT: mouse_namespace = newSVpvs_share("namespace"); mouse_methods = newSVpvs_share("methods"); mouse_name = newSVpvs_share("name"); + mouse_coerce = newSVpvs_share("coerce"); mouse_get_attribute = newSVpvs_share("get_attribute"); mouse_get_attribute_list = newSVpvs_share("get_attribute_list"); @@ -435,7 +442,7 @@ CODE: } sv_setsv_mg((SV*)gv, code_ref); /* *gv = $code_ref */ - set_slot(methods, name, code); /* $self->{methods}{$name} = $code */ + (void)set_slot(methods, name, code); /* $self->{methods}{$name} = $code */ /* name the CODE ref if it's anonymous */ { @@ -454,6 +461,7 @@ MODULE = Mouse PACKAGE = Mouse::Meta::Class BOOT: INSTALL_SIMPLE_READER(Class, roles); INSTALL_SIMPLE_PREDICATE_WITH_KEY(Class, is_anon_class, anon_serial_id); + INSTALL_SIMPLE_READER(Class, is_immutable); INSTALL_CLASS_HOLDER(Class, method_metaclass, "Mouse::Meta::Method"); INSTALL_CLASS_HOLDER(Class, attribute_metaclass, "Mouse::Meta::Attribute"); @@ -585,10 +593,9 @@ CODE: AV* demolishall; I32 len, i; - PERL_UNUSED_VAR(ix); - if(!IsObject(object)){ - croak("You must not call DESTROY as a class method"); + croak("You must not call %s as a class method", + ix == 0 ? "DESTROY" : "DEMOLISHALL"); } if(SvOK(meta)){ @@ -627,8 +634,14 @@ CODE: XPUSHs(object); PUTBACK; - call_sv(AvARRAY(demolishall)[i], G_VOID | G_DISCARD | G_EVAL); - if(SvTRUE(ERRSV)){ + call_sv(AvARRAY(demolishall)[i], G_VOID | G_EVAL); + + /* discard a scalar which G_VOID returns */ + SPAGAIN; + (void)POPs; + PUTBACK; + + if(sv_true(ERRSV)){ SV* const e = newSVsv(ERRSV); FREETMPS; @@ -656,13 +669,11 @@ void BUILDALL(SV* self, SV* args) CODE: { - AV* const xc = mouse_get_xc(aTHX_ self); + SV* const meta = get_metaclass(self); + AV* const xc = mouse_get_xc(aTHX_ meta); if(!IsHashRef(args)){ croak("You must pass a HASH reference to BUILDALL"); } - if(mg_find(SvRV(args), PERL_MAGIC_tied)){ - croak("You cannot use tie HASH reference as args"); - } mouse_buildall(aTHX_ xc, self, args); }