X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=xs-src%2FMouse.xs;h=143228a794e24cfa541d03e04407e867f22bbe56;hp=84d49f21e12b10d77f32276680150922d4cf2701;hb=70425827d676b2b4130f5e78689bf017fe4c4609;hpb=ae34e0779f972bfb489cb174f2f2dbafcbb34ba3

diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs
index 84d49f2..143228a 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 */
 };
@@ -113,6 +117,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,24 +246,66 @@ 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);
     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();
     }
 
+    /* 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);
@@ -270,7 +320,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);
             }
@@ -281,6 +331,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)){
@@ -292,7 +343,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;
@@ -306,11 +361,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("__ANON__", SVs_TEMP), meta);
+        (void)set_slot(object, newSVpvs_flags("__METACLASS__", SVs_TEMP), meta);
     }
 
-    FREETMPS;
-    LEAVE;
 }
 
 static SV*
@@ -335,122 +388,29 @@ mouse_initialize_metaclass(pTHX_ SV* const klass) {
     return meta;
 }
 
+static void
+mouse_buildall(pTHX_ AV* const xc, SV* const object, SV* const args) {
+    AV* const buildall = MOUSE_xc_buildall(xc);
+    I32 const len      = AvFILLp(buildall) + 1;
+    I32 i;
+    for(i = 0; i < len; i++){
+        dSP;
 
-/* copied from Class-MOP/topic/symbol-manipluator */
-static GV*
-mouse_get_gv(pTHX_ SV* const self, svtype const type, const char* const var_name, I32 const var_name_len, I32 const flags){
-    SV* package_name;
-    STRLEN len;
-    const char* pv;
-
-    if(!flags){
-        SV* const ns = mcall0(self, mouse_namespace);
-        GV** gvp;
-        if(!(SvROK(ns) && SvTYPE(SvRV(ns)) == SVt_PVHV)){
-            croak("namespace() did not return a hash reference");
-        }
-        gvp = (GV**)hv_fetch((HV*)SvRV(ns), var_name, var_name_len, FALSE);
-        if(gvp && isGV_with_GP(*gvp)){
-            return *gvp;
-        }
-    }
-
-    package_name = get_slot(self, mouse_package);
-
-    if(!(package_name && SvOK(package_name))){
-        croak("No package name defined");
-    }
-
-    pv = SvPV_const(package_name, len);
-
-    return gv_fetchpvn_flags(Perl_form(aTHX_ "%s::%s", pv, var_name), (len + var_name_len + 2), flags, type);
-}
+        PUSHMARK(SP);
+        EXTEND(SP, 2);
+        PUSHs(object);
+        PUSHs(args);
+        PUTBACK;
 
-/* copied from Class-MOP/topic/symbol-manipluator */
-static SV*
-mouse_gv_elem(pTHX_ GV* const gv, svtype const type, I32 const add){
-    SV* sv;
-
-    if(!gv){
-        return NULL;
-    }
-
-    assert(isGV_with_GP(gv));
-
-    switch(type){
-    case SVt_PVAV:
-        sv = (SV*)(add ? GvAVn(gv) : GvAV(gv));
-        break;
-    case SVt_PVHV:
-        sv = (SV*)(add ? GvHVn(gv) : GvHV(gv));
-        break;
-    case SVt_PVCV:
-        sv = (SV*)GvCV(gv);
-        break;
-    case SVt_PVIO:
-        sv = (SV*)(add ? GvIOn(gv) : GvIO(gv));
-        break;
-    case SVt_PVGV:
-        sv = (SV*)gv;
-        break;
-    default: /* SCALAR */
-        sv =       add ? GvSVn(gv) : GvSV(gv);
-        break;
-    }
-
-    return sv;
-}
+        call_sv(AvARRAY(buildall)[i], G_VOID);
 
-/* copied from Class-MOP/topic/symbol-manipluator */
-static void
-mouse_deconstruct_variable_name(pTHX_ SV* const variable,
-    const char** const var_name, STRLEN* const var_name_len,
-    svtype* const type,
-    const char** const type_name) {
-
-    STRLEN len;
-    const char* pv;
-
-    /* e.g. variable = '$foo' */
-
-    if(!SvOK(variable)) {
-        croak("You must pass a variable name");
-    }
-    pv = SvPV_const(variable, len);
-    if(len < 2){
-        croak("You must pass a variable name including a sigil");
-    }
-
-    *var_name     = pv  + 1;
-    *var_name_len = len - 1;
-
-    switch(pv[0]){
-    case '$':
-        *type      = SVt_PV; /* for all the types of scalars */
-        *type_name = "SCALAR";
-        break;
-    case '@':
-        *type      = SVt_PVAV;
-        *type_name = "ARRAY";
-        break;
-    case '%':
-        *type      = SVt_PVHV;
-        *type_name = "HASH";
-        break;
-    case '&':
-        *type      = SVt_PVCV;
-        *type_name = "CODE";
-        break;
-    case '*':
-        *type      = SVt_PVGV;
-        *type_name = "GLOB";
-        break;
-    default:
-        croak("I do not recognize that sigil '%c'", pv[0]);
+        /* discard a scalar which G_VOID returns */
+        SPAGAIN;
+        (void)POPs;
+        PUTBACK;
     }
 }
 
-
 MODULE = Mouse  PACKAGE = Mouse
 
 PROTOTYPES: DISABLE
@@ -460,6 +420,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");
@@ -533,13 +494,31 @@ 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 */
     {
         CV* const code_entity = (CV*)SvRV(code_ref);
         if(CvANON(code_entity)
             && CvGV(code_entity) /* a cv under construction has no gv */ ){
+            HV* dbsub;
+
+            /* update %DB::sub to make NYTProf happy */
+            if((PL_perldb & (PERLDBf_SUBLINE|PERLDB_NAMEANON))
+                && PL_DBsub && (dbsub = GvHV(PL_DBsub))
+            ){
+                /* see Perl_newATTRSUB() in op.c */
+                SV* const subname = sv_newmortal();
+                HE* orig;
+
+                gv_efullname3(subname, CvGV(code_entity), NULL);
+                orig = hv_fetch_ent(dbsub, subname, FALSE, 0U);
+                if(orig){
+                    gv_efullname3(subname, gv, NULL);
+                    (void)hv_store_ent(dbsub, subname, HeVAL(orig), 0U);
+                    SvREFCNT_inc_simple_void_NN(HeVAL(orig));
+                }
+            }
 
             CvGV(code_entity) = gv;
             CvANON_off(code_entity);
@@ -547,51 +526,18 @@ CODE:
     }
 }
 
-bool
-has_package_symbol(SV* self, SV* variable)
-PREINIT:
-    svtype type;
-    const char* type_name;
-    const char* var_name;
-    STRLEN var_name_len;
-    GV* gv;
-CODE:
-    mouse_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name);
-    gv = mouse_get_gv(aTHX_ self, type, var_name, var_name_len, 0);
-    RETVAL = mouse_gv_elem(aTHX_ gv, type, FALSE) ? TRUE : FALSE;
-OUTPUT:
-    RETVAL
-
-SV*
-get_package_symbol(SV* self, SV* variable)
-PREINIT:
-    svtype type;
-    const char* type_name;
-    const char* var_name;
-    STRLEN var_name_len;
-    I32 flags = 0;
-    GV* gv;
-    SV* sv;
-CODE:
-    mouse_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name);
-    gv = mouse_get_gv(aTHX_ self, type, var_name, var_name_len, flags);
-    sv = mouse_gv_elem(aTHX_ gv, type, FALSE);
-
-    RETVAL = sv ? newRV_inc(sv) : &PL_sv_undef;
-OUTPUT:
-    RETVAL
-
-
 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_SIMPLE_READER_WITH_KEY(Class, __strict_constructor, strict_constructor);
 
-    INSTALL_SIMPLE_READER_WITH_DEFAULTS(Class, method_metaclass,     "Mouse::Meta::Method");
-    INSTALL_SIMPLE_READER_WITH_DEFAULTS(Class, attribute_metaclass,  "Mouse::Meta::Attribute");
-    INSTALL_SIMPLE_READER_WITH_DEFAULTS(Class, constructor_class,    "Mouse::Meta::Method::Constructor::XS");
-    INSTALL_SIMPLE_READER_WITH_DEFAULTS(Class, destructor_class,     "Mouse::Meta::Method::Destructor::XS");
+    INSTALL_CLASS_HOLDER(Class, method_metaclass,     "Mouse::Meta::Method");
+    INSTALL_CLASS_HOLDER(Class, attribute_metaclass,  "Mouse::Meta::Attribute");
+    INSTALL_CLASS_HOLDER(Class, constructor_class,    "Mouse::Meta::Method::Constructor::XS");
+    INSTALL_CLASS_HOLDER(Class, destructor_class,     "Mouse::Meta::Method::Destructor::XS");
 
     newCONSTSUB(gv_stashpvs("Mouse::Meta::Method::Constructor::XS", TRUE), "_generate_constructor",
         newRV_inc((SV*)get_cvs("Mouse::Object::new", TRUE)));
@@ -659,7 +605,7 @@ BOOT:
     INSTALL_SIMPLE_READER_WITH_KEY(Role, get_roles, roles);
     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Role, is_anon_role, anon_serial_id);
 
-    INSTALL_SIMPLE_READER_WITH_DEFAULTS(Role, method_metaclass,  "Mouse::Meta::Role::Method");
+    INSTALL_CLASS_HOLDER(Role, method_metaclass,  "Mouse::Meta::Role::Method");
 
 MODULE = Mouse  PACKAGE = Mouse::Object
 
@@ -671,11 +617,10 @@ CODE:
     AV* const xc   = mouse_get_xc(aTHX_ meta);
     UV const flags = MOUSE_xc_flags(xc);
     SV* args;
-    AV* buildall;
-    I32 len, i;
 
     /* BUILDARGS */
     if(flags & MOUSEf_XC_HAS_BUILDARGS){
+        I32 i;
         SPAGAIN;
 
         PUSHMARK(SP);
@@ -703,26 +648,16 @@ CODE:
     RETVAL = mouse_instance_create(aTHX_ MOUSE_xc_stash(xc));
     mouse_class_initialize_object(aTHX_ meta, RETVAL, (HV*)SvRV(args), FALSE);
 
-    /* BUILDALL */
-    buildall = MOUSE_xc_buildall(xc);
-    len      = AvFILLp(buildall) + 1;
-    for(i = 0; i < len; i++){
-        dSP;
-
-        PUSHMARK(SP);
-        EXTEND(SP, 2);
-        PUSHs(RETVAL); /* self */
-        PUSHs(args);
-        PUTBACK;
-
-        call_sv(AvARRAY(buildall)[i], G_VOID | G_DISCARD);
-    }
+    mouse_buildall(aTHX_ xc, RETVAL, args);
 }
 OUTPUT:
     RETVAL
 
 void
 DESTROY(SV* object)
+ALIAS:
+    DESTROY     = 0
+    DEMOLISHALL = 1
 CODE:
 {
     SV* const meta = get_metaclass(object);
@@ -730,7 +665,8 @@ CODE:
     I32 len, i;
 
     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)){
@@ -738,7 +674,7 @@ CODE:
 
         demolishall = MOUSE_xc_demolishall(xc);
     }
-    else {
+    else { /* The metaclass is already destroyed */
         AV* const linearized_isa = mro_get_linear_isa(SvSTASH(SvRV(object)));
 
         len = AvFILLp(linearized_isa) + 1;
@@ -754,24 +690,33 @@ CODE:
         }
     }
 
-    /* DEMOLISHALL */
     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_2mortal(newSViv(0));
-        ERRSV             = sv_2mortal(newSVpvs(""));
         for(i = 0; i < len; i++){
-            dSP;
+            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(SvTRUE(ERRSV)){
+            if(sv_true(ERRSV)){
                 SV* const e = newSVsv(ERRSV);
 
                 FREETMPS;
@@ -795,3 +740,15 @@ OUTPUT:
     RETVAL
 
 
+void
+BUILDALL(SV* self, SV* args)
+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");
+    }
+    mouse_buildall(aTHX_ xc, self, args);
+}