X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xs-src%2FMouse.xs;h=e94d4769d1f0b83654f11310495b4b18c38b4786;hb=cc1318893656996b0892fa5809c1f12d4b765a9f;hp=1759d04fb247de4589588f87a02a04596d3743c4;hpb=cb60d0b55962e6ff8cdc07e51e59f7dd5feafd43;p=gitmo%2FMouse.git diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs index 1759d04..e94d476 100644 --- a/xs-src/Mouse.xs +++ b/xs-src/Mouse.xs @@ -430,10 +430,7 @@ mouse_get_modifier_storage(pTHX_ SV* table; SV* storage_ref; - SvGETMAGIC(name); - if(!SvOK(name)){ - mouse_throw_error(meta, NULL, "You must define a method name for '%s' modifiers", keys[m]); - } + must_defined(name, "a method name"); table = get_slot(meta, key); @@ -512,65 +509,22 @@ CODE: croak("No package name defined"); } - SvGETMAGIC(name); - SvGETMAGIC(code); - - if(!SvOK(name)){ - mouse_throw_error(self, NULL, "You must define a method name"); - } - if(!SvROK(code)){ - mouse_throw_error(self, NULL, "You must define a CODE reference"); - } + must_defined(name, "a method name"); + must_ref (code, "a CODE reference", SVt_NULL); /* any reftype is OK */ code_ref = code; if(SvTYPE(SvRV(code_ref)) != SVt_PVCV){ SV* sv = code_ref; /* used in tryAMAGICunDEREF */ SV** sp = &sv; /* used in tryAMAGICunDEREF */ tryAMAGICunDEREF(to_cv); /* try \&{$code} */ - if(!(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV)){ - mouse_throw_error(self, NULL, "You must pass a CODE reference to add_method"); - } + must_ref(code, "a CODE reference", SVt_PVCV); code_ref = sv; } /* *{$package . '::' . $name} -> *gv */ gv = gv_fetchpv(form("%"SVf"::%"SVf, package, name), GV_ADDMULTI, SVt_PVCV); - if(GvCVu(gv)){ /* delete *slot{gv} to work around "redefine" warning */ - SvREFCNT_dec(GvCV(gv)); - GvCV(gv) = NULL; - } - sv_setsv_mg((SV*)gv, code_ref); /* *gv = $code_ref */ - + mouse_install_sub(aTHX_ gv, code_ref); (void)set_slot(methods, name, code); /* $self->{methods}{$name} = $code */ - - /* name the CODE ref if it's anonymous */ - { - CV* const code_entity = (CV*)SvRV(code_ref); - if(CvANON(code_entity) - && CvGV(code_entity) /* a cv under construction has no gv */ ){ - HV* dbsub; - - /* update %DB::sub to make NYTProf happy */ - if((PL_perldb & (PERLDBf_SUBLINE|PERLDB_NAMEANON)) - && PL_DBsub && (dbsub = GvHV(PL_DBsub)) - ){ - /* see Perl_newATTRSUB() in op.c */ - SV* const subname = sv_newmortal(); - HE* orig; - - gv_efullname3(subname, CvGV(code_entity), NULL); - orig = hv_fetch_ent(dbsub, subname, FALSE, 0U); - if(orig){ - gv_efullname3(subname, gv, NULL); - (void)hv_store_ent(dbsub, subname, HeVAL(orig), 0U); - SvREFCNT_inc_simple_void_NN(HeVAL(orig)); - } - } - - CvGV(code_entity) = gv; - CvANON_off(code_entity); - } - } } MODULE = Mouse PACKAGE = Mouse::Meta::Class @@ -827,8 +781,6 @@ CODE: SV* const meta = get_metaclass(self); AV* const xc = mouse_get_xc(aTHX_ meta); - if(!IsHashRef(args)){ - croak("You must pass a HASH reference to BUILDALL"); - } + must_ref(args, "a HASH reference to BUILDALL", SVt_PVHV); mouse_buildall(aTHX_ xc, self, args); }