test for the metaroles of metaroles thing (ruoso)

[gitmo/Moose.git] / Moose.xs

diff --git a/Moose.xs b/Moose.xs
index ef7a8d9..874e9e0 100644 (file)
--- a/Moose.xs
+++ b/Moose.xs
@@ -1,160 +1,102 @@
-
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
 #include "ppport.h"
 
-static bool ck_sv_defined(SV*);
-static bool ck_sv_is_ref(SV*);
-static bool ck_sv_ref_type(SV*, int);
+#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;
+    }
 
-static bool
-ck_sv_defined(SV* value){
-  return SvOK(value) ? 1 : 0; 
-}
+    for (mg = SvMAGIC(SvRV(sv)); mg; mg = moremagic) {
+        moremagic = mg->mg_moremagic;
 
-static bool
-ck_sv_is_ref(SV* value){
-  bool retval = 0;
-  if( ck_sv_defined(value) && SvROK(value) ){
-    retval = 1;  
-  }
-  return retval;
-}
+        if (mg->mg_type == PERL_MAGIC_ext && mg->mg_virtual == &export_flag_vtbl) {
+            break;
+        }
+    }
 
-static bool
-ck_sv_ref_type(SV* value, int sv_type){
-  bool retval = 0;
-  if( ck_sv_is_ref(value) && SvTYPE( SvRV(value) ) == sv_type){
-    retval = 1;
-  }
-  return retval;
+    return !!mg;
 }
 
-static const char *regclass = "Regexp";
-
-MODULE = Moose PACKAGE = Moose::Util::TypeConstraints::OptimizedConstraints
-PROTOTYPES: ENABLE
-
-bool
-Undef(value)
-  SV* value
-  CODE:
-    RETVAL = !ck_sv_defined(value);
-  OUTPUT:
-    RETVAL
-
-bool
-Defined(value)
-  SV* value
-  CODE:
-    RETVAL = ck_sv_defined(value);
-  OUTPUT:
-    RETVAL
+STATIC int
+unset_export_flag (pTHX_ SV *sv, MAGIC *mymg)
+{
+    MAGIC *mg, *prevmagic = NULL, *moremagic = NULL;
 
-bool
-Value(value)
-  SV* value
-  CODE:
-    RETVAL = (ck_sv_defined(value) && !ck_sv_is_ref(value)) ? 1 : 0;
-  OUTPUT:
-    RETVAL
+    for (mg = SvMAGIC(sv); mg; prevmagic = mg, mg = moremagic) {
+        moremagic = mg->mg_moremagic;
 
-bool
-Str(value)
-  SV* value
-  CODE:
-    RETVAL = (ck_sv_defined(value) && !ck_sv_is_ref(value)) ? 1 : 0;
-  OUTPUT:
-    RETVAL
+        if (mg == mymg) {
+            break;
+        }
+    }
 
-bool
-Ref(value)
-  SV* value
-  CODE:
-    RETVAL = ck_sv_is_ref(value);
-  OUTPUT:
-    RETVAL
+    if (!mg) {
+        return 0;
+    }
 
-bool
-ScalarRef(value)
-  SV* value
-  CODE:
-    RETVAL = 0;
-    if(
-      SvOK(value) && SvROK(value)
-    ){
-      int type = SvTYPE(SvRV(value));
-      if( 
-        type == SVt_IV || 
-        type == SVt_NV || 
-        type == SVt_PV ||
-        type == SVt_NULL
-      ){
-        RETVAL = 1;
-      }
+    if (prevmagic) {
+        prevmagic->mg_moremagic = moremagic;
+    }
+    else {
+        SvMAGIC_set(sv, moremagic);
     }
-  OUTPUT:
-    RETVAL
 
-bool
-ArrayRef(value)
-  SV* value
-  CODE:
-    RETVAL = ck_sv_ref_type(value, SVt_PVAV);
-  OUTPUT:
-    RETVAL
+    mg->mg_moremagic = NULL;
 
-bool
-HashRef(value)
-  SV* value
-  CODE:
-    RETVAL = (ck_sv_ref_type(value, SVt_PVHV) && !sv_isobject(value)) ? 1 : 0;
-  OUTPUT:
-    RETVAL
+    Safefree (mg);
 
-bool
-CodeRef(value)
-  SV* value
-  CODE:
-    RETVAL = ck_sv_ref_type(value, SVt_PVCV);
-  OUTPUT:
-    RETVAL
+    return 0;
+}
 
-bool
-GlobRef(value)
-  SV* value
-  CODE:
-    RETVAL = ck_sv_ref_type(value, SVt_PVGV);
-  OUTPUT:
-    RETVAL
+MODULE = Moose  PACKAGE = Moose::Exporter
 
-bool
-Object(value)
-  SV* value
-  CODE:
-    RETVAL = 0;
-    if( ck_sv_is_ref(value) 
-        && sv_isobject(value)
-        && !sv_isa(value, regclass)
-      ){
-      RETVAL = 1;  
-    }
-  OUTPUT:
-    RETVAL
+void
+_flag_as_reexport (SV *sv)
+    PROTOTYPE: \*
+    CODE:
+        sv_magicext(SvRV(sv), NULL, PERL_MAGIC_ext, &export_flag_vtbl, NULL, 0);
 
 bool
-RegexpRef(value)
-  SV* value
-  CODE:
-    RETVAL = 0;
-    if( ck_sv_is_ref(value)
-        && sv_isobject(value)
-        && sv_isa(value, regclass)
-      ){
-      RETVAL = 1;  
-    }
-  OUTPUT:
-    RETVAL
-
-
+_export_is_flagged (SV *sv)
+    PROTOTYPE: \*
+    CODE:
+        RETVAL = export_flag_is_set(aTHX_ sv);
+    OUTPUT:
+        RETVAL