ext/mro/mro.xs

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