X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=xs-src%2FMouse.xs;h=e94d4769d1f0b83654f11310495b4b18c38b4786;hp=7800a86a720d16a22924e3d097d12e4876d1fbaa;hb=d06d926635763fa5687c429b5ad39938c564fbed;hpb=31113a4a9ce776118909d8a019af3e784d21d909

diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs
index 7800a86..e94d476 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)
@@ -19,6 +21,8 @@ enum mouse_xc_flags_t {
     MOUSEf_XC_IS_IMMUTABLE   = 0x0001,
     MOUSEf_XC_IS_ANON        = 0x0002,
     MOUSEf_XC_HAS_BUILDARGS  = 0x0004,
+    MOUSEf_XC_CONSTRUCTOR_IS_STRICT
+                             = 0x0008,
 
     MOUSEf_XC_mask           = 0xFFFF /* not used */
 };
@@ -37,6 +41,12 @@ enum mouse_xc_ix_t{
     MOUSE_XC_last
 };
 
+enum mouse_modifier_t {
+    MOUSE_M_BEFORE,
+    MOUSE_M_AROUND,
+    MOUSE_M_AFTER,
+};
+
 static MGVTBL mouse_xc_vtbl; /* for identity */
 
 static void
@@ -113,6 +123,10 @@ mouse_class_update_xc(pTHX_ SV* const metaclass PERL_UNUSED_DECL, HV* const stas
         flags |= MOUSEf_XC_HAS_BUILDARGS;
     }
 
+    if(predicate_calls(metaclass, "__strict_constructor")){
+        flags |= MOUSEf_XC_CONSTRUCTOR_IS_STRICT;
+    }
+
     av_store(xc, MOUSE_XC_FLAGS,       newSVuv(flags));
     av_store(xc, MOUSE_XC_ATTRALL,     (SV*)attrall);
     av_store(xc, MOUSE_XC_BUILDALL,    (SV*)buildall);
@@ -238,12 +252,52 @@ mouse_buildargs(pTHX_ SV* metaclass, SV* const klass, I32 ax, I32 items) {
 }
 
 static void
+mouse_report_unknown_args(pTHX_ SV* const meta, AV* const attrs, HV* const args) {
+    HV* const attr_map = newHV_mortal();
+    SV* const unknown  = newSVpvs_flags("", SVs_TEMP);
+    I32 const len      = AvFILLp(attrs) + 1;
+    I32 i;
+    HE* he;
+
+    for(i = 0; i < len; i++){
+        SV* const attr = MOUSE_av_at(attrs, i);
+        AV* const xa   = mouse_get_xa(aTHX_ attr);
+        SV* const init_arg = MOUSE_xa_init_arg(xa);
+        if(SvOK(init_arg)){
+            (void)hv_store_ent(attr_map, init_arg, &PL_sv_undef, 0U);
+        }
+    }
+
+    hv_iterinit(args);
+    while((he = hv_iternext(args))){
+        SV* const key = hv_iterkeysv(he);
+        if(!hv_exists_ent(attr_map, key, 0U)){
+            sv_catpvf(unknown, "%"SVf", ", key);
+        }
+    }
+
+    if(SvCUR(unknown) > 0){
+        SvCUR(unknown) -= 2; /* chop "," */
+    }
+    else{
+        sv_setpvs(unknown, "(unknown)");
+    }
+
+    mouse_throw_error(meta, NULL,
+        "Unknown attribute passed to the constructor of %"SVf": %"SVf,
+        mcall0(meta, mouse_name), unknown);
+}
+
+
+
+static void
 mouse_class_initialize_object(pTHX_ SV* const meta, SV* const object, HV* const args, bool const ignore_triggers) {
     AV* const xc    = mouse_get_xc(aTHX_ meta);
     AV* const attrs = MOUSE_xc_attrall(xc);
     I32 len         = AvFILLp(attrs) + 1;
     I32 i;
     AV* triggers_queue = NULL;
+    I32 used = 0;
 
     assert(meta || object);
     assert(args);
@@ -253,13 +307,11 @@ mouse_class_initialize_object(pTHX_ SV* const meta, SV* const object, HV* const
         croak("You cannot use tied HASH reference as initializing arguments");
     }
 
-    ENTER;
-    SAVETMPS;
-
     if(!ignore_triggers){
         triggers_queue = newAV_mortal();
     }
 
+    /* for each attribute */
     for(i = 0; i < len; i++){
         SV* const attr = MOUSE_av_at(attrs, i);
         AV* const xa   = mouse_get_xa(aTHX_ attr);
@@ -274,7 +326,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);
             }
@@ -285,6 +337,7 @@ mouse_class_initialize_object(pTHX_ SV* const meta, SV* const object, HV* const
 
                 av_push(triggers_queue, (SV*)pair);
             }
+            used++;
         }
         else { /* no init arg */
             if(flags & (MOUSEf_ATTR_HAS_DEFAULT | MOUSEf_ATTR_HAS_BUILDER)){
@@ -296,7 +349,11 @@ mouse_class_initialize_object(pTHX_ SV* const meta, SV* const object, HV* const
                 mouse_throw_error(attr, NULL, "Attribute (%"SVf") is required", slot);
             }
         }
-    } /* for each attributes */
+    } /* for each attribute */
+
+    if(MOUSE_xc_flags(xc) & MOUSEf_XC_CONSTRUCTOR_IS_STRICT && used < HvUSEDKEYS(args)){
+        mouse_report_unknown_args(aTHX_ meta, attrs, args);
+    }
 
     if(triggers_queue){
         len = AvFILLp(triggers_queue) + 1;
@@ -310,11 +367,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*
@@ -353,8 +408,51 @@ 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;
+    }
+}
+
+static AV*
+mouse_get_modifier_storage(pTHX_
+        SV* const meta,
+        enum mouse_modifier_t const m, SV* const name) {
+    static const char* const keys[] = {
+        "before",
+        "around",
+        "after",
+    };
+    SV* const key = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_method_modifiers", keys[m]));
+    SV* table;
+    SV* storage_ref;
+
+    must_defined(name, "a method name");
+
+    table = get_slot(meta, key);
+
+    if(!table){
+        /* $meta->{$key} = {} */
+        table = sv_2mortal(newRV_noinc((SV*)newHV()));
+        set_slot(meta, key, table);
     }
+
+    storage_ref = get_slot(table, name);
+
+    if(!storage_ref){
+        storage_ref = sv_2mortal(newRV_noinc((SV*)newAV()));
+        set_slot(table, name, storage_ref);
+    }
+    else{
+        if(!IsArrayRef(storage_ref)){
+            croak("Modifier strorage for '%s' is not an ARRAY reference", keys[m]);
+        }
+    }
+
+    return (AV*)SvRV(storage_ref);
 }
 
 MODULE = Mouse  PACKAGE = Mouse
@@ -366,6 +464,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");
@@ -410,47 +509,22 @@ CODE:
         croak("No package name defined");
     }
 
-    SvGETMAGIC(name);
-    SvGETMAGIC(code);
-
-    if(!SvOK(name)){
-        mouse_throw_error(self, NULL, "You must define a method name");
-    }
-    if(!SvROK(code)){
-        mouse_throw_error(self, NULL, "You must define a CODE reference");
-    }
+    must_defined(name, "a method name");
+    must_ref    (code, "a CODE reference", SVt_NULL); /* any reftype is OK */
 
     code_ref = code;
     if(SvTYPE(SvRV(code_ref)) != SVt_PVCV){
         SV*  sv = code_ref;  /* used in tryAMAGICunDEREF */
         SV** sp = &sv;       /* used in tryAMAGICunDEREF */
         tryAMAGICunDEREF(to_cv); /* try \&{$code} */
-        if(!(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV)){
-            mouse_throw_error(self, NULL, "You must pass a CODE reference to add_method");
-        }
+        must_ref(code, "a CODE reference", SVt_PVCV);
         code_ref = sv;
     }
 
     /*  *{$package . '::' . $name} -> *gv */
     gv = gv_fetchpv(form("%"SVf"::%"SVf, package, name), GV_ADDMULTI, SVt_PVCV);
-    if(GvCVu(gv)){ /* delete *slot{gv} to work around "redefine" warning */
-        SvREFCNT_dec(GvCV(gv));
-        GvCV(gv) = NULL;
-    }
-    sv_setsv_mg((SV*)gv, code_ref); /* *gv = $code_ref */
-
-    set_slot(methods, name, code); /* $self->{methods}{$name} = $code */
-
-    /* name the CODE ref if it's anonymous */
-    {
-        CV* const code_entity = (CV*)SvRV(code_ref);
-        if(CvANON(code_entity)
-            && CvGV(code_entity) /* a cv under construction has no gv */ ){
-
-            CvGV(code_entity) = gv;
-            CvANON_off(code_entity);
-        }
-    }
+    mouse_install_sub(aTHX_ gv, code_ref);
+    (void)set_slot(methods, name, code); /* $self->{methods}{$name} = $code */
 }
 
 MODULE = Mouse  PACKAGE = Mouse::Meta::Class
@@ -459,6 +533,7 @@ 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_SIMPLE_READER_WITH_KEY(Class, __strict_constructor, strict_constructor);
 
     INSTALL_CLASS_HOLDER(Class, method_metaclass,     "Mouse::Meta::Method");
     INSTALL_CLASS_HOLDER(Class, attribute_metaclass,  "Mouse::Meta::Attribute");
@@ -533,6 +608,39 @@ BOOT:
 
     INSTALL_CLASS_HOLDER(Role, method_metaclass,  "Mouse::Meta::Role::Method");
 
+void
+add_before_modifier(SV* self, SV* name, SV* modifier)
+CODE:
+{
+    av_push(mouse_get_modifier_storage(aTHX_ self, ix, name), newSVsv(modifier));
+}
+ALIAS:
+    add_before_method_modifier = MOUSE_M_BEFORE
+    add_around_method_modifier = MOUSE_M_AROUND
+    add_after_method_modifier  = MOUSE_M_AFTER
+
+void
+get_before_modifiers(SV* self, SV* name)
+ALIAS:
+    get_before_method_modifiers = MOUSE_M_BEFORE
+    get_around_method_modifiers = MOUSE_M_AROUND
+    get_after_method_modifiers  = MOUSE_M_AFTER
+PPCODE:
+{
+    AV* const storage = mouse_get_modifier_storage(aTHX_ self, ix, name);
+    I32 const len     = av_len(storage) + 1;
+    if(GIMME_V == G_ARRAY) {
+        I32 i;
+        EXTEND(SP, len);
+        for(i = 0; i < len; i++){
+            PUSHs(*av_fetch(storage, i, TRUE));
+        }
+    }
+    else{
+        mPUSHi(len);
+    }
+}
+
 MODULE = Mouse  PACKAGE = Mouse::Object
 
 SV*
@@ -619,19 +727,29 @@ CODE:
     len      = AvFILLp(demolishall) + 1;
     if(len > 0){
         GV* const statusvalue = gv_fetchpvs("?", 0, SVt_PV);
-        SAVESPTR(GvSV(statusvalue)); /* local $? */
+
+        if(statusvalue){ /* it can be NULL */
+            SAVESPTR(GvSV(statusvalue)); /* local $? */
+            GvSV(statusvalue) = sv_newmortal();
+        }
         SAVESPTR(ERRSV); /* local $@ */
+        ERRSV = newSVpvs_flags("", SVs_TEMP);
 
-        GvSV(statusvalue) = sv_newmortal();
-        ERRSV             = newSVpvs_flags("", SVs_TEMP);
         for(i = 0; i < len; i++){
             SPAGAIN;
 
             PUSHMARK(SP);
             XPUSHs(object);
+            XPUSHs(boolSV(PL_dirty));
+            PUTBACK;
+
+            call_sv(AvARRAY(demolishall)[i], G_VOID | G_EVAL);
+
+            /* discard a scalar which G_VOID returns */
+            SPAGAIN;
+            (void)POPs;
             PUTBACK;
 
-            call_sv(AvARRAY(demolishall)[i], G_VOID | G_DISCARD | G_EVAL);
             if(sv_true(ERRSV)){
                 SV* const e = newSVsv(ERRSV);
 
@@ -663,8 +781,6 @@ CODE:
     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");
-    }
+    must_ref(args, "a HASH reference to BUILDALL", SVt_PVHV);
     mouse_buildall(aTHX_ xc, self, args);
 }