File Coverage

ext/mro/mro.xs
Criterion Covered Total %
statement 228 257 88.7
branch n/a
condition n/a
subroutine n/a
total 228 257 88.7


line stmt bran cond sub time code
1           #define PERL_NO_GET_CONTEXT
2            
3           #include "EXTERN.h"
4           #include "perl.h"
5           #include "XSUB.h"
6            
7           static AV*
8           S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level);
9            
10           static const struct mro_alg c3_alg =
11           {S_mro_get_linear_isa_c3, "c3", 2, 0, 0};
12            
13           /*
14           =for apidoc mro_get_linear_isa_c3
15            
16           Returns the C3 linearization of @ISA
17           the given stash. The return value is a read-only AV*.
18           C should be 0 (it is used internally in this
19           function's recursion).
20            
21 8624         You are responsible for C on the
22           return value if you plan to store it anywhere
23           semi-permanently (otherwise it might be deleted
24           out from under you the next time the cache is
25           invalidated).
26            
27           =cut
28           */
29            
30           static AV*
31           S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
32 8624         {
33 8624         AV* retval;
34 8624         GV** gvp;
35 0         GV* gv;
36           AV* isa;
37 8624         const HEK* stashhek;
38 32         struct mro_meta* meta;
39 32          
40           assert(HvAUX(stash));
41 8592          
42           stashhek = HvENAME_HEK(stash);
43           if (!stashhek) stashhek = HvNAME_HEK(stash);
44 8592         if (!stashhek)
45           Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
46            
47           if (level > 100)
48           Perl_croak(aTHX_ "Recursive inheritance detected in package '%"SVf"'",
49           SVfARG(sv_2mortal(newSVhek(stashhek))));
50 4542          
51 4542         meta = HvMROMETA(stash);
52            
53           /* return cache if valid */
54           if((retval = MUTABLE_AV(MRO_GET_PRIVATE_DATA(meta, &c3_alg)))) {
55           return retval;
56           }
57            
58           /* not in cache, make a new one */
59 5002          
60           gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
61           isa = (gvp && (gv = *gvp) && isGV_with_GP(gv)) ? GvAV(gv) : NULL;
62            
63 4126         /* For a better idea how the rest of this works, see the much clearer
64           pure perl version in Algorithm::C3 0.01:
65           http://search.cpan.org/src/STEVAN/Algorithm-C3-0.01/lib/Algorithm/C3.pm
66           (later versions go about it differently than this code for speed reasons)
67           */
68            
69           if(isa && AvFILLp(isa) >= 0) {
70 4126         SV** seqs_ptr;
71 4126         I32 seqs_items;
72 10642         HV *tails;
73 6052         AV *const seqs = MUTABLE_AV(sv_2mortal(MUTABLE_SV(newAV())));
74 6052         I32* heads;
75 6052          
76           /* This builds @seqs, which is an array of arrays.
77           The members of @seqs are the MROs of
78 8         the members of @ISA, followed by @ISA itself.
79 8         */
80 8         SSize_t items = AvFILLp(isa) + 1;
81           SV** isa_ptr = AvARRAY(isa);
82           while(items--) {
83           SV* const isa_item = *isa_ptr++;
84 6044         HV* const isa_item_stash = gv_stashsv(isa_item, 0);
85 6044         if(!isa_item_stash) {
86           /* if no stash, make a temporary fake MRO
87 2812         containing just itself */
88           AV* const isa_lin = newAV();
89           av_push(isa_lin, newSVsv(isa_item));
90           av_push(seqs, MUTABLE_SV(isa_lin));
91           }
92           else {
93 430         /* recursion */
94 430         AV* const isa_lin
95           = S_mro_get_linear_isa_c3(aTHX_ isa_item_stash, level + 1);
96            
97           if(items == 0 && AvFILLp(seqs) == -1) {
98           /* Only one parent class. For this case, the C3
99           linearisation is this class followed by the parent's
100           linearisation, so don't bother with the expensive
101 430         calculation. */
102 430         SV **svp;
103 430         I32 subrv_items = AvFILLp(isa_lin) + 1;
104           SV *const *subrv_p = AvARRAY(isa_lin);
105            
106           /* Hijack the allocated but unused array seqs to be the
107           return value. It's currently mortalised. */
108 430          
109           retval = seqs;
110 2250          
111           av_extend(retval, subrv_items);
112           AvFILLp(retval) = subrv_items;
113           svp = AvARRAY(retval);
114            
115           /* First entry is this class. We happen to make a shared
116 1390         hash key scalar because it's the cheapest and fastest
117 1390         way to do it. */
118           *svp++ = newSVhek(stashhek);
119            
120           while(subrv_items--) {
121           /* These values are unlikely to be shared hash key
122           scalars, so no point in adding code to optimising
123           for a case that is unlikely to be true.
124 2382         (Or prove me wrong and do it.) */
125            
126           SV *const val = *subrv_p++;
127 464         *svp++ = newSVsv(val);
128 464         }
129            
130           SvREFCNT_inc(retval);
131            
132           goto done;
133 928         }
134           av_push(seqs, SvREFCNT_inc_simple_NN(MUTABLE_SV(isa_lin)));
135           }
136           }
137           av_push(seqs, SvREFCNT_inc_simple_NN(MUTABLE_SV(isa)));
138           tails = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
139            
140 464         /* This builds "heads", which as an array of integer array
141 464         indices, one per seq, which point at the virtual "head"
142 3116         of the seq (initially zero) */
143 2188         Newxz(heads, AvFILLp(seqs)+1, I32);
144 2188          
145 2188         /* This builds %tails, which has one key for every class
146 1412         mentioned in the tail of any sequence in @seqs (tail meaning
147 8100         everything after the first class, the "head"). The value
148 5276         is how many times this key appears in the tails of @seqs.
149           */
150           seqs_ptr = AvARRAY(seqs);
151 5276         seqs_items = AvFILLp(seqs) + 1;
152 5276         while(seqs_items--) {
153 5276         AV *const seq = MUTABLE_AV(*seqs_ptr++);
154           I32 seq_items = AvFILLp(seq);
155           if(seq_items > 0) {
156           SV** seq_ptr = AvARRAY(seq) + 1;
157           while(seq_items--) {
158 5276         SV* const seqitem = *seq_ptr++;
159 1904         /* LVALUE fetch will create a new undefined SV if necessary
160           */
161 3372         HE* const he = hv_fetch_ent(tails, seqitem, 1, 0);
162           if(he) {
163           SV* const val = HeVAL(he);
164           /* For 5.8.0 and later, sv_inc() with increment undef to
165           an IV of 1, which is what we want for a newly created
166           entry. However, for 5.6.x it will become an NV of
167           1.0, which confuses the SvIVX() checks above. */
168           if(SvIOK(val)) {
169 464         SvIV_set(val, SvIVX(val) + 1);
170 464         } else {
171           sv_setiv(val, 1);
172           }
173           }
174           }
175           }
176           }
177            
178           /* Initialize retval to build the return value in */
179           retval = newAV();
180 4292         av_push(retval, newSVhek(stashhek)); /* us first */
181 30180          
182           /* This loop won't terminate until we either finish building
183 25888         the MRO, or get an exception. */
184           while(1) {
185 25888         SV* cand = NULL;
186 18744         SV* winner = NULL;
187 18744         int s;
188 18744          
189           /* "foreach $seq (@seqs)" */
190           SV** const avptr = AvARRAY(seqs);
191           for(s = 0; s <= AvFILLp(seqs); s++) {
192           SV** svp;
193           AV * const seq = MUTABLE_AV(avptr[s]);
194           SV* seqhead;
195           if(!seq) continue; /* skip empty seqs */
196           svp = av_fetch(seq, heads[s], 0);
197 5992         seqhead = *svp; /* seqhead = head of this seq */
198 5528         if(!winner) {
199 5528         HE* tail_entry;
200 2164         SV* val;
201 3828         /* if we haven't found a winner for this round yet,
202 3828         and this seqhead is not in tails (or the count
203           for it in tails has dropped to zero), then this
204           seqhead is our new winner, and is added to the
205           final MRO immediately */
206 16580         cand = seqhead;
207           if((tail_entry = hv_fetch_ent(tails, cand, 0, 0))
208           && (val = HeVAL(tail_entry))
209           && (SvIVX(val) > 0))
210           continue;
211           winner = newSVsv(cand);
212           av_push(retval, winner);
213 7448         /* note however that even when we find a winner,
214 7448         we continue looping over @seqs to do housekeeping */
215 2180         }
216 2180         if(!sv_cmp(seqhead, winner)) {
217           /* Once we have a winner (including the iteration
218           where we first found him), inc the head ptr
219           for any seq which had the winner as a head,
220           NULL out any seq which is now empty,
221           and adjust tails for consistency */
222            
223           const int new_head = ++heads[s];
224 5268         if(new_head > AvFILLp(seq)) {
225 5268         SvREFCNT_dec(avptr[s]);
226 5268         avptr[s] = NULL;
227 5268         }
228 5268         else {
229           HE* tail_entry;
230           SV* val;
231           /* Because we know this new seqhead used to be
232           a tail, we can assume it is in tails and has
233           a positive value, which we need to dec */
234           svp = av_fetch(seq, new_head, 0);
235 4292         seqhead = *svp;
236 460         tail_entry = hv_fetch_ent(tails, seqhead, 0, 0);
237           val = HeVAL(tail_entry);
238           sv_dec(val);
239           }
240           }
241           }
242 3832          
243           /* if we found no candidates, we are done building the MRO.
244           !cand means no seqs have any entries left to check */
245           if(!cand) {
246 4         Safefree(heads);
247           break;
248           }
249 4          
250 16         /* If we had candidates, but nobody won, then the @ISA
251 12         hierarchy is not C3-incompatible */
252 12         if(!winner) {
253           SV *errmsg;
254 4         I32 i;
255            
256           errmsg = newSVpvf(
257           "Inconsistent hierarchy during C3 merge of class '%"SVf"':\n\t"
258 4         "current merge results [\n",
259 4         SVfARG(sv_2mortal(newSVhek(stashhek))));
260           for (i = 0; i <= av_len(retval); i++) {
261 4         SV **elem = av_fetch(retval, i, 0);
262           sv_catpvf(errmsg, "\t\t%"SVf",\n", SVfARG(*elem));
263           }
264           sv_catpvf(errmsg, "\t]\n\tmerging failed on '%"SVf"'", SVfARG(cand));
265            
266           /* we have to do some cleanup before we croak */
267 416          
268 416         SvREFCNT_dec(retval);
269           Safefree(heads);
270            
271           Perl_croak(aTHX_ "%"SVf, SVfARG(errmsg));
272           }
273           }
274 1306         }
275           else { /* @ISA was undefined or empty */
276 1306         /* build a retval containing only ourselves */
277           retval = newAV();
278           av_push(retval, newSVhek(stashhek));
279           }
280            
281           done:
282           /* we don't want anyone modifying the cache entry but us,
283           and we do so by replacing it completely */
284           SvREADONLY_on(retval);
285            
286           return MUTABLE_AV(Perl_mro_set_private_data(aTHX_ meta, &c3_alg,
287           MUTABLE_SV(retval)));
288           }
289 144          
290 536          
291           /* These two are static helpers for next::method and friends,
292           and re-implement a bunch of the code from pp_caller() in
293           a more efficient manner for this particular usage.
294           */
295            
296           static I32
297           __dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock) {
298           I32 i;
299           for (i = startingblock; i >= 0; i--) {
300           if(CxTYPE((PERL_CONTEXT*)(&cxstk[i])) == CXt_SUB) return i;
301           }
302           return i;
303           }
304            
305           MODULE = mro PACKAGE = mro PREFIX = mro_
306            
307           void
308           mro_get_linear_isa(...)
309           PROTOTYPE: $;$
310           PREINIT:
311           AV* RETVAL;
312           HV* class_stash;
313           SV* classname;
314           PPCODE:
315 2450         if(items < 1 || items > 2)
316 0         croak_xs_usage(cv, "classname [, type ]");
317            
318 2450         classname = ST(0);
319 2450         class_stash = gv_stashsv(classname, 0);
320            
321 2450         if(!class_stash) {
322           /* No stash exists yet, give them just the classname */
323 4         AV* isalin = newAV();
324 4         av_push(isalin, newSVsv(classname));
325 4         ST(0) = sv_2mortal(newRV_noinc(MUTABLE_SV(isalin)));
326 4         XSRETURN(1);
327           }
328 2446         else if(items > 1) {
329 28         const struct mro_alg *const algo = Perl_mro_get_from_name(aTHX_ ST(1));
330 28         if (!algo)
331 8         Perl_croak(aTHX_ "Invalid mro name: '%"SVf"'", ST(1));
332 20         RETVAL = algo->resolve(aTHX_ class_stash, 0);
333           }
334           else {
335 2418         RETVAL = mro_get_linear_isa(class_stash);
336           }
337 2434         ST(0) = newRV_inc(MUTABLE_SV(RETVAL));
338 2434         sv_2mortal(ST(0));
339 2434         XSRETURN(1);
340            
341           void
342           mro_set_mro(...)
343           PROTOTYPE: $$
344           PREINIT:
345           SV* classname;
346           HV* class_stash;
347           struct mro_meta* meta;
348           PPCODE:
349 696         if (items != 2)
350 0         croak_xs_usage(cv, "classname, type");
351            
352 696         classname = ST(0);
353 696         class_stash = gv_stashsv(classname, GV_ADD);
354 696         if(!class_stash) Perl_croak(aTHX_ "Cannot create class: '%"SVf"'!", SVfARG(classname));
355 696         meta = HvMROMETA(class_stash);
356            
357 696         Perl_mro_set_mro(aTHX_ meta, ST(1));
358            
359 696         XSRETURN_EMPTY;
360            
361           void
362           mro_get_mro(...)
363           PROTOTYPE: $
364           PREINIT:
365           SV* classname;
366           HV* class_stash;
367           PPCODE:
368 12         if (items != 1)
369 0         croak_xs_usage(cv, "classname");
370            
371 12         classname = ST(0);
372 12         class_stash = gv_stashsv(classname, 0);
373            
374 12         if (class_stash) {
375 8         const struct mro_alg *const meta = HvMROMETA(class_stash)->mro_which;
376 8         ST(0) = newSVpvn_flags(meta->name, meta->length,
377           SVs_TEMP
378           | ((meta->kflags & HVhek_UTF8) ? SVf_UTF8 : 0));
379           } else {
380 4         ST(0) = newSVpvn_flags("dfs", 3, SVs_TEMP);
381           }
382 12         XSRETURN(1);
383            
384           void
385           mro_get_isarev(...)
386           PROTOTYPE: $
387           PREINIT:
388           SV* classname;
389           HE* he;
390           HV* isarev;
391           AV* ret_array;
392           PPCODE:
393 94         if (items != 1)
394 0         croak_xs_usage(cv, "classname");
395            
396 94         classname = ST(0);
397            
398 94         he = hv_fetch_ent(PL_isarev, classname, 0, 0);
399 94         isarev = he ? MUTABLE_HV(HeVAL(he)) : NULL;
400            
401 94         ret_array = newAV();
402 94         if(isarev) {
403           HE* iter;
404 70         hv_iterinit(isarev);
405 266         while((iter = hv_iternext(isarev)))
406 126         av_push(ret_array, newSVsv(hv_iterkeysv(iter)));
407           }
408 94         mXPUSHs(newRV_noinc(MUTABLE_SV(ret_array)));
409            
410 94         PUTBACK;
411            
412           void
413           mro_is_universal(...)
414           PROTOTYPE: $
415           PREINIT:
416           SV* classname;
417           HV* isarev;
418           char* classname_pv;
419           STRLEN classname_len;
420           HE* he;
421           PPCODE:
422 18         if (items != 1)
423 0         croak_xs_usage(cv, "classname");
424            
425 18         classname = ST(0);
426            
427 18         classname_pv = SvPV(classname,classname_len);
428            
429 18         he = hv_fetch_ent(PL_isarev, classname, 0, 0);
430 18         isarev = he ? MUTABLE_HV(HeVAL(he)) : NULL;
431            
432 18         if((classname_len == 9 && strEQ(classname_pv, "UNIVERSAL"))
433 18         || (isarev && hv_exists(isarev, "UNIVERSAL", 9)))
434 4         XSRETURN_YES;
435           else
436 14         XSRETURN_NO;
437            
438            
439           void
440           mro_invalidate_all_method_caches(...)
441           PROTOTYPE:
442           PPCODE:
443 4         if (items != 0)
444 0         croak_xs_usage(cv, "");
445            
446 4         PL_sub_generation++;
447            
448 4         XSRETURN_EMPTY;
449            
450           void
451           mro_get_pkg_gen(...)
452           PROTOTYPE: $
453           PREINIT:
454           SV* classname;
455           HV* class_stash;
456           PPCODE:
457 32         if(items != 1)
458 0         croak_xs_usage(cv, "classname");
459          
460 32         classname = ST(0);
461            
462 32         class_stash = gv_stashsv(classname, 0);
463            
464 32         mXPUSHi(class_stash ? HvMROMETA(class_stash)->pkg_gen : 0);
465          
466 32         PUTBACK;
467            
468           void
469           mro__nextcan(...)
470           PREINIT:
471 116         SV* self = ST(0);
472 116         const I32 throw_nomethod = SvIVX(ST(1));
473 116         I32 cxix = cxstack_ix;
474 116         const PERL_CONTEXT *ccstack = cxstack;
475 116         const PERL_SI *top_si = PL_curstackinfo;
476           HV* selfstash;
477           SV *stashname;
478           const char *fq_subname;
479           const char *subname;
480           bool subname_utf8 = 0;
481           STRLEN stashname_len;
482           STRLEN subname_len;
483           SV* sv;
484           GV** gvp;
485           AV* linear_av;
486           SV** linear_svp;
487           const char *hvname;
488           I32 entries;
489           struct mro_meta* selfmeta;
490           HV* nmcache;
491           I32 i;
492           PPCODE:
493           PERL_UNUSED_ARG(cv);
494            
495 116         if(sv_isobject(self))
496 4         selfstash = SvSTASH(SvRV(self));
497           else
498 112         selfstash = gv_stashsv(self, GV_ADD);
499            
500           assert(selfstash);
501            
502 116         hvname = HvNAME_get(selfstash);
503 116         if (!hvname)
504 0         Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup");
505            
506           /* This block finds the contextually-enclosing fully-qualified subname,
507           much like looking at (caller($i))[3] until you find a real sub that
508           isn't ANON, etc (also skips over pureperl next::method, etc) */
509 228         for(i = 0; i < 2; i++) {
510           cxix = __dopoptosub_at(ccstack, cxix);
511           for (;;) {
512           GV* cvgv;
513           STRLEN fq_subname_len;
514            
515           /* we may be in a higher stacklevel, so dig down deeper */
516 248         while (cxix < 0) {
517 4         if(top_si->si_type == PERLSI_MAIN)
518 4         Perl_croak(aTHX_ "next::method/next::can/maybe::next::method must be used in method context");
519 0         top_si = top_si->si_prev;
520 0         ccstack = top_si->si_cxstack;
521 0         cxix = __dopoptosub_at(ccstack, top_si->si_cxix);
522           }
523            
524 244         if(CxTYPE((PERL_CONTEXT*)(&ccstack[cxix])) != CXt_SUB
525 244         || (PL_DBsub && GvCV(PL_DBsub) && ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))) {
526 0         cxix = __dopoptosub_at(ccstack, cxix - 1);
527 0         continue;
528           }
529            
530           {
531 244         const I32 dbcxix = __dopoptosub_at(ccstack, cxix - 1);
532 244         if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub)) {
533 0         if(CxTYPE((PERL_CONTEXT*)(&ccstack[dbcxix])) != CXt_SUB) {
534           cxix = dbcxix;
535 0         continue;
536           }
537           }
538           }
539            
540 244         cvgv = CvGV(ccstack[cxix].blk_sub.cv);
541            
542 244         if(!isGV(cvgv)) {
543 0         cxix = __dopoptosub_at(ccstack, cxix - 1);
544 0         continue;
545           }
546            
547           /* we found a real sub here */
548 244         sv = sv_newmortal();
549            
550 244         gv_efullname3(sv, cvgv, NULL);
551            
552 244         if(SvPOK(sv)) {
553 244         fq_subname = SvPVX(sv);
554 244         fq_subname_len = SvCUR(sv);
555            
556 244         subname_utf8 = SvUTF8(sv) ? 1 : 0;
557 244         subname = strrchr(fq_subname, ':');
558           } else {
559           subname = NULL;
560           }
561            
562 244         if(!subname)
563 0         Perl_croak(aTHX_ "next::method/next::can/maybe::next::method cannot find enclosing method");
564            
565 244         subname++;
566 244         subname_len = fq_subname_len - (subname - fq_subname);
567 244         if(subname_len == 8 && strEQ(subname, "__ANON__")) {
568 16         cxix = __dopoptosub_at(ccstack, cxix - 1);
569 16         continue;
570           }
571           break;
572           }
573 228         cxix--;
574           }
575            
576           /* If we made it to here, we found our context */
577            
578           /* Initialize the next::method cache for this stash
579           if necessary */
580 112         selfmeta = HvMROMETA(selfstash);
581 112         if(!(nmcache = selfmeta->mro_nextmethod)) {
582 40         nmcache = selfmeta->mro_nextmethod = newHV();
583           }
584           else { /* Use the cached coderef if it exists */
585 72         HE* cache_entry = hv_fetch_ent(nmcache, sv, 0, 0);
586 72         if (cache_entry) {
587 12         SV* const val = HeVAL(cache_entry);
588 12         if(val == &PL_sv_undef) {
589 0         if(throw_nomethod)
590 0         Perl_croak(aTHX_ "No next::method '%"SVf"' found for %"SVf,
591 0         SVfARG(newSVpvn_flags(subname, subname_len,
592           SVs_TEMP | ( subname_utf8 ? SVf_UTF8 : 0 ) )),
593 0         SVfARG(sv_2mortal(newSVhek( HvNAME_HEK(selfstash) ))));
594 0         XSRETURN_EMPTY;
595           }
596 12         mXPUSHs(newRV_inc(val));
597 12         XSRETURN(1);
598           }
599           }
600            
601           /* beyond here is just for cache misses, so perf isn't as critical */
602            
603 100         stashname_len = subname - fq_subname - 2;
604 100         stashname = newSVpvn_flags(fq_subname, stashname_len,
605           SVs_TEMP | (subname_utf8 ? SVf_UTF8 : 0));
606            
607           /* has ourselves at the top of the list */
608 100         linear_av = S_mro_get_linear_isa_c3(aTHX_ selfstash, 0);
609            
610 100         linear_svp = AvARRAY(linear_av);
611 100         entries = AvFILLp(linear_av) + 1;
612            
613           /* Walk down our MRO, skipping everything up
614           to the contextually enclosing class */
615 240         while (entries--) {
616 136         SV * const linear_sv = *linear_svp++;
617           assert(linear_sv);
618 136         if(sv_eq(linear_sv, stashname))
619           break;
620           }
621            
622           /* Now search the remainder of the MRO for the
623           same method name as the contextually enclosing
624           method */
625 100         if(entries > 0) {
626 170         while (entries--) {
627 154         SV * const linear_sv = *linear_svp++;
628           HV* curstash;
629           GV* candidate;
630           CV* cand_cv;
631            
632           assert(linear_sv);
633 154         curstash = gv_stashsv(linear_sv, FALSE);
634            
635 154         if (!curstash) {
636 0         if (ckWARN(WARN_SYNTAX))
637 0         Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Can't locate package %"SVf" for @%"SVf"::ISA",
638           (void*)linear_sv,
639 0         SVfARG(sv_2mortal(newSVhek( HvNAME_HEK(selfstash) ))));
640 0         continue;
641           }
642            
643           assert(curstash);
644            
645 154         gvp = (GV**)hv_fetch(curstash, subname,
646           subname_utf8 ? -(I32)subname_len : (I32)subname_len, 0);
647 154         if (!gvp) continue;
648            
649 80         candidate = *gvp;
650           assert(candidate);
651            
652 80         if (SvTYPE(candidate) != SVt_PVGV)
653 0         gv_init_pvn(candidate, curstash, subname, subname_len,
654           GV_ADDMULTI|(subname_utf8 ? SVf_UTF8 : 0));
655            
656           /* Notably, we only look for real entries, not method cache
657           entries, because in C3 the method cache of a parent is not
658           valid for the child */
659 80         if (SvTYPE(candidate) == SVt_PVGV && (cand_cv = GvCV(candidate)) && !GvCVGEN(candidate)) {
660 80         SvREFCNT_inc_simple_void_NN(MUTABLE_SV(cand_cv));
661 80         (void)hv_store_ent(nmcache, sv, MUTABLE_SV(cand_cv), 0);
662 80         mXPUSHs(newRV_inc(MUTABLE_SV(cand_cv)));
663 80         XSRETURN(1);
664           }
665           }
666           }
667            
668 20         (void)hv_store_ent(nmcache, sv, &PL_sv_undef, 0);
669 20         if(throw_nomethod)
670 4         Perl_croak(aTHX_ "No next::method '%"SVf"' found for %"SVf,
671 4         SVfARG(newSVpvn_flags(subname, subname_len,
672           SVs_TEMP | ( subname_utf8 ? SVf_UTF8 : 0 ) )),
673 4         SVfARG(sv_2mortal(newSVhek( HvNAME_HEK(selfstash) ))));
674 16         XSRETURN_EMPTY;
675            
676           BOOT:
677 218         Perl_mro_register(aTHX_ &c3_alg);