From: Florian Ragwitz Date: Tue, 10 Mar 2009 00:25:42 +0000 (+0100) Subject: Merge branch 'master' into xs_reorg X-Git-Tag: 0.78_01~72^2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=caa6b5cd10ef5addf2f06670ed5c97e95381936c;p=gitmo%2FClass-MOP.git Merge branch 'master' into xs_reorg * master: Stop segfaulting when trying to get the name from a sub that's still being compiled. Remove optional test plan. Testcase for get_code_info on a sub that's still being compiled Make brace style consistent Conflicts: MOP.xs --- caa6b5cd10ef5addf2f06670ed5c97e95381936c diff --cc mop.c index 11a856b,0000000..425cd48 mode 100644,000000..100644 --- a/mop.c +++ b/mop.c @@@ -1,197 -1,0 +1,203 @@@ +#include "mop.h" + +void +mop_call_xs (pTHX_ void (*subaddr) (pTHX_ CV *), CV *cv, SV **mark) +{ + dSP; + PUSHMARK(mark); + (*subaddr)(aTHX_ cv); + PUTBACK; +} + +#if PERL_VERSION >= 10 +UV +mop_check_package_cache_flag (pTHX_ HV *stash) +{ + assert(SvTYPE(stash) == SVt_PVHV); + + /* here we're trying to implement a c version of mro::get_pkg_gen($stash), + * however the perl core doesn't make it easy for us. It doesn't provide an + * api that just does what we want. + * + * However, we know that the information we want is, inside the core, + * available using HvMROMETA(stash)->pkg_gen. Unfortunately, although the + * HvMROMETA macro is public, it is implemented using Perl_mro_meta_init, + * which is not public and only available inside the core, as the mro + * interface as well as the structure returned by mro_meta_init isn't + * considered to be stable yet. + * + * Perl_mro_meta_init isn't declared static, so we could just define it + * ourselfs if perls headers don't do that for us, except that won't work + * on platforms where symbols need to be explicitly exported when linking + * shared libraries. + * + * So our, hopefully temporary, solution is to be even more evil and + * basically reimplement HvMROMETA in a very fragile way that'll blow up + * when the relevant parts of the mro implementation in core change. + * + * :-( + * + */ + + return HvAUX(stash)->xhv_mro_meta + ? HvAUX(stash)->xhv_mro_meta->pkg_gen + : 0; +} + +#else /* pre 5.10.0 */ + +UV +mop_check_package_cache_flag (pTHX_ HV *stash) +{ + PERL_UNUSED_ARG(stash); + assert(SvTYPE(stash) == SVt_PVHV); + + return PL_sub_generation; +} +#endif + +SV * +mop_call0 (pTHX_ SV *const self, SV *const method) +{ + dSP; + SV *ret; + + PUSHMARK(SP); + XPUSHs(self); + PUTBACK; + + call_sv(method, G_SCALAR | G_METHOD); + + SPAGAIN; + ret = POPs; + PUTBACK; + + return ret; +} + +int +get_code_info (SV *coderef, char **pkg, char **name) +{ + if (!SvOK(coderef) || !SvROK(coderef) || SvTYPE(SvRV(coderef)) != SVt_PVCV) { + return 0; + } + + coderef = SvRV(coderef); ++ ++ /* sub is still being compiled */ ++ if (!CvGV(coderef)) { ++ return 0; ++ } ++ + /* I think this only gets triggered with a mangled coderef, but if + we hit it without the guard, we segfault. The slightly odd return + value strikes me as an improvement (mst) + */ +#ifdef isGV_with_GP + if ( isGV_with_GP(CvGV(coderef)) ) { +#endif + *pkg = HvNAME( GvSTASH(CvGV(coderef)) ); + *name = GvNAME( CvGV(coderef) ); +#ifdef isGV_with_GP + } else { + *pkg = "__UNKNOWN__"; + *name = "__ANON__"; + } +#endif + + return 1; +} + +void +get_package_symbols (HV *stash, type_filter_t filter, get_package_symbols_cb_t cb, void *ud) +{ + HE *he; + + (void)hv_iterinit(stash); + + if (filter == TYPE_FILTER_NONE) { + while ( (he = hv_iternext(stash)) ) { + STRLEN keylen; + const char *key = HePV(he, keylen); + if (!cb(key, keylen, HeVAL(he), ud)) { + return; + } + } + return; + } + + while ( (he = hv_iternext(stash)) ) { + SV *const gv = HeVAL(he); + SV *sv = NULL; + char *key; + STRLEN keylen; + char *package; + SV *fq; + + switch( SvTYPE(gv) ) { +#ifndef SVt_RV + case SVt_RV: +#endif + case SVt_PV: + case SVt_IV: + /* expand the gv into a real typeglob if it + * contains stub functions and we were asked to + * return CODE symbols */ + if (filter == TYPE_FILTER_CODE) { + if (SvROK(gv)) { + /* we don't really care about the length, + but that's the API */ + key = HePV(he, keylen); + package = HvNAME(stash); + fq = newSVpvf("%s::%s", package, key); + sv = (SV *)get_cv(SvPV_nolen(fq), 0); + break; + } + + key = HePV(he, keylen); + gv_init((GV *)gv, stash, key, keylen, GV_ADDMULTI); + } + /* fall through */ + case SVt_PVGV: + switch (filter) { + case TYPE_FILTER_CODE: sv = (SV *)GvCVu(gv); break; + case TYPE_FILTER_ARRAY: sv = (SV *)GvAV(gv); break; + case TYPE_FILTER_IO: sv = (SV *)GvIO(gv); break; + case TYPE_FILTER_HASH: sv = (SV *)GvHV(gv); break; + case TYPE_FILTER_SCALAR: sv = (SV *)GvSV(gv); break; + default: + croak("Unknown type"); + } + break; + default: + continue; + } + + if (sv) { + const char *key = HePV(he, keylen); + if (!cb(key, keylen, sv, ud)) { + return; + } + } + } +} + +static bool +collect_all_symbols (const char *key, STRLEN keylen, SV *val, void *ud) +{ + HV *hash = (HV *)ud; + + if (!hv_store (hash, key, keylen, newRV_inc(val), 0)) { + croak("failed to store symbol ref"); + } + + return TRUE; +} + +HV * +get_all_package_symbols (HV *stash, type_filter_t filter) +{ + HV *ret = newHV (); + get_package_symbols (stash, filter, collect_all_symbols, ret); + return ret; +}