Moose-2.1405HEADMoose-2.1405master

14 files changed, 463 insertions, 0 deletions

diff --git a/xs/Attribute.xs b/xs/Attribute.xs
new file mode 100644
index 0000000..6314af8
--- /dev/null
+++ b/xs/Attribute.xs
@@ -0,0 +1,9 @@
+#include "mop.h"
+
+MODULE = Class::MOP::Attribute   PACKAGE = Class::MOP::Attribute
+
+PROTOTYPES: DISABLE
+
+BOOT:
+    INSTALL_SIMPLE_READER(Attribute, associated_class);
+    INSTALL_SIMPLE_READER(Attribute, associated_methods);
diff --git a/xs/AttributeCore.xs b/xs/AttributeCore.xs
new file mode 100644
index 0000000..d495a16
--- /dev/null
+++ b/xs/AttributeCore.xs
@@ -0,0 +1,18 @@
+#include "mop.h"
+
+MODULE = Class::MOP::Mixin::AttributeCore   PACKAGE = Class::MOP::Mixin::AttributeCore
+
+PROTOTYPES: DISABLE
+
+BOOT:
+    INSTALL_SIMPLE_READER(Mixin::AttributeCore, name);
+    INSTALL_SIMPLE_READER(Mixin::AttributeCore, accessor);
+    INSTALL_SIMPLE_READER(Mixin::AttributeCore, reader);
+    INSTALL_SIMPLE_READER(Mixin::AttributeCore, writer);
+    INSTALL_SIMPLE_READER(Mixin::AttributeCore, predicate);
+    INSTALL_SIMPLE_READER(Mixin::AttributeCore, clearer);
+    INSTALL_SIMPLE_READER(Mixin::AttributeCore, builder);
+    INSTALL_SIMPLE_READER(Mixin::AttributeCore, init_arg);
+    INSTALL_SIMPLE_READER(Mixin::AttributeCore, initializer);
+    INSTALL_SIMPLE_READER(Mixin::AttributeCore, definition_context);
+    INSTALL_SIMPLE_READER(Mixin::AttributeCore, insertion_order);
diff --git a/xs/Class.xs b/xs/Class.xs
new file mode 100644
index 0000000..5c5d5c9
--- /dev/null
+++ b/xs/Class.xs
@@ -0,0 +1,12 @@
+#include "mop.h"
+
+MODULE = Class::MOP::Class   PACKAGE = Class::MOP::Class
+
+PROTOTYPES: DISABLE
+
+BOOT:
+    INSTALL_SIMPLE_READER(Class, instance_metaclass);
+    INSTALL_SIMPLE_READER(Class, immutable_trait);
+    INSTALL_SIMPLE_READER(Class, constructor_class);
+    INSTALL_SIMPLE_READER(Class, constructor_name);
+    INSTALL_SIMPLE_READER(Class, destructor_class);
diff --git a/xs/Generated.xs b/xs/Generated.xs
new file mode 100644
index 0000000..57db324
--- /dev/null
+++ b/xs/Generated.xs
@@ -0,0 +1,9 @@
+#include "mop.h"
+
+MODULE = Class::MOP::Method::Generated   PACKAGE = Class::MOP::Method::Generated
+
+PROTOTYPES: DISABLE
+
+BOOT:
+    INSTALL_SIMPLE_READER(Method::Generated, is_inline);
+    INSTALL_SIMPLE_READER(Method::Generated, definition_context);
diff --git a/xs/HasAttributes.xs b/xs/HasAttributes.xs
new file mode 100644
index 0000000..dc59227
--- /dev/null
+++ b/xs/HasAttributes.xs
@@ -0,0 +1,9 @@
+#include "mop.h"
+
+MODULE = Class::MOP::Mixin::HasAttributes   PACKAGE = Class::MOP::Mixin::HasAttributes
+
+PROTOTYPES: DISABLE
+
+BOOT:
+    INSTALL_SIMPLE_READER(Mixin::HasAttributes, attribute_metaclass);
+    INSTALL_SIMPLE_READER_WITH_KEY(Mixin::HasAttributes, _attribute_map, attributes);
diff --git a/xs/HasMethods.xs b/xs/HasMethods.xs
new file mode 100644
index 0000000..e136abe
--- /dev/null
+++ b/xs/HasMethods.xs
@@ -0,0 +1,88 @@
+#include "mop.h"
+
+SV *mop_method_metaclass;
+SV *mop_associated_metaclass;
+SV *mop_wrap;
+
+static void
+mop_update_method_map(pTHX_ HV *const stash, HV *const map)
+{
+    char *method_name;
+    I32   method_name_len;
+    SV   *method;
+    HV   *symbols;
+
+    symbols = mop_get_all_package_symbols(stash, TYPE_FILTER_CODE);
+    sv_2mortal((SV*)symbols);
+
+    (void)hv_iterinit(map);
+    while ((method = hv_iternextsv(map, &method_name, &method_name_len))) {
+        SV *body;
+        SV *stash_slot;
+
+        if (!SvROK(method)) {
+            continue;
+        }
+
+        if (sv_isobject(method)) {
+            /* $method_object->body() */
+            body = mop_call0(aTHX_ method, KEY_FOR(body));
+        }
+        else {
+            body = method;
+        }
+
+        stash_slot = *hv_fetch(symbols, method_name, method_name_len, TRUE);
+        if (SvROK(stash_slot) && ((CV*)SvRV(body)) == ((CV*)SvRV(stash_slot))) {
+            continue;
+        }
+
+        /* delete $map->{$method_name} */
+        (void)hv_delete(map, method_name, method_name_len, G_DISCARD);
+    }
+}
+
+MODULE = Class::MOP::Mixin::HasMethods   PACKAGE = Class::MOP::Mixin::HasMethods
+
+PROTOTYPES: DISABLE
+
+void
+_method_map(self)
+    SV *self
+    PREINIT:
+        HV *const obj        = (HV *)SvRV(self);
+        SV *const class_name = HeVAL( hv_fetch_ent(obj, KEY_FOR(package), 0, HASH_FOR(package)) );
+        HV *const stash      = gv_stashsv(class_name, 0);
+        UV current;
+        SV *cache_flag;
+        SV *map_ref;
+    PPCODE:
+        if (!stash) {
+             mXPUSHs(newRV_noinc((SV *)newHV()));
+             return;
+        }
+
+        current    = mop_check_package_cache_flag(aTHX_ stash);
+        cache_flag = HeVAL( hv_fetch_ent(obj, KEY_FOR(package_cache_flag), TRUE, HASH_FOR(package_cache_flag)));
+        map_ref    = HeVAL( hv_fetch_ent(obj, KEY_FOR(methods), TRUE, HASH_FOR(methods)));
+
+        /* $self->{methods} does not yet exist (or got deleted) */
+        if ( !SvROK(map_ref) || SvTYPE(SvRV(map_ref)) != SVt_PVHV ) {
+            SV *new_map_ref = newRV_noinc((SV *)newHV());
+            sv_2mortal(new_map_ref);
+            sv_setsv(map_ref, new_map_ref);
+        }
+
+        if ( !SvOK(cache_flag) || SvUV(cache_flag) != current ) {
+            mop_update_method_map(aTHX_ stash, (HV *)SvRV(map_ref));
+            sv_setuv(cache_flag, mop_check_package_cache_flag(aTHX_ stash)); /* update_cache_flag() */
+        }
+
+        XPUSHs(map_ref);
+
+BOOT:
+    mop_method_metaclass     = newSVpvs("method_metaclass");
+    mop_associated_metaclass = newSVpvs("associated_metaclass");
+    mop_wrap                 = newSVpvs("wrap");
+    INSTALL_SIMPLE_READER(Mixin::HasMethods, method_metaclass);
+    INSTALL_SIMPLE_READER(Mixin::HasMethods, wrapped_method_metaclass);
diff --git a/xs/Inlined.xs b/xs/Inlined.xs
new file mode 100644
index 0000000..a7f1f56
--- /dev/null
+++ b/xs/Inlined.xs
@@ -0,0 +1,8 @@
+#include "mop.h"
+
+MODULE = Class::MOP::Method::Inlined   PACKAGE = Class::MOP::Method::Inlined
+
+PROTOTYPES: DISABLE
+
+BOOT:
+    INSTALL_SIMPLE_READER(Method::Inlined, _expected_method_class);
diff --git a/xs/Instance.xs b/xs/Instance.xs
new file mode 100644
index 0000000..944caed
--- /dev/null
+++ b/xs/Instance.xs
@@ -0,0 +1,8 @@
+#include "mop.h"
+
+MODULE = Class::MOP::Instance   PACKAGE = Class::MOP::Instance
+
+PROTOTYPES: DISABLE
+
+BOOT:
+    INSTALL_SIMPLE_READER(Instance, associated_metaclass);
diff --git a/xs/MOP.xs b/xs/MOP.xs
new file mode 100644
index 0000000..0bf05dc
--- /dev/null
+++ b/xs/MOP.xs
@@ -0,0 +1,21 @@
+#include "mop.h"
+
+MODULE = Class::MOP   PACKAGE = Class::MOP
+
+PROTOTYPES: DISABLE
+
+# use prototype here to be compatible with get_code_info from Sub::Identify
+void
+get_code_info(coderef)
+    SV *coderef
+    PROTOTYPE: $
+    PREINIT:
+        char *pkg  = NULL;
+        char *name = NULL;
+    PPCODE:
+        SvGETMAGIC(coderef);
+        if (mop_get_code_info(coderef, &pkg, &name)) {
+            EXTEND(SP, 2);
+            mPUSHs(newSVpv(pkg, 0));
+            mPUSHs(newSVpv(name, 0));
+        }
diff --git a/xs/Method.xs b/xs/Method.xs
new file mode 100644
index 0000000..5ffa467
--- /dev/null
+++ b/xs/Method.xs
@@ -0,0 +1,23 @@
+#include "mop.h"
+
+MODULE = Class::MOP::Method   PACKAGE = Class::MOP::Method
+
+PROTOTYPES: DISABLE
+
+BOOT:
+    INSTALL_SIMPLE_READER(Method, name);
+    INSTALL_SIMPLE_READER(Method, package_name);
+    INSTALL_SIMPLE_READER(Method, body);
+
+bool
+is_stub(self)
+    SV *self
+
+    PREINIT:
+        CV *const body = (CV *)SvRV( HeVAL( hv_fetch_ent((HV *)SvRV(self), KEY_FOR(body), 0, HASH_FOR(body)) ) );
+
+    CODE:
+        RETVAL = !( CvISXSUB(body) || CvROOT(body) );
+
+    OUTPUT:
+        RETVAL
diff --git a/xs/Moose.xs b/xs/Moose.xs
new file mode 100644
index 0000000..22686cd
--- /dev/null
+++ b/xs/Moose.xs
@@ -0,0 +1,170 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "ppport.h"
+#include "mop.h"
+
+#ifndef MGf_COPY
+# define MGf_COPY 0
+#endif
+
+#ifndef MGf_DUP
+# define MGf_DUP 0
+#endif
+
+#ifndef MGf_LOCAL
+# define MGf_LOCAL 0
+#endif
+
+STATIC int unset_export_flag (pTHX_ SV *sv, MAGIC *mg);
+
+STATIC MGVTBL export_flag_vtbl = {
+    NULL, /* get */
+    unset_export_flag, /* set */
+    NULL, /* len */
+    NULL, /* clear */
+    NULL, /* free */
+#if MGf_COPY
+    NULL, /* copy */
+#endif
+#if MGf_DUP
+    NULL, /* dup */
+#endif
+#if MGf_LOCAL
+    NULL, /* local */
+#endif
+};
+
+STATIC bool
+export_flag_is_set (pTHX_ SV *sv)
+{
+    MAGIC *mg, *moremagic;
+
+    if (SvTYPE(SvRV(sv)) != SVt_PVGV) {
+        return 0;
+    }
+
+    for (mg = SvMAGIC(SvRV(sv)); mg; mg = moremagic) {
+        moremagic = mg->mg_moremagic;
+
+        if (mg->mg_type == PERL_MAGIC_ext && mg->mg_virtual == &export_flag_vtbl) {
+            break;
+        }
+    }
+
+    return !!mg;
+}
+
+STATIC int
+unset_export_flag (pTHX_ SV *sv, MAGIC *mymg)
+{
+    MAGIC *mg, *prevmagic = NULL, *moremagic = NULL;
+
+    for (mg = SvMAGIC(sv); mg; prevmagic = mg, mg = moremagic) {
+        moremagic = mg->mg_moremagic;
+
+        if (mg == mymg) {
+            break;
+        }
+    }
+
+    if (!mg) {
+        return 0;
+    }
+
+    if (prevmagic) {
+        prevmagic->mg_moremagic = moremagic;
+    }
+    else {
+        SvMAGIC_set(sv, moremagic);
+    }
+
+    mg->mg_moremagic = NULL;
+
+    Safefree (mg);
+
+    return 0;
+}
+
+#ifndef SvRXOK
+/* SvRXOK appeared before SVt_REGEXP did, so this implementation assumes magic
+ * based qr//. Note re::is_regexp isn't in 5.8, hence the need for this XS.
+ */
+#define SvRXOK(sv) is_regexp(aTHX_ sv)
+
+STATIC int
+is_regexp (pTHX_ SV* sv) {
+    SV* tmpsv;
+
+    if (SvMAGICAL(sv)) {
+        mg_get(sv);
+    }
+
+    if (SvROK(sv) &&
+        (tmpsv = (SV*) SvRV(sv)) &&
+        SvTYPE(tmpsv) == SVt_PVMG &&
+        (mg_find(tmpsv, PERL_MAGIC_qr))) {
+        return TRUE;
+    }
+
+    return FALSE;
+}
+#endif
+
+XS_EXTERNAL(boot_Class__MOP);
+XS_EXTERNAL(boot_Class__MOP__Mixin__HasAttributes);
+XS_EXTERNAL(boot_Class__MOP__Mixin__HasMethods);
+XS_EXTERNAL(boot_Class__MOP__Package);
+XS_EXTERNAL(boot_Class__MOP__Mixin__AttributeCore);
+XS_EXTERNAL(boot_Class__MOP__Method);
+XS_EXTERNAL(boot_Class__MOP__Method__Inlined);
+XS_EXTERNAL(boot_Class__MOP__Method__Generated);
+XS_EXTERNAL(boot_Class__MOP__Class);
+XS_EXTERNAL(boot_Class__MOP__Attribute);
+XS_EXTERNAL(boot_Class__MOP__Instance);
+XS_EXTERNAL(boot_Moose__Meta__Role__Application__ToInstance);
+
+MODULE = Moose  PACKAGE = Moose::Exporter
+
+PROTOTYPES: DISABLE
+
+BOOT:
+    mop_prehash_keys();
+
+    MOP_CALL_BOOT (boot_Class__MOP);
+    MOP_CALL_BOOT (boot_Class__MOP__Mixin__HasAttributes);
+    MOP_CALL_BOOT (boot_Class__MOP__Mixin__HasMethods);
+    MOP_CALL_BOOT (boot_Class__MOP__Package);
+    MOP_CALL_BOOT (boot_Class__MOP__Mixin__AttributeCore);
+    MOP_CALL_BOOT (boot_Class__MOP__Method);
+    MOP_CALL_BOOT (boot_Class__MOP__Method__Inlined);
+    MOP_CALL_BOOT (boot_Class__MOP__Method__Generated);
+    MOP_CALL_BOOT (boot_Class__MOP__Class);
+    MOP_CALL_BOOT (boot_Class__MOP__Attribute);
+    MOP_CALL_BOOT (boot_Class__MOP__Instance);
+    MOP_CALL_BOOT (boot_Moose__Meta__Role__Application__ToInstance);
+
+void
+_flag_as_reexport (SV *sv)
+    CODE:
+        sv_magicext(SvRV(sv), NULL, PERL_MAGIC_ext, &export_flag_vtbl, NULL, 0);
+
+bool
+_export_is_flagged (SV *sv)
+    CODE:
+        RETVAL = export_flag_is_set(aTHX_ sv);
+    OUTPUT:
+        RETVAL
+
+MODULE = Moose  PACKAGE = Moose::Util::TypeConstraints::Builtins
+
+bool
+_RegexpRef (SV *sv=NULL)
+    INIT:
+        if (!items) {
+            sv = DEFSV;
+        }
+    CODE:
+        RETVAL = SvRXOK(sv);
+    OUTPUT:
+        RETVAL
diff --git a/xs/Package.xs b/xs/Package.xs
new file mode 100644
index 0000000..6c47099
--- /dev/null
+++ b/xs/Package.xs
@@ -0,0 +1,8 @@
+#include "mop.h"
+
+MODULE = Class::MOP::Package   PACKAGE = Class::MOP::Package
+
+PROTOTYPES: DISABLE
+
+BOOT:
+    INSTALL_SIMPLE_READER_WITH_KEY(Package, name, package);
diff --git a/xs/ToInstance.xs b/xs/ToInstance.xs
new file mode 100644
index 0000000..044d2f3
--- /dev/null
+++ b/xs/ToInstance.xs
@@ -0,0 +1,63 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+static void
+S_reset_amagic (pTHX_ SV *rv, const bool on)
+{
+    /* It is assumed that you've already turned magic on/off on rv  */
+
+    SV *sva;
+    SV *const target = SvRV (rv);
+
+    /* Less 1 for the reference we've already dealt with.  */
+    U32 how_many = SvREFCNT (target) - 1;
+    MAGIC *mg;
+
+    if (SvMAGICAL (target) && (mg = mg_find (target, PERL_MAGIC_backref))) {
+        /* Back references also need to be found, but aren't part of the target's reference count. */
+        how_many += 1 + av_len ((AV *)mg->mg_obj);
+    }
+
+    if (!how_many) {
+        /* There was only 1 reference to this object.  */
+        return;
+    }
+
+    for (sva = PL_sv_arenaroot; sva; sva = (SV *)SvANY (sva)) {
+        register const SV *const svend = &sva[SvREFCNT (sva)];
+        register SV *sv;
+        for (sv = sva + 1; sv < svend; ++sv) {
+            if (SvTYPE (sv) != SVTYPEMASK
+             && ((sv->sv_flags & SVf_ROK) == SVf_ROK)
+             && SvREFCNT (sv)
+             && SvRV (sv) == target
+             && sv != rv) {
+                if (on) {
+                    SvAMAGIC_on (sv);
+                }
+                else {
+                    SvAMAGIC_off (sv);
+                }
+
+                if (--how_many == 0) {
+                    /* We have found them all. */
+                    return;
+                }
+            }
+        }
+    }
+}
+
+MODULE = Moose::Meta::Role::Application::ToInstance PACKAGE = Moose::Meta::Role::Application::ToInstance
+
+PROTOTYPES: DISABLE
+
+void
+_reset_amagic (rv)
+        SV *rv
+    CODE:
+        if (Gv_AMG (SvSTASH (SvRV (rv))) && !SvAMAGIC (rv)) {
+            SvAMAGIC_on (rv);
+            S_reset_amagic (aTHX_ rv, TRUE);
+        }
diff --git a/xs/typemap b/xs/typemap
new file mode 100644
index 0000000..7ab39e1
--- /dev/null
+++ b/xs/typemap
@@ -0,0 +1,17 @@
+type_filter_t  T_TYPE_FILTER
+
+INPUT
+
+T_TYPE_FILTER
+    {
+        const char *__tMp = SvPV_nolen($arg);
+        switch (*__tMp) {
+            case 'C': $var = TYPE_FILTER_CODE;   break;
+            case 'A': $var = TYPE_FILTER_ARRAY;  break;
+            case 'I': $var = TYPE_FILTER_IO;     break;
+            case 'H': $var = TYPE_FILTER_HASH;   break;
+            case 'S': $var = TYPE_FILTER_SCALAR; break;
+            default:
+                croak(\"Unknown type %s\\n\", __tMp);
+        }
+    }