Mouse::Util::does_role() respects $thing->does() method
[gitmo/Mouse.git] / xs-src / MouseTypeConstraints.xs
index f7e99a8..8ff2975 100644 (file)
 #define SvRXOK(sv) (SvROK(sv) && SvMAGICAL(SvRV(sv)) && mg_find(SvRV(sv), PERL_MAGIC_qr))
 #endif
 
+#define MY_CXT_KEY "Mouse::Util::TypeConstraints::_guts" XS_VERSION
+typedef struct sui_cxt{
+    GV* universal_isa;
+    GV* universal_can;
+    AV* tc_extra_args;
+} my_cxt_t;
+START_MY_CXT
+
 typedef int (*check_fptr_t)(pTHX_ SV* const data, SV* const sv);
 
+static
+XSPROTO(XS_Mouse_constraint_check);
+
 /*
     NOTE: mouse_tc_check() handles GETMAGIC
 */
@@ -33,12 +44,21 @@ mouse_tc_check(pTHX_ SV* const tc_code, SV* const sv) {
     else { /* custom */
         int ok;
         dSP;
+        dMY_CXT;
 
         ENTER;
         SAVETMPS;
 
         PUSHMARK(SP);
         XPUSHs(sv);
+        if( MY_CXT.tc_extra_args ) {
+            AV* const av  = MY_CXT.tc_extra_args;
+            I32 const len = AvFILLp(av) + 1;
+            int i;
+            for(i = 0; i < len; i++) {
+                XPUSHs( AvARRAY(av)[i] );
+            }
+        }
         PUTBACK;
 
         call_sv(tc_code, G_SCALAR);
@@ -55,8 +75,10 @@ mouse_tc_check(pTHX_ SV* const tc_code, SV* const sv) {
 }
 
 /*
-    The following type check functions return an integer, not a bool, to keep them simple,
-    so if you assign these return value to bool variable, you must use "expr ? TRUE : FALSE".
+    The following type check functions return an integer, not a bool, to keep
+    the code simple,
+    so if you assign these return value to a bool variable, you must use
+    "expr ? TRUE : FALSE".
 */
 
 int
@@ -120,7 +142,7 @@ S_nv_is_integer(pTHX_ NV const nv) {
     }
     else {
         char buf[64];  /* Must fit sprintf/Gconvert of longest NV */
-        char* p;
+        const char* p;
         (void)Gconvert(nv, NV_DIG, 0, buf);
         p = &buf[0];
 
@@ -174,7 +196,7 @@ mouse_tc_RoleName(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
         ENTER;
         SAVETMPS;
 
-        ok =  is_an_instance_of("Mouse::Meta::Role", get_metaclass(sv));
+        ok = is_an_instance_of("Mouse::Meta::Role", get_metaclass(sv));
 
         FREETMPS;
         LEAVE;
@@ -276,7 +298,7 @@ mouse_parameterized_ArrayRef(pTHX_ SV* const param, SV* const sv) {
 
 static int
 mouse_parameterized_HashRef(pTHX_ SV* const param, SV* const sv) {
-    if(mouse_tc_HashRef(aTHX_ NULL, sv)){
+    if(IsHashRef(sv)){
         HV* const hv  = (HV*)SvRV(sv);
         HE* he;
 
@@ -340,12 +362,6 @@ mouse_types_check(pTHX_ AV* const types, SV* const sv) {
  *  This class_type generator is taken from Scalar::Util::Instance
  */
 
-#define MY_CXT_KEY "Mouse::Util::TypeConstraints::_guts" XS_VERSION
-typedef struct sui_cxt{
-    GV* universal_isa;
-    GV* universal_can;
-} my_cxt_t;
-START_MY_CXT
 
 #define MG_klass_stash(mg) ((HV*)(mg)->mg_obj)
 #define MG_klass_pv(mg)    ((mg)->mg_ptr)
@@ -542,8 +558,8 @@ mouse_generate_can_predicate_for(pTHX_ SV* const methods, const char* const pred
     return mouse_tc_generate(aTHX_ predicate_name, (check_fptr_t)mouse_can_methods, (SV*)param);
 }
 
-
-XS(XS_Mouse_constraint_check) {
+static
+XSPROTO(XS_Mouse_constraint_check) {
     dVAR;
     dXSARGS;
     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
@@ -559,8 +575,8 @@ XS(XS_Mouse_constraint_check) {
     XSRETURN(1);
 }
 
-XS(XS_Mouse_TypeConstraint_fallback); /* -Wmissing-prototypes */
-XS(XS_Mouse_TypeConstraint_fallback) {
+static
+XSPROTO(XS_Mouse_TypeConstraint_fallback) {
     dXSARGS;
     PERL_UNUSED_VAR(cv);
     PERL_UNUSED_VAR(items);
@@ -574,6 +590,8 @@ setup_my_cxt(pTHX_ pMY_CXT){
 
     MY_CXT.universal_can = gv_fetchpvs("UNIVERSAL::can", GV_ADD, SVt_PVCV);
     SvREFCNT_inc_simple_void_NN(MY_CXT.universal_can);
+
+    MY_CXT.tc_extra_args = NULL;
 }
 
 #define DEFINE_TC(name) mouse_tc_generate(aTHX_ "Mouse::Util::TypeConstraints::" STRINGIFY(name), CAT2(mouse_tc_, name), NULL)
@@ -668,7 +686,6 @@ BOOT:
     INSTALL_SIMPLE_READER(TypeConstraint, type_parameter);
 
     INSTALL_SIMPLE_READER_WITH_KEY(TypeConstraint, _compiled_type_constraint, compiled_type_constraint);
-    INSTALL_SIMPLE_READER(TypeConstraint, _compiled_type_coercion); /* Mouse specific */
 
     INSTALL_SIMPLE_PREDICATE_WITH_KEY(TypeConstraint, has_coercion, _compiled_type_coercion);
     INSTALL_SIMPLE_PREDICATE_WITH_KEY(TypeConstraint, __is_parameterized, type_parameter); /* Mouse specific */
@@ -735,7 +752,7 @@ CODE:
     for(parent = get_slots(self, "parent"); parent; parent = get_slots(parent, "parent")){
         check = get_slots(parent, "hand_optimized_type_constraint");
         if(check && SvOK(check)){
-            if(!mouse_tc_CodeRef(aTHX_ NULL, check)){
+            if(!IsCodeRef(check)){
                 croak("Not a CODE reference");
             }
             av_unshift(checks, 1);
@@ -800,12 +817,24 @@ CODE:
 }
 
 bool
-check(SV* self, SV* sv)
+check(SV* self, SV* sv, ...)
 CODE:
 {
     SV* const check = get_slots(self, "compiled_type_constraint");
-    if(!(check && mouse_tc_CodeRef(aTHX_ NULL, check))){
-        mouse_throw_error(self, check, "'%"SVf"' has no compiled type constraint", self);
+    if(!(check && IsCodeRef(check))){
+        mouse_throw_error(self, check,
+            "'%"SVf"' has no compiled type constraint", self);
+    }
+    if( items > 2 ) {
+        int i;
+        AV* av;
+        dMY_CXT;
+        SAVESPTR(MY_CXT.tc_extra_args);
+        av = MY_CXT.tc_extra_args = newAV_mortal();
+        av_extend(av, items - 3);
+        for(i = 2; i < items; i++) {
+            av_push(av, SvREFCNT_inc_NN( ST(i) ) );
+        }
     }
     RETVAL = mouse_tc_check(aTHX_ check, sv) ? TRUE : FALSE;
 }