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