Mouse::Util::does_role() respects $thing->does() method

[gitmo/Mouse.git] / xs-src / MouseAttribute.xs

diff --git a/xs-src/MouseAttribute.xs b/xs-src/MouseAttribute.xs
index 7b25881..7a453fd 100644 (file)
--- a/xs-src/MouseAttribute.xs
+++ b/xs-src/MouseAttribute.xs
@@ -15,7 +15,7 @@ mouse_build_xa(pTHX_ SV* const attr) {
     ENTER;
     SAVETMPS;
 
-    xa    = newAV();
+    xa = newAV();
 
     mg = sv_magicext(SvRV(attr), (SV*)xa, PERL_MAGIC_ext, &mouse_xa_vtbl, NULL, 0);
     SvREFCNT_dec(xa); /* refcnt++ in sv_magicext */
@@ -184,6 +184,44 @@ mouse_xa_set_default(pTHX_ AV* const xa, SV* const object) {
     return value;
 }
 
+/* checks $isa->does($does) */
+static void
+mouse_check_isa_does_does(pTHX_ SV* const klass, SV* const name, SV* const isa, SV* const does){
+    STRLEN len;
+    const char* const pv = SvPV_const(isa, len); /* need strigify */
+    bool does_ok;
+    dSP;
+
+    ENTER;
+    SAVETMPS;
+
+    SAVESPTR(ERRSV);
+    ERRSV = sv_newmortal();
+
+    PUSHMARK(SP);
+    EXTEND(SP, 2);
+    mPUSHp(pv, len);
+    PUSHs(does);
+    PUTBACK;
+
+    call_method("does", G_EVAL | G_SCALAR);
+
+    SPAGAIN;
+    does_ok = sv_true(POPs);
+    PUTBACK;
+
+    FREETMPS;
+    LEAVE;
+
+    if(!does_ok){
+        mouse_throw_error(klass, NULL,
+            "Cannot have both an isa option and a does option"
+            "because '%"SVf"' does not do '%"SVf"' on attribute (%"SVf")",
+            isa, does, name
+        );
+    }
+}
+
 MODULE = Mouse::Meta::Attribute  PACKAGE = Mouse::Meta::Attribute
 
 PROTOTYPES: DISABLE
@@ -212,6 +250,7 @@ BOOT:
     INSTALL_SIMPLE_READER_WITH_KEY(Attribute, should_auto_deref, auto_deref);
     INSTALL_SIMPLE_READER_WITH_KEY(Attribute, should_coerce, coerce);
     INSTALL_SIMPLE_READER(Attribute, documentation);
+    INSTALL_SIMPLE_READER(Attribute, insertion_order);
 
     /* predicates */
     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_accessor, accessor);
@@ -233,6 +272,7 @@ void
 _process_options(SV* klass, SV* name, HV* args)
 CODE:
 {
+    /* TODO: initialize 'xa' here */
     SV** svp;
     SV* tc = NULL;
 
@@ -243,10 +283,7 @@ CODE:
 
     /* taken from Class::MOP::Attribute::new */
 
-    if(!SvOK(name)){
-        mouse_throw_error(klass, NULL,
-            "You must provide a name for the attribute");
-    }
+    must_defined(name, "an attribute name");
 
     svp = hv_fetchs(args, "init_arg", FALSE);
     if(!svp){
@@ -260,7 +297,7 @@ CODE:
     svp = hv_fetchs(args, "builder", FALSE);
     if(svp){
         if(!SvOK(*svp)){
-            mouse_throw_error(klass, NULL,
+            mouse_throw_error(klass, *svp,
                 "builder must be a defined scalar value which is a method name");
         }
         can_be_required = TRUE;
@@ -268,7 +305,7 @@ CODE:
     }
     else if((svp = hv_fetchs(args, "default", FALSE))){
         if(SvROK(*svp) && SvTYPE(SvRV(*svp)) != SVt_PVCV) {
-            mouse_throw_error(klass, NULL,
+            mouse_throw_error(klass, *svp,
                "References are not allowed as default values, you must "
                 "wrap the default of '%"SVf"' in a CODE reference "
                 "(ex: sub { [] } and not [])", name);
@@ -284,7 +321,7 @@ CODE:
             "without a default, builder, or an init_arg", name);
     }
 
-     /* taken from Mouse::Meta::Attribute->new and ->_process_args */
+    /* taken from Mouse::Meta::Attribute->new and ->_process_args */
 
     svp = hv_fetchs(args, "is", FALSE);
     if(svp){
@@ -302,10 +339,12 @@ CODE:
             else{
                 svp = hv_fetchs(args, "accessor", TRUE);
             }
-            sv_setsv(*svp, name);
+            if(!SvOK(*svp)) {
+                sv_setsv(*svp, name);
+            }
         }
         else if(strEQ(is, "bare")){
-            /* do nothing, but don't complain (later) about missing methods */
+            /* do nothing, but might complain later about missing methods */
         }
         else{
             mouse_throw_error(klass, NULL,
@@ -327,17 +366,25 @@ CODE:
         tc = newSVsv(POPs);
         PUTBACK;
     }
-    else if((svp = hv_fetchs(args, "does", FALSE))){
-        SPAGAIN;
-        PUSHMARK(SP);
-        XPUSHs(*svp);
-        PUTBACK;
 
-        call_pv("Mouse::Util::TypeConstraints::find_or_create_does_type_constraint",
-            G_SCALAR);
-        SPAGAIN;
-        tc = newSVsv(POPs);
-        PUTBACK;
+    if((svp = hv_fetchs(args, "does", FALSE))){
+        /* check 'isa' does 'does' */
+        if(tc){
+            mouse_check_isa_does_does(aTHX_ klass, name, tc, *svp);
+            /* nothing to do */
+        }
+        else{
+            SPAGAIN;
+            PUSHMARK(SP);
+            XPUSHs(*svp);
+            PUTBACK;
+
+            call_pv("Mouse::Util::TypeConstraints::find_or_create_does_type_constraint",
+                G_SCALAR);
+            SPAGAIN;
+            tc = newSVsv(POPs);
+            PUTBACK;
+        }
     }
     if(tc){
         (void)hv_stores(args, "type_constraint", tc);
@@ -429,7 +476,7 @@ CODE:
     if(svp && sv_true(*svp)){
         if(!(has_default || has_builder)){
             mouse_throw_error(klass, NULL,
-                "You cannot have lazy attribute (%"SVf") without specifying "
+                "You cannot have a lazy attribute (%"SVf") without specifying "
                 "a default value for it", name);
         }
     }