3 * Copyright (c) 2007 Brandon L Black
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
11 * "Which order shall we go in?" said Frodo. "Eldest first, or quickest first?
12 * You'll be last either way, Master Peregrin."
18 These functions are related to the method resolution order of perl classes
27 Perl_mro_meta_init(pTHX_ HV* stash)
29 struct mro_meta* newmeta;
33 assert(!(HvAUX(stash)->xhv_mro_meta));
34 Newxz(newmeta, 1, struct mro_meta);
35 HvAUX(stash)->xhv_mro_meta = newmeta;
36 newmeta->sub_generation = 1;
38 /* Manually flag UNIVERSAL as being universal.
39 This happens early in perl booting (when universal.c
40 does the newXS calls for UNIVERSAL::*), and infects
41 other packages as they are added to UNIVERSAL's MRO
43 if(HvNAMELEN_get(stash) == 9
44 && strEQ(HEK_KEY(HvAUX(stash)->xhv_name), "UNIVERSAL")) {
45 HvMROMETA(stash)->is_universal = 1;
51 #if defined(USE_ITHREADS)
53 /* for sv_dup on new threads */
55 Perl_mro_meta_dup(pTHX_ struct mro_meta* smeta, CLONE_PARAMS* param)
57 struct mro_meta* newmeta;
61 Newx(newmeta, 1, struct mro_meta);
62 Copy(smeta, newmeta, 1, struct mro_meta);
64 if (newmeta->mro_linear_dfs)
65 newmeta->mro_linear_dfs
66 = (AV*) SvREFCNT_inc(sv_dup((SV*)newmeta->mro_linear_dfs, param));
67 if (newmeta->mro_linear_c3)
68 newmeta->mro_linear_c3
69 = (AV*) SvREFCNT_inc(sv_dup((SV*)newmeta->mro_linear_c3, param));
70 if (newmeta->mro_isarev)
72 = (HV*) SvREFCNT_inc(sv_dup((SV*)newmeta->mro_isarev, param));
73 if (newmeta->mro_nextmethod)
74 newmeta->mro_nextmethod
75 = (HV*) SvREFCNT_inc(sv_dup((SV*)newmeta->mro_nextmethod, param));
80 #endif /* USE_ITHREADS */
83 =for apidoc mro_get_linear_isa_dfs
85 Returns the Depth-First Search linearization of @ISA
86 the given stash. The return value is a read-only AV*.
87 C<level> should be 0 (it is used internally in this
88 function's recursion).
90 You are responsible for C<SvREFCNT_inc()> on the
91 return value if you plan to store it anywhere
92 semi-permanently (otherwise it might be deleted
93 out from under you the next time the cache is
99 Perl_mro_get_linear_isa_dfs(pTHX_ HV *stash, I32 level)
110 const char* stashname;
111 struct mro_meta* meta;
114 assert(HvAUX(stash));
116 stashname = HvNAME_get(stash);
119 "Can't linearize anonymous symbol table");
122 Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
125 meta = HvMROMETA(stash);
127 /* return cache if valid */
128 if((retval = meta->mro_linear_dfs)) {
132 /* not in cache, make a new one */
135 av_push(retval, newSVpv(stashname, 0)); /* add ourselves at the top */
138 gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
139 av = (gvp && (gv = *gvp) && isGV_with_GP(gv)) ? GvAV(gv) : NULL;
143 /* "stored" is used to keep track of all of the classnames
144 we have added to the MRO so far, so we can do a quick
145 exists check and avoid adding duplicate classnames to
148 HV* stored = (HV*)sv_2mortal((SV*)newHV());
150 items = AvFILLp(av) + 1;
154 SV* const sv = *svp++;
155 HV* const basestash = gv_stashsv(sv, 0);
158 /* if no stash exists for this @ISA member,
159 simply add it to the MRO and move on */
160 if(!hv_exists_ent(stored, sv, 0)) {
161 av_push(retval, newSVsv(sv));
162 hv_store_ent(stored, sv, &PL_sv_undef, 0);
166 /* otherwise, recurse into ourselves for the MRO
167 of this @ISA member, and append their MRO to ours */
168 subrv = mro_get_linear_isa_dfs(basestash, level + 1);
169 subrv_p = AvARRAY(subrv);
170 subrv_items = AvFILLp(subrv) + 1;
171 while(subrv_items--) {
172 SV* subsv = *subrv_p++;
173 if(!hv_exists_ent(stored, subsv, 0)) {
174 av_push(retval, newSVsv(subsv));
175 hv_store_ent(stored, subsv, &PL_sv_undef, 0);
182 /* we don't want anyone modifying the cache entry but us,
183 and we do so by replacing it completely */
184 SvREADONLY_on(retval);
186 meta->mro_linear_dfs = retval;
191 =for apidoc mro_get_linear_isa_c3
193 Returns the C3 linearization of @ISA
194 the given stash. The return value is a read-only AV*.
195 C<level> should be 0 (it is used internally in this
196 function's recursion).
198 You are responsible for C<SvREFCNT_inc()> on the
199 return value if you plan to store it anywhere
200 semi-permanently (otherwise it might be deleted
201 out from under you the next time the cache is
208 Perl_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level)
214 const char* stashname;
215 STRLEN stashname_len;
216 struct mro_meta* meta;
219 assert(HvAUX(stash));
221 stashname = HvNAME_get(stash);
222 stashname_len = HvNAMELEN_get(stash);
225 "Can't linearize anonymous symbol table");
228 Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
231 meta = HvMROMETA(stash);
233 /* return cache if valid */
234 if((retval = meta->mro_linear_c3)) {
238 /* not in cache, make a new one */
241 av_push(retval, newSVpvn(stashname, stashname_len)); /* us first */
243 gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
244 isa = (gvp && (gv = *gvp) && isGV_with_GP(gv)) ? GvAV(gv) : NULL;
246 /* For a better idea how the rest of this works, see the much clearer
247 pure perl version in Algorithm::C3 0.01:
248 http://search.cpan.org/src/STEVAN/Algorithm-C3-0.01/lib/Algorithm/C3.pm
249 (later versions go about it differently than this code for speed reasons)
251 if(isa && AvFILLp(isa) >= 0) {
254 HV* tails = (HV*)sv_2mortal((SV*)newHV());
255 AV* seqs = (AV*)sv_2mortal((SV*)newAV());
256 I32 items = AvFILLp(isa) + 1;
257 SV** isa_ptr = AvARRAY(isa);
260 SV* isa_item = *isa_ptr++;
261 HV* isa_item_stash = gv_stashsv(isa_item, 0);
262 if(!isa_item_stash) {
264 av_push(isa_lin, newSVsv(isa_item));
267 isa_lin = mro_get_linear_isa_c3(isa_item_stash, level + 1); /* recursion */
269 av_push(seqs, (SV*)av_make(AvFILLp(isa_lin)+1, AvARRAY(isa_lin)));
271 av_push(seqs, (SV*)av_make(AvFILLp(isa)+1, AvARRAY(isa)));
273 seqs_ptr = AvARRAY(seqs);
274 seqs_items = AvFILLp(seqs) + 1;
275 while(seqs_items--) {
276 AV* seq = (AV*)*seqs_ptr++;
277 I32 seq_items = AvFILLp(seq);
279 SV** seq_ptr = AvARRAY(seq) + 1;
281 SV* seqitem = *seq_ptr++;
282 HE* he = hv_fetch_ent(tails, seqitem, 0, 0);
284 hv_store_ent(tails, seqitem, newSViv(1), 0);
301 SV** avptr = AvARRAY(seqs);
302 items = AvFILLp(seqs)+1;
306 if(AvFILLp(seq) < 0) continue;
307 svp = av_fetch(seq, 0, 0);
311 if((tail_entry = hv_fetch_ent(tails, cand, 0, 0))
312 && (val = HeVAL(tail_entry))
315 winner = newSVsv(cand);
316 av_push(retval, winner);
318 if(!sv_cmp(seqhead, winner)) {
320 /* this is basically shift(@seq) in void context */
321 SvREFCNT_dec(*AvARRAY(seq));
322 *AvARRAY(seq) = &PL_sv_undef;
323 AvARRAY(seq) = AvARRAY(seq) + 1;
327 if(AvFILLp(seq) < 0) continue;
328 svp = av_fetch(seq, 0, 0);
330 tail_entry = hv_fetch_ent(tails, seqhead, 0, 0);
331 val = HeVAL(tail_entry);
337 SvREFCNT_dec(retval);
338 Perl_croak(aTHX_ "Inconsistent hierarchy during C3 merge of class '%s': "
339 "merging failed on parent '%"SVf"'", stashname, SVfARG(cand));
344 /* we don't want anyone modifying the cache entry but us,
345 and we do so by replacing it completely */
346 SvREADONLY_on(retval);
348 meta->mro_linear_c3 = retval;
353 =for apidoc mro_get_linear_isa
355 Returns either C<mro_get_linear_isa_c3> or
356 C<mro_get_linear_isa_dfs> for the given stash,
357 dependant upon which MRO is in effect
358 for that stash. The return value is a
361 You are responsible for C<SvREFCNT_inc()> on the
362 return value if you plan to store it anywhere
363 semi-permanently (otherwise it might be deleted
364 out from under you the next time the cache is
370 Perl_mro_get_linear_isa(pTHX_ HV *stash)
372 struct mro_meta* meta;
374 assert(HvAUX(stash));
376 meta = HvMROMETA(stash);
377 if(meta->mro_which == MRO_DFS) {
378 return mro_get_linear_isa_dfs(stash, 0);
379 } else if(meta->mro_which == MRO_C3) {
380 return mro_get_linear_isa_c3(stash, 0);
382 Perl_croak(aTHX_ "panic: invalid MRO!");
387 =for apidoc mro_isa_changed_in
389 Takes the necessary steps (cache invalidations, mostly)
390 when the @ISA of the given package has changed. Invoked
391 by the C<setisa> magic, should not need to invoke directly.
396 Perl_mro_isa_changed_in(pTHX_ HV* stash)
404 struct mro_meta* meta;
407 stashname = HvNAME_get(stash);
409 /* wipe out the cached linearizations for this stash */
410 meta = HvMROMETA(stash);
411 SvREFCNT_dec((SV*)meta->mro_linear_dfs);
412 SvREFCNT_dec((SV*)meta->mro_linear_c3);
413 meta->mro_linear_dfs = NULL;
414 meta->mro_linear_c3 = NULL;
416 /* Wipe the global method cache if this package
417 is UNIVERSAL or one of its parents */
418 if(meta->is_universal)
421 /* Wipe the local method cache otherwise */
423 meta->sub_generation++;
425 /* wipe next::method cache too */
426 if(meta->mro_nextmethod) hv_clear(meta->mro_nextmethod);
428 /* Iterate the isarev (classes that are our children),
429 wiping out their linearization and method caches */
430 if((isarev = meta->mro_isarev)) {
432 while((iter = hv_iternext(isarev))) {
433 SV* revkey = hv_iterkeysv(iter);
434 HV* revstash = gv_stashsv(revkey, 0);
435 struct mro_meta* revmeta = HvMROMETA(revstash);
436 SvREFCNT_dec((SV*)revmeta->mro_linear_dfs);
437 SvREFCNT_dec((SV*)revmeta->mro_linear_c3);
438 revmeta->mro_linear_dfs = NULL;
439 revmeta->mro_linear_c3 = NULL;
440 if(!meta->is_universal)
441 revmeta->sub_generation++;
442 if(revmeta->mro_nextmethod)
443 hv_clear(revmeta->mro_nextmethod);
447 /* Now iterate our MRO (parents), and do a few things:
448 1) instantiate with the "fake" flag if they don't exist
449 2) flag them as universal if we are universal
450 3) Add everything from our isarev to their isarev
453 /* We're starting at the 2nd element, skipping ourselves here */
454 linear_mro = mro_get_linear_isa(stash);
455 svp = AvARRAY(linear_mro) + 1;
456 items = AvFILLp(linear_mro);
459 SV* const sv = *svp++;
460 struct mro_meta* mrometa;
463 HV* mrostash = gv_stashsv(sv, 0);
465 mrostash = gv_stashsv(sv, GV_ADD);
467 We created the package on the fly, so
468 that we could store isarev information.
469 This flag lets gv_fetchmeth know about it,
470 so that it can still generate the very useful
471 "Can't locate package Foo for @Bar::ISA" warning.
473 HvMROMETA(mrostash)->fake = 1;
476 mrometa = HvMROMETA(mrostash);
477 mroisarev = mrometa->mro_isarev;
479 /* is_universal is viral */
480 if(meta->is_universal)
481 mrometa->is_universal = 1;
484 mroisarev = mrometa->mro_isarev = newHV();
486 if(!hv_exists(mroisarev, stashname, strlen(stashname)))
487 hv_store(mroisarev, stashname, strlen(stashname), &PL_sv_yes, 0);
491 while((iter = hv_iternext(isarev))) {
492 SV* revkey = hv_iterkeysv(iter);
493 if(!hv_exists_ent(mroisarev, revkey, 0))
494 hv_store_ent(mroisarev, revkey, &PL_sv_yes, 0);
501 =for apidoc mro_method_changed_in
503 Like C<mro_isa_changed_in>, but invalidates method
504 caching on any child classes of the given stash, so
505 that they might notice the changes in this one.
507 Ideally, all instances of C<PL_sub_generation++> in
508 the perl source should be replaced by calls to this.
509 Some already are, but some are more difficult to
512 Perl has always had problems with method caches
513 getting out of sync when one directly manipulates
514 stashes via things like C<%{Foo::} = %{Bar::}> or
515 C<${Foo::}{bar} = ...> or the equivalent. If
516 you do this in core or XS code, call this afterwards
517 on the destination stash to get things back in sync.
519 If you're doing such a thing from pure perl, use
520 C<mro::method_changed_in(classname)>, which
526 Perl_mro_method_changed_in(pTHX_ HV *stash)
528 struct mro_meta* meta = HvMROMETA(stash);
532 /* If stash is UNIVERSAL, or one of UNIVERSAL's parents,
533 invalidate all method caches globally */
534 if(meta->is_universal) {
539 /* else, invalidate the method caches of all child classes,
541 if((isarev = meta->mro_isarev)) {
543 while((iter = hv_iternext(isarev))) {
544 SV* revkey = hv_iterkeysv(iter);
545 HV* revstash = gv_stashsv(revkey, 0);
546 struct mro_meta* mrometa = HvMROMETA(revstash);
547 mrometa->sub_generation++;
548 if(mrometa->mro_nextmethod)
549 hv_clear(mrometa->mro_nextmethod);
554 /* These two are static helpers for next::method and friends,
555 and re-implement a bunch of the code from pp_caller() in
556 a more efficient manner for this particular usage.
560 __dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock) {
562 for (i = startingblock; i >= 0; i--) {
563 if(CxTYPE((PERL_CONTEXT*)(&cxstk[i])) == CXt_SUB) return i;
569 __nextcan(pTHX_ SV* self, I32 throw_nomethod)
572 register const PERL_CONTEXT *ccstack = cxstack;
573 const PERL_SI *top_si = PL_curstackinfo;
577 const char *fq_subname;
579 STRLEN fq_subname_len;
580 STRLEN stashname_len;
588 GV* candidate = NULL;
592 struct mro_meta* selfmeta;
596 if(sv_isobject(self))
597 selfstash = SvSTASH(SvRV(self));
599 selfstash = gv_stashsv(self, 0);
603 hvname = HvNAME_get(selfstash);
605 Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup");
607 cxix = __dopoptosub_at(cxstack, cxstack_ix);
609 /* This block finds the contextually-enclosing fully-qualified subname,
610 much like looking at (caller($i))[3] until you find a real sub that
613 /* we may be in a higher stacklevel, so dig down deeper */
615 if(top_si->si_type == PERLSI_MAIN)
616 Perl_croak(aTHX_ "next::method/next::can/maybe::next::method must be used in method context");
617 top_si = top_si->si_prev;
618 ccstack = top_si->si_cxstack;
619 cxix = __dopoptosub_at(ccstack, top_si->si_cxix);
622 if(CxTYPE((PERL_CONTEXT*)(&ccstack[cxix])) != CXt_SUB
623 || (PL_DBsub && GvCV(PL_DBsub) && ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))) {
624 cxix = __dopoptosub_at(ccstack, cxix - 1);
629 const I32 dbcxix = __dopoptosub_at(ccstack, cxix - 1);
630 if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub)) {
631 if(CxTYPE((PERL_CONTEXT*)(&ccstack[dbcxix])) != CXt_SUB) {
638 cvgv = CvGV(ccstack[cxix].blk_sub.cv);
641 cxix = __dopoptosub_at(ccstack, cxix - 1);
645 /* we found a real sub here */
646 sv = sv_2mortal(newSV(0));
648 gv_efullname3(sv, cvgv, NULL);
650 fq_subname = SvPVX(sv);
651 fq_subname_len = SvCUR(sv);
653 subname = strrchr(fq_subname, ':');
655 Perl_croak(aTHX_ "next::method/next::can/maybe::next::method cannot find enclosing method");
658 subname_len = fq_subname_len - (subname - fq_subname);
659 if(subname_len == 8 && strEQ(subname, "__ANON__")) {
660 cxix = __dopoptosub_at(ccstack, cxix - 1);
666 /* If we made it to here, we found our context */
668 /* Initialize the next::method cache for this stash
670 selfmeta = HvMROMETA(selfstash);
671 if(!(nmcache = selfmeta->mro_nextmethod)) {
672 nmcache = selfmeta->mro_nextmethod = newHV();
675 /* Use the cached coderef if it exists */
676 if((cache_entry = hv_fetch_ent(nmcache, sv, 0, 0))) {
677 SV* val = HeVAL(cache_entry);
678 if(val == &PL_sv_undef) {
680 Perl_croak(aTHX_ "No next::method '%s' found for %s", subname, hvname);
685 /* beyond here is just for cache misses, so perf isn't as critical */
687 stashname_len = subname - fq_subname - 2;
688 stashname = sv_2mortal(newSVpvn(fq_subname, stashname_len));
690 linear_av = mro_get_linear_isa_c3(selfstash, 0); /* has ourselves at the top of the list */
692 linear_svp = AvARRAY(linear_av);
693 items = AvFILLp(linear_av) + 1;
695 /* Walk down our MRO, skipping everything up
696 to the contextually enclosing class */
698 linear_sv = *linear_svp++;
700 if(sv_eq(linear_sv, stashname))
704 /* Now search the remainder of the MRO for the
705 same method name as the contextually enclosing
709 linear_sv = *linear_svp++;
711 curstash = gv_stashsv(linear_sv, FALSE);
713 if (!curstash || (HvMROMETA(curstash)->fake && !HvFILL(curstash))) {
714 if (ckWARN(WARN_SYNTAX))
715 Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Can't locate package %"SVf" for @%s::ISA",
716 (void*)linear_sv, hvname);
722 gvp = (GV**)hv_fetch(curstash, subname, subname_len, 0);
728 if (SvTYPE(candidate) != SVt_PVGV)
729 gv_init(candidate, curstash, subname, subname_len, TRUE);
731 /* Notably, we only look for real entries, not method cache
732 entries, because in C3 the method cache of a parent is not
733 valid for the child */
734 if (SvTYPE(candidate) == SVt_PVGV && (cand_cv = GvCV(candidate)) && !GvCVGEN(candidate)) {
735 SvREFCNT_inc_simple_void_NN((SV*)cand_cv);
736 hv_store_ent(nmcache, newSVsv(sv), (SV*)cand_cv, 0);
742 hv_store_ent(nmcache, newSVsv(sv), &PL_sv_undef, 0);
744 Perl_croak(aTHX_ "No next::method '%s' found for %s", subname, hvname);
750 XS(XS_mro_get_linear_isa);
753 XS(XS_mro_get_isarev);
754 XS(XS_mro_is_universal);
755 XS(XS_mro_get_global_sub_generation);
756 XS(XS_mro_invalidate_all_method_caches);
757 XS(XS_mro_get_sub_generation);
758 XS(XS_mro_method_changed_in);
761 XS(XS_maybe_next_method);
764 Perl_boot_core_mro(pTHX)
767 static const char file[] = __FILE__;
769 newXSproto("mro::get_linear_isa", XS_mro_get_linear_isa, file, "$;$");
770 newXSproto("mro::set_mro", XS_mro_set_mro, file, "$$");
771 newXSproto("mro::get_mro", XS_mro_get_mro, file, "$");
772 newXSproto("mro::get_isarev", XS_mro_get_isarev, file, "$");
773 newXSproto("mro::is_universal", XS_mro_is_universal, file, "$");
774 newXSproto("mro::get_global_sub_generation", XS_mro_get_global_sub_generation, file, "");
775 newXSproto("mro::invalidate_all_method_caches", XS_mro_invalidate_all_method_caches, file, "");
776 newXSproto("mro::get_sub_generation", XS_mro_get_sub_generation, file, "$");
777 newXSproto("mro::method_changed_in", XS_mro_method_changed_in, file, "$");
778 newXS("next::can", XS_next_can, file);
779 newXS("next::method", XS_next_method, file);
780 newXS("maybe::next::method", XS_maybe_next_method, file);
783 XS(XS_mro_get_linear_isa) {
792 if(items < 1 || items > 2)
793 Perl_croak(aTHX_ "Usage: mro::get_linear_isa(classname [, type ])");
796 class_stash = gv_stashsv(classname, 0);
797 if(!class_stash) Perl_croak(aTHX_ "No such class: '%"SVf"'!", SVfARG(classname));
800 char* which = SvPV_nolen(ST(1));
801 if(strEQ(which, "dfs"))
802 RETVAL = mro_get_linear_isa_dfs(class_stash, 0);
803 else if(strEQ(which, "c3"))
804 RETVAL = mro_get_linear_isa_c3(class_stash, 0);
806 Perl_croak(aTHX_ "Invalid mro name: '%s'", which);
809 RETVAL = mro_get_linear_isa(class_stash);
812 ST(0) = newRV_inc((SV*)RETVAL);
825 struct mro_meta* meta;
830 Perl_croak(aTHX_ "Usage: mro::set_mro(classname, type)");
833 whichstr = SvPV_nolen(ST(1));
834 class_stash = gv_stashsv(classname, GV_ADD);
835 if(!class_stash) Perl_croak(aTHX_ "Cannot create class: '%"SVf"'!", SVfARG(classname));
836 meta = HvMROMETA(class_stash);
838 if(strEQ(whichstr, "dfs"))
840 else if(strEQ(whichstr, "c3"))
843 Perl_croak(aTHX_ "Invalid mro name: '%s'", whichstr);
845 if(meta->mro_which != which) {
846 meta->mro_which = which;
847 /* Only affects local method cache, not
848 even child classes */
849 meta->sub_generation++;
850 if(meta->mro_nextmethod)
851 hv_clear(meta->mro_nextmethod);
864 struct mro_meta* meta;
869 Perl_croak(aTHX_ "Usage: mro::get_mro(classname)");
872 class_stash = gv_stashsv(classname, 0);
873 if(!class_stash) Perl_croak(aTHX_ "No such class: '%"SVf"'!", SVfARG(classname));
874 meta = HvMROMETA(class_stash);
876 if(meta->mro_which == MRO_DFS)
877 ST(0) = sv_2mortal(newSVpvn("dfs", 3));
879 ST(0) = sv_2mortal(newSVpvn("c3", 2));
884 XS(XS_mro_get_isarev)
895 Perl_croak(aTHX_ "Usage: mro::get_isarev(classname)");
899 class_stash = gv_stashsv(classname, 0);
900 if(!class_stash) Perl_croak(aTHX_ "No such class: '%"SVf"'!", SVfARG(classname));
904 if((isarev = HvMROMETA(class_stash)->mro_isarev)) {
907 while((iter = hv_iternext(isarev)))
908 XPUSHs(hv_iterkeysv(iter));
915 XS(XS_mro_is_universal)
925 Perl_croak(aTHX_ "Usage: mro::get_mro(classname)");
928 class_stash = gv_stashsv(classname, 0);
929 if(!class_stash) Perl_croak(aTHX_ "No such class: '%"SVf"'!", SVfARG(classname));
931 if (HvMROMETA(class_stash)->is_universal)
937 XS(XS_mro_get_global_sub_generation)
945 Perl_croak(aTHX_ "Usage: mro::get_global_sub_generation()");
947 ST(0) = sv_2mortal(newSViv(PL_sub_generation));
951 XS(XS_mro_invalidate_all_method_caches)
959 Perl_croak(aTHX_ "Usage: mro::invalidate_all_method_caches()");
966 XS(XS_mro_get_sub_generation)
976 Perl_croak(aTHX_ "Usage: mro::get_sub_generation(classname)");
979 class_stash = gv_stashsv(classname, 0);
980 if(!class_stash) Perl_croak(aTHX_ "No such class: '%"SVf"'!", SVfARG(classname));
982 ST(0) = sv_2mortal(newSViv(HvMROMETA(class_stash)->sub_generation));
986 XS(XS_mro_method_changed_in)
996 Perl_croak(aTHX_ "Usage: mro::method_changed_in(classname)");
1000 class_stash = gv_stashsv(classname, 0);
1001 if(!class_stash) Perl_croak(aTHX_ "No such class: '%"SVf"'!", SVfARG(classname));
1003 mro_method_changed_in(class_stash);
1013 SV* methcv = __nextcan(aTHX_ self, 0);
1015 PERL_UNUSED_ARG(cv);
1016 PERL_UNUSED_VAR(items);
1018 if(methcv == &PL_sv_undef) {
1019 ST(0) = &PL_sv_undef;
1022 ST(0) = sv_2mortal(newRV_inc(methcv));
1033 SV* methcv = __nextcan(aTHX_ self, 1);
1035 PERL_UNUSED_ARG(cv);
1038 call_sv(methcv, GIMME_V);
1041 XS(XS_maybe_next_method)
1046 SV* methcv = __nextcan(aTHX_ self, 0);
1048 PERL_UNUSED_ARG(cv);
1050 if(methcv == &PL_sv_undef) {
1051 ST(0) = &PL_sv_undef;
1056 call_sv(methcv, GIMME_V);
1061 * c-indentation-style: bsd
1063 * indent-tabs-mode: t
1066 * ex: set ts=8 sts=4 sw=4 noet: