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 @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 '%"SVf"'",
  49                    SVfARG(sv_2mortal(newSVhek(stashhek))));
  50
  51     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
  60     gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
  61     isa = (gvp && (gv = *gvp) && isGV_with_GP(gv)) ? GvAV(gv) : NULL;
  62
  63     /* 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         SV** seqs_ptr;
  71         I32 seqs_items;
  72         HV *tails;
  73         AV *const seqs = MUTABLE_AV(sv_2mortal(MUTABLE_SV(newAV())));
  74         I32* heads;
  75
  76         /* This builds @seqs, which is an array of arrays.
  77            The members of @seqs are the MROs of
  78            the members of @ISA, followed by @ISA itself.
  79         */
  80         I32 items = AvFILLp(isa) + 1;
  81         SV** isa_ptr = AvARRAY(isa);
  82         while(items--) {
  83             SV* const isa_item = *isa_ptr++;
  84             HV* const isa_item_stash = gv_stashsv(isa_item, 0);
  85             if(!isa_item_stash) {
  86                 /* if no stash, make a temporary fake MRO
  87                    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                 /* recursion */
  94                 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                        calculation.  */
 102                     SV **svp;
 103                     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
 109                     retval = seqs;
 110
 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                        hash key scalar because it's the cheapest and fastest
 117                        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                            (Or prove me wrong and do it.)  */
 125
 126                         SV *const val = *subrv_p++;
 127                         *svp++ = newSVsv(val);
 128                     }
 129
 130                     SvREFCNT_inc(retval);
 131
 132                     goto done;
 133                 }
 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         /* This builds "heads", which as an array of integer array
 141            indices, one per seq, which point at the virtual "head"
 142            of the seq (initially zero) */
 143         Newxz(heads, AvFILLp(seqs)+1, I32);
 144
 145         /* This builds %tails, which has one key for every class
 146            mentioned in the tail of any sequence in @seqs (tail meaning
 147            everything after the first class, the "head").  The value
 148            is how many times this key appears in the tails of @seqs.
 149         */
 150         seqs_ptr = AvARRAY(seqs);
 151         seqs_items = AvFILLp(seqs) + 1;
 152         while(seqs_items--) {
 153             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                     SV* const seqitem = *seq_ptr++;
 159                     /* LVALUE fetch will create a new undefined SV if necessary
 160                      */
 161                     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                             SvIV_set(val, SvIVX(val) + 1);
 170                         } 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         av_push(retval, newSVhek(stashhek)); /* us first */
 181
 182         /* This loop won't terminate until we either finish building
 183            the MRO, or get an exception. */
 184         while(1) {
 185             SV* cand = NULL;
 186             SV* winner = NULL;
 187             int s;
 188
 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                 seqhead = *svp; /* seqhead = head of this seq */
 198                 if(!winner) {
 199                     HE* tail_entry;
 200                     SV* val;
 201                     /* if we haven't found a winner for this round yet,
 202                        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                     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                     /* note however that even when we find a winner,
 214                        we continue looping over @seqs to do housekeeping */
 215                 }
 216                 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                     if(new_head > AvFILLp(seq)) {
 225                         SvREFCNT_dec(avptr[s]);
 226                         avptr[s] = NULL;
 227                     }
 228                     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                         seqhead = *svp;
 236                         tail_entry = hv_fetch_ent(tails, seqhead, 0, 0);
 237                         val = HeVAL(tail_entry);
 238                         sv_dec(val);
 239                     }
 240                 }
 241             }
 242
 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                 Safefree(heads);
 247                 break;
 248             }
 249
 250             /* If we had candidates, but nobody won, then the @ISA
 251                hierarchy is not C3-incompatible */
 252             if(!winner) {
 253                 SV *errmsg;
 254                 I32 i;
 255
 256                 errmsg = newSVpvf(
 257                             "Inconsistent hierarchy during C3 merge of class '%"SVf"':\n\t"
 258                             "current merge results [\n",
 259                                             SVfARG(sv_2mortal(newSVhek(stashhek))));
 260                 for (i = 0; i <= av_len(retval); i++) {
 261                     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
 268                 SvREFCNT_dec(retval);
 269                 Safefree(heads);
 270
 271                 Perl_croak(aTHX_ "%"SVf, SVfARG(errmsg));
 272             }
 273         }
 274     }
 275     else { /* @ISA was undefined or empty */
 276         /* 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
 290
 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     if(items < 1 || items > 2)
 316         croak_xs_usage(cv, "classname [, type ]");
 317
 318     classname = ST(0);
 319     class_stash = gv_stashsv(classname, 0);
 320
 321     if(!class_stash) {
 322         /* No stash exists yet, give them just the classname */
 323         AV* isalin = newAV();
 324         av_push(isalin, newSVsv(classname));
 325         ST(0) = sv_2mortal(newRV_noinc(MUTABLE_SV(isalin)));
 326         XSRETURN(1);
 327     }
 328     else if(items > 1) {
 329         const struct mro_alg *const algo = Perl_mro_get_from_name(aTHX_ ST(1));
 330         if (!algo)
 331             Perl_croak(aTHX_ "Invalid mro name: '%"SVf"'", ST(1));
 332         RETVAL = algo->resolve(aTHX_ class_stash, 0);
 333     }
 334     else {
 335         RETVAL = mro_get_linear_isa(class_stash);
 336     }
 337     ST(0) = newRV_inc(MUTABLE_SV(RETVAL));
 338     sv_2mortal(ST(0));
 339     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     if (items != 2)
 350         croak_xs_usage(cv, "classname, type");
 351
 352     classname = ST(0);
 353     class_stash = gv_stashsv(classname, GV_ADD);
 354     if(!class_stash) Perl_croak(aTHX_ "Cannot create class: '%"SVf"'!", SVfARG(classname));
 355     meta = HvMROMETA(class_stash);
 356
 357     Perl_mro_set_mro(aTHX_ meta, ST(1));
 358
 359     XSRETURN_EMPTY;
 360
 361 void
 362 mro_get_mro(...)
 363   PROTOTYPE: $
 364   PREINIT:
 365     SV* classname;
 366     HV* class_stash;
 367   PPCODE:
 368     if (items != 1)
 369         croak_xs_usage(cv, "classname");
 370
 371     classname = ST(0);
 372     class_stash = gv_stashsv(classname, 0);
 373
 374     if (class_stash) {
 375         const struct mro_alg *const meta = HvMROMETA(class_stash)->mro_which;
 376         ST(0) = newSVpvn_flags(meta->name, meta->length,
 377                                SVs_TEMP
 378                                | ((meta->kflags & HVhek_UTF8) ? SVf_UTF8 : 0));
 379     } else {
 380       ST(0) = newSVpvn_flags("dfs", 3, SVs_TEMP);
 381     }
 382     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     if (items != 1)
 394         croak_xs_usage(cv, "classname");
 395
 396     classname = ST(0);
 397
 398     he = hv_fetch_ent(PL_isarev, classname, 0, 0);
 399     isarev = he ? MUTABLE_HV(HeVAL(he)) : NULL;
 400
 401     ret_array = newAV();
 402     if(isarev) {
 403         HE* iter;
 404         hv_iterinit(isarev);
 405         while((iter = hv_iternext(isarev)))
 406             av_push(ret_array, newSVsv(hv_iterkeysv(iter)));
 407     }
 408     mXPUSHs(newRV_noinc(MUTABLE_SV(ret_array)));
 409
 410     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     if (items != 1)
 423         croak_xs_usage(cv, "classname");
 424
 425     classname = ST(0);
 426
 427     classname_pv = SvPV(classname,classname_len);
 428
 429     he = hv_fetch_ent(PL_isarev, classname, 0, 0);
 430     isarev = he ? MUTABLE_HV(HeVAL(he)) : NULL;
 431
 432     if((classname_len == 9 && strEQ(classname_pv, "UNIVERSAL"))
 433         || (isarev && hv_exists(isarev, "UNIVERSAL", 9)))
 434         XSRETURN_YES;
 435     else
 436         XSRETURN_NO;
 437
 438
 439 void
 440 mro_invalidate_all_method_caches(...)
 441   PROTOTYPE:
 442   PPCODE:
 443     if (items != 0)
 444         croak_xs_usage(cv, "");
 445
 446     PL_sub_generation++;
 447
 448     XSRETURN_EMPTY;
 449
 450 void
 451 mro_get_pkg_gen(...)
 452   PROTOTYPE: $
 453   PREINIT:
 454     SV* classname;
 455     HV* class_stash;
 456   PPCODE:
 457     if(items != 1)
 458         croak_xs_usage(cv, "classname");
 459
 460     classname = ST(0);
 461
 462     class_stash = gv_stashsv(classname, 0);
 463
 464     mXPUSHi(class_stash ? HvMROMETA(class_stash)->pkg_gen : 0);
 465
 466     PUTBACK;
 467
 468 void
 469 mro__nextcan(...)
 470   PREINIT:
 471     SV* self = ST(0);
 472     const I32 throw_nomethod = SvIVX(ST(1));
 473     register I32 cxix = cxstack_ix;
 474     register const PERL_CONTEXT *ccstack = cxstack;
 475     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     if(sv_isobject(self))
 496         selfstash = SvSTASH(SvRV(self));
 497     else
 498         selfstash = gv_stashsv(self, GV_ADD);
 499
 500     assert(selfstash);
 501
 502     hvname = HvNAME_get(selfstash);
 503     if (!hvname)
 504         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     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             while (cxix < 0) {
 517                 if(top_si->si_type == PERLSI_MAIN)
 518                     Perl_croak(aTHX_ "next::method/next::can/maybe::next::method must be used in method context");
 519                 top_si = top_si->si_prev;
 520                 ccstack = top_si->si_cxstack;
 521                 cxix = __dopoptosub_at(ccstack, top_si->si_cxix);
 522             }
 523
 524             if(CxTYPE((PERL_CONTEXT*)(&ccstack[cxix])) != CXt_SUB
 525               || (PL_DBsub && GvCV(PL_DBsub) && ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))) {
 526                 cxix = __dopoptosub_at(ccstack, cxix - 1);
 527                 continue;
 528             }
 529
 530             {
 531                 const I32 dbcxix = __dopoptosub_at(ccstack, cxix - 1);
 532                 if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub)) {
 533                     if(CxTYPE((PERL_CONTEXT*)(&ccstack[dbcxix])) != CXt_SUB) {
 534                         cxix = dbcxix;
 535                         continue;
 536                     }
 537                 }
 538             }
 539
 540             cvgv = CvGV(ccstack[cxix].blk_sub.cv);
 541
 542             if(!isGV(cvgv)) {
 543                 cxix = __dopoptosub_at(ccstack, cxix - 1);
 544                 continue;
 545             }
 546
 547             /* we found a real sub here */
 548             sv = sv_newmortal();
 549
 550             gv_efullname3(sv, cvgv, NULL);
 551
 552             if(SvPOK(sv)) {
 553                 fq_subname = SvPVX(sv);
 554                 fq_subname_len = SvCUR(sv);
 555
 556                 subname_utf8 = SvUTF8(sv) ? 1 : 0;
 557                 subname = strrchr(fq_subname, ':');
 558             } else {
 559                 subname = NULL;
 560             }
 561
 562             if(!subname)
 563                 Perl_croak(aTHX_ "next::method/next::can/maybe::next::method cannot find enclosing method");
 564
 565             subname++;
 566             subname_len = fq_subname_len - (subname - fq_subname);
 567             if(subname_len == 8 && strEQ(subname, "__ANON__")) {
 568                 cxix = __dopoptosub_at(ccstack, cxix - 1);
 569                 continue;
 570             }
 571             break;
 572         }
 573         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     selfmeta = HvMROMETA(selfstash);
 581     if(!(nmcache = selfmeta->mro_nextmethod)) {
 582         nmcache = selfmeta->mro_nextmethod = newHV();
 583     }
 584     else { /* Use the cached coderef if it exists */
 585         HE* cache_entry = hv_fetch_ent(nmcache, sv, 0, 0);
 586         if (cache_entry) {
 587             SV* const val = HeVAL(cache_entry);
 588             if(val == &PL_sv_undef) {
 589                 if(throw_nomethod)
 590                     Perl_croak(aTHX_ "No next::method '%"SVf"' found for %"SVf,
 591                         SVfARG(newSVpvn_flags(subname, subname_len,
 592                                 SVs_TEMP | ( subname_utf8 ? SVf_UTF8 : 0 ) )),
 593                         SVfARG(sv_2mortal(newSVhek( HvNAME_HEK(selfstash) ))));
 594                 XSRETURN_EMPTY;
 595             }
 596             mXPUSHs(newRV_inc(val));
 597             XSRETURN(1);
 598         }
 599     }
 600
 601     /* beyond here is just for cache misses, so perf isn't as critical */
 602
 603     stashname_len = subname - fq_subname - 2;
 604     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     linear_av = S_mro_get_linear_isa_c3(aTHX_ selfstash, 0);
 609
 610     linear_svp = AvARRAY(linear_av);
 611     entries = AvFILLp(linear_av) + 1;
 612
 613     /* Walk down our MRO, skipping everything up
 614        to the contextually enclosing class */
 615     while (entries--) {
 616         SV * const linear_sv = *linear_svp++;
 617         assert(linear_sv);
 618         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     if(entries > 0) {
 626         while (entries--) {
 627             SV * const linear_sv = *linear_svp++;
 628             HV* curstash;
 629             GV* candidate;
 630             CV* cand_cv;
 631
 632             assert(linear_sv);
 633             curstash = gv_stashsv(linear_sv, FALSE);
 634
 635             if (!curstash) {
 636                 if (ckWARN(WARN_SYNTAX))
 637                     Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Can't locate package %"SVf" for @%"SVf"::ISA",
 638                         (void*)linear_sv,
 639                         SVfARG(sv_2mortal(newSVhek( HvNAME_HEK(selfstash) ))));
 640                 continue;
 641             }
 642
 643             assert(curstash);
 644
 645             gvp = (GV**)hv_fetch(curstash, subname,
 646                                     subname_utf8 ? -subname_len : subname_len, 0);
 647             if (!gvp) continue;
 648
 649             candidate = *gvp;
 650             assert(candidate);
 651
 652             if (SvTYPE(candidate) != SVt_PVGV)
 653                 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             if (SvTYPE(candidate) == SVt_PVGV && (cand_cv = GvCV(candidate)) && !GvCVGEN(candidate)) {
 660                 SvREFCNT_inc_simple_void_NN(MUTABLE_SV(cand_cv));
 661                 (void)hv_store_ent(nmcache, sv, MUTABLE_SV(cand_cv), 0);
 662                 mXPUSHs(newRV_inc(MUTABLE_SV(cand_cv)));
 663                 XSRETURN(1);
 664             }
 665         }
 666     }
 667
 668     (void)hv_store_ent(nmcache, sv, &PL_sv_undef, 0);
 669     if(throw_nomethod)
 670         Perl_croak(aTHX_ "No next::method '%"SVf"' found for %"SVf,
 671                          SVfARG(newSVpvn_flags(subname, subname_len,
 672                                 SVs_TEMP | ( subname_utf8 ? SVf_UTF8 : 0 ) )),
 673                         SVfARG(sv_2mortal(newSVhek( HvNAME_HEK(selfstash) ))));
 674     XSRETURN_EMPTY;
 675
 676 BOOT:
 677     Perl_mro_register(aTHX_ &c3_alg);