File Coverage

mop.c
Criterion Covered Total %
statement 76 92 82.6
branch 41 88 46.5
condition n/a
subroutine n/a
pod n/a
total 117 180 65.0


line stmt bran cond sub pod time code
1             #include "mop.h"
2             #include "ppport.h"
3              
4             void
5 5412           mop_call_xs (pTHX_ XSPROTO(subaddr), CV *cv, SV **mark)
6             {
7 5412           dSP;
8 5412 50         PUSHMARK(mark);
9 5412           (*subaddr)(aTHX_ cv);
10 5412           PUTBACK;
11 5412           }
12              
13             #if PERL_VERSION_GE(5,10,0)
14             UV
15 488252           mop_check_package_cache_flag (pTHX_ HV *stash)
16             {
17             assert(SvTYPE(stash) == SVt_PVHV);
18              
19             /* here we're trying to implement a c version of mro::get_pkg_gen($stash),
20             * however the perl core doesn't make it easy for us. It doesn't provide an
21             * api that just does what we want.
22             *
23             * However, we know that the information we want is, inside the core,
24             * available using HvMROMETA(stash)->pkg_gen. Unfortunately, although the
25             * HvMROMETA macro is public, it is implemented using Perl_mro_meta_init,
26             * which is not public and only available inside the core, as the mro
27             * interface as well as the structure returned by mro_meta_init isn't
28             * considered to be stable yet.
29             *
30             * Perl_mro_meta_init isn't declared static, so we could just define it
31             * ourselfs if perls headers don't do that for us, except that won't work
32             * on platforms where symbols need to be explicitly exported when linking
33             * shared libraries.
34             *
35             * So our, hopefully temporary, solution is to be even more evil and
36             * basically reimplement HvMROMETA in a very fragile way that'll blow up
37             * when the relevant parts of the mro implementation in core change.
38             *
39             * :-(
40             *
41             */
42              
43 488252 100         return HvAUX(stash)->xhv_mro_meta
44 488181           ? HvAUX(stash)->xhv_mro_meta->pkg_gen
45             : 0;
46             }
47              
48             #else /* pre 5.10.0 */
49              
50             UV
51             mop_check_package_cache_flag (pTHX_ HV *stash)
52             {
53             PERL_UNUSED_ARG(stash);
54             assert(SvTYPE(stash) == SVt_PVHV);
55              
56             return PL_sub_generation;
57             }
58             #endif
59              
60             SV *
61 43301           mop_call0 (pTHX_ SV *const self, SV *const method)
62             {
63 43301           dSP;
64             SV *ret;
65              
66 43301 50         PUSHMARK(SP);
67 43301 50         XPUSHs(self);
68 43301           PUTBACK;
69              
70 43301           call_sv(method, G_SCALAR | G_METHOD);
71              
72 43301           SPAGAIN;
73 43301           ret = POPs;
74 43301           PUTBACK;
75              
76 43301           return ret;
77             }
78              
79             int
80 233731           mop_get_code_info (SV *coderef, char **pkg, char **name)
81             {
82 233731 50         if (!SvOK(coderef) || !SvROK(coderef) || SvTYPE(SvRV(coderef)) != SVt_PVCV) {
    0          
    0          
    50          
    50          
83 0           return 0;
84             }
85              
86 233731           coderef = SvRV(coderef);
87              
88             /* sub is still being compiled */
89 233731 50         if (!CvGV(coderef)) {
90 0           return 0;
91             }
92              
93             /* I think this only gets triggered with a mangled coderef, but if
94             we hit it without the guard, we segfault. The slightly odd return
95             value strikes me as an improvement (mst)
96             */
97              
98 467462 50         if ( isGV_with_GP(CvGV(coderef)) ) {
    50          
    0          
99 233731           GV *gv = CvGV(coderef);
100 233731 100         HV *stash = GvSTASH(gv) ? GvSTASH(gv) : CvSTASH(coderef);
101              
102 233731 100         *pkg = stash ? HvNAME(stash) : "__UNKNOWN__";
    50          
    50          
    50          
    0          
    50          
    50          
103 233731           *name = GvNAME( CvGV(coderef) );
104             } else {
105 0           *pkg = "__UNKNOWN__";
106 0           *name = "__ANON__";
107             }
108              
109 233731           return 1;
110             }
111              
112             /* XXX: eventually this should just use the implementation in Package::Stash */
113             void
114 43955           mop_get_package_symbols (HV *stash, type_filter_t filter, get_package_symbols_cb_t cb, void *ud)
115             {
116             HE *he;
117              
118 43955           (void)hv_iterinit(stash);
119              
120 43955 50         if (filter == TYPE_FILTER_NONE) {
121 0 0         while ( (he = hv_iternext(stash)) ) {
122             STRLEN keylen;
123 0 0         const char *key = HePV(he, keylen);
    0          
124 0 0         if (!cb(key, keylen, HeVAL(he), ud)) {
125 0           return;
126             }
127             }
128 0           return;
129             }
130              
131 780562 100         while ( (he = hv_iternext(stash)) ) {
132 736607           GV * const gv = (GV*)HeVAL(he);
133             STRLEN keylen;
134 736607 50         const char * const key = HePV(he, keylen);
    0          
135 736607           SV *sv = NULL;
136              
137 736607 100         if(isGV(gv)){
138 735420           switch (filter) {
139 735420 100         case TYPE_FILTER_CODE: sv = (SV *)GvCVu(gv); break;
140 0           case TYPE_FILTER_ARRAY: sv = (SV *)GvAV(gv); break;
141 0 0         case TYPE_FILTER_IO: sv = (SV *)GvIO(gv); break;
    0          
    0          
    0          
142 0           case TYPE_FILTER_HASH: sv = (SV *)GvHV(gv); break;
143 0           case TYPE_FILTER_SCALAR: sv = (SV *)GvSV(gv); break;
144             default:
145 735420           croak("Unknown type");
146             }
147             }
148             /* expand the gv into a real typeglob if it
149             * contains stub functions or constants and we
150             * were asked to return CODE references */
151 1187 50         else if (filter == TYPE_FILTER_CODE) {
152 1187           gv_init(gv, stash, key, keylen, GV_ADDMULTI);
153 1187           sv = (SV *)GvCV(gv);
154             }
155              
156 736607 100         if (sv) {
157 501589 50         if (!cb(key, keylen, sv, ud)) {
158 736607           return;
159             }
160             }
161             }
162             }
163              
164             static bool
165 501589           collect_all_symbols (const char *key, STRLEN keylen, SV *val, void *ud)
166             {
167 501589           HV *hash = (HV *)ud;
168              
169 501589 50         if (!hv_store (hash, key, keylen, newRV_inc(val), 0)) {
170 0           croak("failed to store symbol ref");
171             }
172              
173 501589           return TRUE;
174             }
175              
176             HV *
177 43955           mop_get_all_package_symbols (HV *stash, type_filter_t filter)
178             {
179 43955           HV *ret = newHV ();
180 43955           mop_get_package_symbols (stash, filter, collect_all_symbols, ret);
181 43955           return ret;
182             }
183              
184             #define DECLARE_KEY(name) { #name, #name, NULL, 0 }
185             #define DECLARE_KEY_WITH_VALUE(name, value) { #name, value, NULL, 0 }
186              
187             /* the order of these has to match with those in mop.h */
188             static struct {
189             const char *name;
190             const char *value;
191             SV *key;
192             U32 hash;
193             } prehashed_keys[key_last] = {
194             DECLARE_KEY(_expected_method_class),
195             DECLARE_KEY(ISA),
196             DECLARE_KEY(VERSION),
197             DECLARE_KEY(accessor),
198             DECLARE_KEY(associated_class),
199             DECLARE_KEY(associated_metaclass),
200             DECLARE_KEY(associated_methods),
201             DECLARE_KEY(attribute_metaclass),
202             DECLARE_KEY(attributes),
203             DECLARE_KEY(body),
204             DECLARE_KEY(builder),
205             DECLARE_KEY(clearer),
206             DECLARE_KEY(constructor_class),
207             DECLARE_KEY(constructor_name),
208             DECLARE_KEY(definition_context),
209             DECLARE_KEY(destructor_class),
210             DECLARE_KEY(immutable_trait),
211             DECLARE_KEY(init_arg),
212             DECLARE_KEY(initializer),
213             DECLARE_KEY(insertion_order),
214             DECLARE_KEY(instance_metaclass),
215             DECLARE_KEY(is_inline),
216             DECLARE_KEY(method_metaclass),
217             DECLARE_KEY(methods),
218             DECLARE_KEY(name),
219             DECLARE_KEY(package),
220             DECLARE_KEY(package_name),
221             DECLARE_KEY(predicate),
222             DECLARE_KEY(reader),
223             DECLARE_KEY(wrapped_method_metaclass),
224             DECLARE_KEY(writer),
225             DECLARE_KEY_WITH_VALUE(package_cache_flag, "_package_cache_flag"),
226             DECLARE_KEY_WITH_VALUE(_version, "-version"),
227             DECLARE_KEY(operator)
228             };
229              
230             SV *
231 1376594           mop_prehashed_key_for (mop_prehashed_key_t key)
232             {
233 1376594           return prehashed_keys[key].key;
234             }
235              
236             U32
237 1333293           mop_prehashed_hash_for (mop_prehashed_key_t key)
238             {
239 1333293           return prehashed_keys[key].hash;
240             }
241              
242             void
243 451           mop_prehash_keys ()
244             {
245             int i;
246 15785 100         for (i = 0; i < key_last; i++) {
247 15334           const char *value = prehashed_keys[i].value;
248 15334           prehashed_keys[i].key = newSVpv(value, strlen(value));
249 15334           PERL_HASH(prehashed_keys[i].hash, value, strlen(value));
250             }
251 451           }
252              
253 6098261           XS_EXTERNAL(mop_xs_simple_reader)
254             {
255             dVAR;
256 6098261           dXSARGS;
257             register HE *he;
258 6098261           mop_prehashed_key_t key = (mop_prehashed_key_t)CvXSUBANY(cv).any_i32;
259             SV *self;
260              
261 6098261 50         if (items != 1) {
262 0           croak("expected exactly one argument");
263             }
264              
265 6098261           self = ST(0);
266              
267 6098261 100         if (!SvROK(self)) {
268 18           croak("can't call %s as a class method", prehashed_keys[key].name);
269             }
270              
271 6098243 50         if (SvTYPE(SvRV(self)) != SVt_PVHV) {
272 0           croak("object is not a hashref");
273             }
274              
275 6098243 100         if ((he = hv_fetch_ent((HV *)SvRV(self), prehashed_keys[key].key, 0, prehashed_keys[key].hash))) {
276 6097032           ST(0) = HeVAL(he);
277             }
278             else {
279 1211           ST(0) = &PL_sv_undef;
280             }
281              
282 6098243           XSRETURN(1);
283             }
284