X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=xs-src%2FMouseUtil.xs;h=92fa6769cb7f45a811b7a42d576d43d47daa4c7b;hp=93160fc13677103482531569328ba5579fcf04b8;hb=077f2efda66008ab1a1fb959851a7c9062404588;hpb=ebe91068002fbe34a924a0a9e2cd79553867938c diff --git a/xs-src/MouseUtil.xs b/xs-src/MouseUtil.xs index 93160fc..92fa676 100644 --- a/xs-src/MouseUtil.xs +++ b/xs-src/MouseUtil.xs @@ -91,8 +91,6 @@ mouse_throw_error(SV* const metaobject, SV* const data /* not used */, const cha va_list args; SV* message; - PERL_UNUSED_ARG(data); /* for moose-compat */ - assert(metaobject); assert(fmt); @@ -103,13 +101,17 @@ mouse_throw_error(SV* const metaobject, SV* const data /* not used */, const cha { dSP; PUSHMARK(SP); - EXTEND(SP, 4); + EXTEND(SP, 6); PUSHs(metaobject); mPUSHs(message); - mPUSHs(newSVpvs("depth")); - mPUSHi(-1); + if(data){ /* extra arg, might be useful for debugging */ + mPUSHs(newSVpvs("data")); + PUSHs(data); + mPUSHs(newSVpvs("depth")); + mPUSHi(-1); + } PUTBACK; @@ -202,8 +204,7 @@ mouse_call1 (pTHX_ SV* const self, SV* const method, SV* const arg1) { int mouse_predicate_call(pTHX_ SV* const self, SV* const method) { - SV* const value = mcall0(self, method); - return SvTRUE(value); + return sv_true( mcall0(self, method) ); } SV* @@ -286,6 +287,29 @@ CODE: } bool +is_valid_class_name(SV* sv) +CODE: +{ + SvGETMAGIC(sv); + if(SvPOKp(sv) && SvCUR(sv) > 0){ + UV i; + RETVAL = TRUE; + for(i = 0; i < SvCUR(sv); i++){ + char const c = SvPVX(sv)[i]; + if(!(isALNUM(c) || c == ':')){ + RETVAL = FALSE; + break; + } + } + } + else{ + RETVAL = SvNIOKp(sv) ? TRUE : FALSE; + } +} +OUTPUT: + RETVAL + +bool is_class_loaded(SV* sv) void @@ -378,6 +402,6 @@ PPCODE: } if(predicate_name == NULL){ /* anonymous predicate */ - XPUSHs( newRV_noinc((SV*)xsub) ); + mXPUSHs( newRV_inc((SV*)xsub) ); } }