3 * Copyright (c) 2007 Brandon L Black
4 * Copyright (c) 2007, 2008 Larry Wall and others
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
12 * 'Which order shall we go in?' said Frodo. 'Eldest first, or quickest first?
13 * You'll be last either way, Master Peregrin.'
15 * [p.101 of _The Lord of the Rings_, I/iii: "A Conspiracy Unmasked"]
21 These functions are related to the method resolution order of perl classes
30 static const struct mro_alg dfs_alg =
31 {S_mro_get_linear_isa_dfs, "dfs", 3, 0, 0};
34 Perl_mro_get_private_data(pTHX_ struct mro_meta *const smeta,
35 const struct mro_alg *const which)
38 PERL_ARGS_ASSERT_MRO_GET_PRIVATE_DATA;
40 data = (SV **)Perl_hv_common(aTHX_ smeta->mro_linear_all, NULL,
41 which->name, which->length, which->kflags,
42 HV_FETCH_JUST_SV, NULL, which->hash);
46 /* If we've been asked to look up the private data for the current MRO, then
48 if (smeta->mro_which == which)
49 smeta->mro_linear_current = *data;
55 Perl_mro_set_private_data(pTHX_ struct mro_meta *const smeta,
56 const struct mro_alg *const which, SV *const data)
58 PERL_ARGS_ASSERT_MRO_SET_PRIVATE_DATA;
60 if (!smeta->mro_linear_all) {
61 if (smeta->mro_which == which) {
62 /* If all we need to store is the current MRO's data, then don't use
63 memory on a hash with 1 element - store it direct, and signal
64 this by leaving the would-be-hash NULL. */
65 smeta->mro_linear_current = data;
68 HV *const hv = newHV();
69 /* Start with 2 buckets. It's unlikely we'll need more. */
71 smeta->mro_linear_all = hv;
73 if (smeta->mro_linear_current) {
74 /* If we were storing something directly, put it in the hash
76 Perl_mro_set_private_data(aTHX_ smeta, smeta->mro_which,
77 smeta->mro_linear_current);
82 /* We get here if we're storing more than one linearisation for this stash,
83 or the linearisation we are storing is not that if its current MRO. */
85 if (smeta->mro_which == which) {
86 /* If we've been asked to store the private data for the current MRO,
88 smeta->mro_linear_current = data;
91 if (!Perl_hv_common(aTHX_ smeta->mro_linear_all, NULL,
92 which->name, which->length, which->kflags,
93 HV_FETCH_ISSTORE, data, which->hash)) {
94 Perl_croak(aTHX_ "panic: hv_store() failed in set_mro_private_data() "
95 "for '%.*s' %d", (int) which->length, which->name,
102 const struct mro_alg *
103 Perl_mro_get_from_name(pTHX_ SV *name) {
106 PERL_ARGS_ASSERT_MRO_GET_FROM_NAME;
108 data = (SV **)Perl_hv_common(aTHX_ PL_registered_mros, name, NULL, 0, 0,
109 HV_FETCH_JUST_SV, NULL, 0);
112 assert(SvTYPE(*data) == SVt_IV);
113 assert(SvIOK(*data));
114 return INT2PTR(const struct mro_alg *, SvUVX(*data));
118 Perl_mro_register(pTHX_ const struct mro_alg *mro) {
119 SV *wrapper = newSVuv(PTR2UV(mro));
121 PERL_ARGS_ASSERT_MRO_REGISTER;
124 if (!Perl_hv_common(aTHX_ PL_registered_mros, NULL,
125 mro->name, mro->length, mro->kflags,
126 HV_FETCH_ISSTORE, wrapper, mro->hash)) {
127 SvREFCNT_dec(wrapper);
128 Perl_croak(aTHX_ "panic: hv_store() failed in mro_register() "
129 "for '%.*s' %d", (int) mro->length, mro->name, mro->kflags);
134 Perl_mro_meta_init(pTHX_ HV* stash)
136 struct mro_meta* newmeta;
138 PERL_ARGS_ASSERT_MRO_META_INIT;
139 assert(HvAUX(stash));
140 assert(!(HvAUX(stash)->xhv_mro_meta));
141 Newxz(newmeta, 1, struct mro_meta);
142 HvAUX(stash)->xhv_mro_meta = newmeta;
143 newmeta->cache_gen = 1;
144 newmeta->pkg_gen = 1;
145 newmeta->mro_which = &dfs_alg;
150 #if defined(USE_ITHREADS)
152 /* for sv_dup on new threads */
154 Perl_mro_meta_dup(pTHX_ struct mro_meta* smeta, CLONE_PARAMS* param)
156 struct mro_meta* newmeta;
158 PERL_ARGS_ASSERT_MRO_META_DUP;
160 Newx(newmeta, 1, struct mro_meta);
161 Copy(smeta, newmeta, 1, struct mro_meta);
163 if (newmeta->mro_linear_all) {
164 newmeta->mro_linear_all
165 = MUTABLE_HV(sv_dup_inc((const SV *)newmeta->mro_linear_all, param));
166 /* This is just acting as a shortcut pointer, and will be automatically
167 updated on the first get. */
168 newmeta->mro_linear_current = NULL;
169 } else if (newmeta->mro_linear_current) {
170 /* Only the current MRO is stored, so this owns the data. */
171 newmeta->mro_linear_current
172 = sv_dup_inc((const SV *)newmeta->mro_linear_current, param);
175 if (newmeta->mro_nextmethod)
176 newmeta->mro_nextmethod
177 = MUTABLE_HV(sv_dup_inc((const SV *)newmeta->mro_nextmethod, param));
180 = MUTABLE_HV(sv_dup_inc((const SV *)newmeta->isa, param));
185 #endif /* USE_ITHREADS */
188 =for apidoc mro_get_linear_isa_dfs
190 Returns the Depth-First Search linearization of @ISA
191 the given stash. The return value is a read-only AV*.
192 C<level> should be 0 (it is used internally in this
193 function's recursion).
195 You are responsible for C<SvREFCNT_inc()> on the
196 return value if you plan to store it anywhere
197 semi-permanently (otherwise it might be deleted
198 out from under you the next time the cache is
204 S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
211 struct mro_meta* meta;
215 PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA_DFS;
216 assert(HvAUX(stash));
218 stashhek = HvNAME_HEK(stash);
220 Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
223 Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
226 meta = HvMROMETA(stash);
228 /* return cache if valid */
229 if((retval = MUTABLE_AV(MRO_GET_PRIVATE_DATA(meta, &dfs_alg)))) {
233 /* not in cache, make a new one */
235 retval = MUTABLE_AV(sv_2mortal(MUTABLE_SV(newAV())));
236 /* We use this later in this function, but don't need a reference to it
237 beyond the end of this function, so reference count is fine. */
238 our_name = newSVhek(stashhek);
239 av_push(retval, our_name); /* add ourselves at the top */
242 gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
243 av = (gvp && (gv = *gvp) && isGV_with_GP(gv)) ? GvAV(gv) : NULL;
245 /* "stored" is used to keep track of all of the classnames we have added to
246 the MRO so far, so we can do a quick exists check and avoid adding
247 duplicate classnames to the MRO as we go.
248 It's then retained to be re-used as a fast lookup for ->isa(), by adding
249 our own name and "UNIVERSAL" to it. */
251 if(av && AvFILLp(av) >= 0) {
253 SV **svp = AvARRAY(av);
254 I32 items = AvFILLp(av) + 1;
258 SV* const sv = *svp++;
259 HV* const basestash = gv_stashsv(sv, 0);
264 /* if no stash exists for this @ISA member,
265 simply add it to the MRO and move on */
270 /* otherwise, recurse into ourselves for the MRO
271 of this @ISA member, and append their MRO to ours.
272 The recursive call could throw an exception, which
273 has memory management implications here, hence the use of
275 const AV *const subrv
276 = mro_get_linear_isa_dfs(basestash, level + 1);
278 subrv_p = AvARRAY(subrv);
279 subrv_items = AvFILLp(subrv) + 1;
282 while(subrv_items--) {
283 SV *const subsv = *subrv_p++;
284 /* LVALUE fetch will create a new undefined SV if necessary
286 HE *const he = hv_fetch_ent(stored, subsv, 1, 0);
288 if(HeVAL(he) != &PL_sv_undef) {
289 /* It was newly created. Steal it for our new SV, and
290 replace it in the hash with the "real" thing. */
291 SV *const val = HeVAL(he);
292 HEK *const key = HeKEY_hek(he);
294 HeVAL(he) = &PL_sv_undef;
295 /* Save copying by making a shared hash key scalar. We
296 inline this here rather than calling
297 Perl_newSVpvn_share because we already have the
298 scalar, and we already have the hash key. */
299 assert(SvTYPE(val) == SVt_NULL);
300 sv_upgrade(val, SVt_PV);
301 SvPV_set(val, HEK_KEY(share_hek_hek(key)));
302 SvCUR_set(val, HEK_LEN(key));
309 av_push(retval, val);
313 /* We are the first (or only) parent. We can short cut the
314 complexity above, because our @ISA is simply us prepended
315 to our parent's @ISA, and our ->isa cache is simply our
316 parent's, with our name added. */
317 /* newSVsv() is slow. This code is only faster if we can avoid
318 it by ensuring that SVs in the arrays are shared hash key
319 scalar SVs, because we can "copy" them very efficiently.
320 Although to be fair, we can't *ensure* this, as a reference
321 to the internal array is returned by mro::get_linear_isa(),
322 so we'll have to be defensive just in case someone faffed
326 stored = MUTABLE_HV(sv_2mortal((SV*)newHVhv(HvMROMETA(basestash)->isa)));
327 av_extend(retval, subrv_items);
328 AvFILLp(retval) = subrv_items;
329 svp = AvARRAY(retval);
330 while(subrv_items--) {
331 SV *const val = *subrv_p++;
332 *++svp = SvIsCOW_shared_hash(val)
333 ? newSVhek(SvSHARED_HEK_FROM_PV(SvPVX(val)))
337 /* They have no stash. So create ourselves an ->isa cache
338 as if we'd copied it from what theirs should be. */
339 stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
340 (void) hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0);
342 newSVhek(HeKEY_hek(hv_store_ent(stored, sv,
348 /* We have no parents. */
349 stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
350 (void) hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0);
353 (void) hv_store_ent(stored, our_name, &PL_sv_undef, 0);
355 SvREFCNT_inc_simple_void_NN(stored);
357 SvREADONLY_on(stored);
361 /* now that we're past the exception dangers, grab our own reference to
362 the AV we're about to use for the result. The reference owned by the
363 mortals' stack will be released soon, so everything will balance. */
364 SvREFCNT_inc_simple_void_NN(retval);
367 /* we don't want anyone modifying the cache entry but us,
368 and we do so by replacing it completely */
369 SvREADONLY_on(retval);
371 return MUTABLE_AV(Perl_mro_set_private_data(aTHX_ meta, &dfs_alg,
372 MUTABLE_SV(retval)));
376 =for apidoc mro_get_linear_isa
378 Returns either C<mro_get_linear_isa_c3> or
379 C<mro_get_linear_isa_dfs> for the given stash,
380 dependant upon which MRO is in effect
381 for that stash. The return value is a
384 You are responsible for C<SvREFCNT_inc()> on the
385 return value if you plan to store it anywhere
386 semi-permanently (otherwise it might be deleted
387 out from under you the next time the cache is
393 Perl_mro_get_linear_isa(pTHX_ HV *stash)
395 struct mro_meta* meta;
397 PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA;
399 Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
401 meta = HvMROMETA(stash);
402 if (!meta->mro_which)
403 Perl_croak(aTHX_ "panic: invalid MRO!");
404 return meta->mro_which->resolve(aTHX_ stash, 0);
408 =for apidoc mro_isa_changed_in
410 Takes the necessary steps (cache invalidations, mostly)
411 when the @ISA of the given package has changed. Invoked
412 by the C<setisa> magic, should not need to invoke directly.
414 =for apidoc mro_isa_changed_in3
416 Takes the necessary steps (cache invalidations, mostly)
417 when the @ISA of the given package has changed. Invoked
418 by the C<setisa> magic, should not need to invoke directly.
420 The stash can be passed as the first argument, or its name and length as
421 the second and third (or both). If just the name is passed and the stash
422 does not exist, then only the subclasses' method and isa caches will be
428 Perl_mro_isa_changed_in3(pTHX_ HV* stash, const char *stashname,
429 STRLEN stashname_len)
438 struct mro_meta * meta = NULL;
440 if(!stashname && stash) {
441 stashname = HvNAME_get(stash);
442 stashname_len = HvNAMELEN_get(stash);
445 stash = gv_stashpvn(stashname, stashname_len, 0 /* don't add */);
448 Perl_croak(aTHX_ "Can't call mro_isa_changed_in() on anonymous symbol table");
451 /* wipe out the cached linearizations for this stash */
452 meta = HvMROMETA(stash);
453 if (meta->mro_linear_all) {
454 SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_all));
455 meta->mro_linear_all = NULL;
456 /* This is just acting as a shortcut pointer. */
457 meta->mro_linear_current = NULL;
458 } else if (meta->mro_linear_current) {
459 /* Only the current MRO is stored, so this owns the data. */
460 SvREFCNT_dec(meta->mro_linear_current);
461 meta->mro_linear_current = NULL;
464 SvREFCNT_dec(meta->isa);
468 /* Inc the package generation, since our @ISA changed */
472 /* Wipe the global method cache if this package
473 is UNIVERSAL or one of its parents */
475 svp = hv_fetch(PL_isarev, stashname, stashname_len, 0);
476 isarev = svp ? MUTABLE_HV(*svp) : NULL;
478 if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL"))
479 || (isarev && hv_exists(isarev, "UNIVERSAL", 9))) {
483 else { /* Wipe the local method cache otherwise */
484 if(meta) meta->cache_gen++;
485 is_universal = FALSE;
488 /* wipe next::method cache too */
489 if(meta && meta->mro_nextmethod) hv_clear(meta->mro_nextmethod);
491 /* Iterate the isarev (classes that are our children),
492 wiping out their linearization, method and isa caches */
495 while((iter = hv_iternext(isarev))) {
497 const char* const revkey = hv_iterkey(iter, &len);
498 HV* revstash = gv_stashpvn(revkey, len, 0);
499 struct mro_meta* revmeta;
501 if(!revstash) continue;
502 revmeta = HvMROMETA(revstash);
503 if (revmeta->mro_linear_all) {
504 SvREFCNT_dec(MUTABLE_SV(revmeta->mro_linear_all));
505 revmeta->mro_linear_all = NULL;
506 /* This is just acting as a shortcut pointer. */
507 revmeta->mro_linear_current = NULL;
508 } else if (revmeta->mro_linear_current) {
509 /* Only the current MRO is stored, so this owns the data. */
510 SvREFCNT_dec(revmeta->mro_linear_current);
511 revmeta->mro_linear_current = NULL;
514 revmeta->cache_gen++;
515 if(revmeta->mro_nextmethod)
516 hv_clear(revmeta->mro_nextmethod);
518 SvREFCNT_dec(revmeta->isa);
524 /* Now iterate our MRO (parents), and do a few things:
525 1) instantiate with the "fake" flag if they don't exist
526 2) flag them as universal if we are universal
527 3) Add everything from our isarev to their isarev
530 /* This only applies if the stash exists. */
533 /* We're starting at the 2nd element, skipping ourselves here */
534 linear_mro = mro_get_linear_isa(stash);
535 svp = AvARRAY(linear_mro) + 1;
536 items = AvFILLp(linear_mro);
539 SV* const sv = *svp++;
542 HE *he = hv_fetch_ent(PL_isarev, sv, TRUE, 0);
544 /* That fetch should not fail. But if it had to create a new SV for
545 us, then will need to upgrade it to an HV (which sv_upgrade() can
548 mroisarev = MUTABLE_HV(HeVAL(he));
550 SvUPGRADE(MUTABLE_SV(mroisarev), SVt_PVHV);
552 /* This hash only ever contains PL_sv_yes. Storing it over itself is
553 almost as cheap as calling hv_exists, so on aggregate we expect to
554 save time by not making two calls to the common HV code for the
555 case where it doesn't exist. */
557 (void)hv_store(mroisarev, stashname, stashname_len, &PL_sv_yes, 0);
561 while((iter = hv_iternext(isarev))) {
563 char* const revkey = hv_iterkey(iter, &revkeylen);
564 (void)hv_store(mroisarev, revkey, revkeylen, &PL_sv_yes, 0);
571 =for apidoc mro_package_moved
573 Call this function to signal to a stash that it has been assigned to
574 another spot in the stash hierarchy. C<stash> is the stash that has been
575 assigned. C<oldstash> is the stash it replaces, if any. C<gv> is the glob
576 that is actually being assigned to. C<newname> and C<newname_len> are the
577 full name of the GV. If these last two arguments are omitted, they can be
578 inferred from C<oldstash> or C<gv>.
580 This can also be called with a null first argument and a null C<gv>, to
581 indicate that C<oldstash> has been deleted.
583 This function invalidates isa caches on the old stash, on all subpackages
584 nested inside it, and on the subclasses of all those, including
585 non-existent packages that have corresponding entries in C<stash>.
590 Perl_mro_package_moved(pTHX_ HV * const stash, const HV * const oldstash,
591 const GV * const gv, const char *newname,
598 /* If newname_len is negative, it is actually the call depth (negated).
600 const I32 level = newname_len < 0 ? newname_len : 0;
602 assert(stash || oldstash);
603 assert(oldstash || gv || newname);
605 if(level < -100) return;
607 if(!newname && oldstash) {
608 newname = HvNAME_get(oldstash);
609 newname_len = HvNAMELEN_get(oldstash);
612 SV * const namesv = sv_newmortal();
614 gv_fullname4(namesv, gv, NULL, 0);
615 newname = SvPV_const(namesv, len);
616 newname_len = len - 2; /* skip trailing :: */
618 /* XXX This relies on the fact that package names cannot contain nulls.
620 if(newname_len < 0) newname_len = strlen(newname);
622 mro_isa_changed_in3((HV *)oldstash, newname, newname_len);
625 (!stash || !HvARRAY(stash)) && (!oldstash || !HvARRAY(oldstash))
628 /* This is partly based on code in hv_iternext_flags. We are not call-
629 ing that here, as we want to avoid resetting the hash iterator. */
631 /* Skip the entire loop if the hash is empty. */
632 if(oldstash && HvUSEDKEYS(oldstash)) {
633 xhv = (XPVHV*)SvANY(oldstash);
636 /* Iterate through entries in the oldstash, calling
638 corresponding_entry_in_new_stash, current_entry, ...
640 meanwhile doing the equivalent of $seen{$key} = 1.
643 while (++riter <= (I32)xhv->xhv_max) {
644 entry = (HvARRAY(oldstash))[riter];
646 /* Iterate through the entries in this list */
647 for(; entry; entry = HeNEXT(entry)) {
651 /* If this entry is not a glob, ignore it.
653 if (!isGV(HeVAL(entry))) continue;
655 key = hv_iterkey(entry, &len);
656 if(len > 1 && key[len-2] == ':' && key[len-1] == ':') {
657 HV * const oldsubstash = GvHV(HeVAL(entry));
658 SV ** const stashentry
659 = stash ? hv_fetch(stash, key, len, 0) : NULL;
662 /* Avoid main::main::main::... */
663 if(oldsubstash == oldstash) continue;
666 stashentry && *stashentry
667 && (substash = GvHV(*stashentry))
671 substash, oldsubstash, NULL, NULL, level-1
673 else if(oldsubstash && HvNAME(oldsubstash))
675 NULL, oldsubstash, NULL, NULL, level-1
678 (void)hv_store(seen, key, len, &PL_sv_yes, 0);
684 /* Skip the entire loop if the hash is empty. */
685 if (stash && HvUSEDKEYS(stash)) {
686 xhv = (XPVHV*)SvANY(stash);
688 /* Iterate through the new stash, skipping $seen{$key} items,
689 calling mro_package_moved(entry, NULL, ...). */
690 while (++riter <= (I32)xhv->xhv_max) {
691 entry = (HvARRAY(stash))[riter];
693 /* Iterate through the entries in this list */
694 for(; entry; entry = HeNEXT(entry)) {
698 /* If this entry is not a glob, ignore it.
700 if (!isGV(HeVAL(entry))) continue;
702 key = hv_iterkey(entry, &len);
703 if(len > 1 && key[len-2] == ':' && key[len-1] == ':') {
706 /* If this entry was seen when we iterated through the
707 oldstash, skip it. */
708 if(seen && hv_exists(seen, key, len)) continue;
710 /* We get here only if this stash has no corresponding
711 entry in the stash being replaced. */
713 substash = GvHV(HeVAL(entry));
714 if(substash && HvNAME(substash)) {
717 /* Avoid checking main::main::main::... */
718 if(substash == stash) continue;
720 /* Add :: and the key (minus the trailing ::)
723 = newSVpvn_flags(newname, newname_len, SVs_TEMP);
724 sv_catpvs(namesv, "::");
725 sv_catpvn(namesv, key, len-2);
727 substash, NULL, NULL,
728 SvPV_nolen_const(namesv),
737 if(seen) SvREFCNT_dec((SV *)seen);
741 =for apidoc mro_method_changed_in
743 Invalidates method caching on any child classes
744 of the given stash, so that they might notice
745 the changes in this one.
747 Ideally, all instances of C<PL_sub_generation++> in
748 perl source outside of C<mro.c> should be
749 replaced by calls to this.
751 Perl automatically handles most of the common
752 ways a method might be redefined. However, there
753 are a few ways you could change a method in a stash
754 without the cache code noticing, in which case you
755 need to call this method afterwards:
757 1) Directly manipulating the stash HV entries from
760 2) Assigning a reference to a readonly scalar
761 constant into a stash entry in order to create
762 a constant subroutine (like constant.pm
765 This same method is available from pure perl
766 via, C<mro::method_changed_in(classname)>.
771 Perl_mro_method_changed_in(pTHX_ HV *stash)
773 const char * const stashname = HvNAME_get(stash);
774 const STRLEN stashname_len = HvNAMELEN_get(stash);
776 SV ** const svp = hv_fetch(PL_isarev, stashname, stashname_len, 0);
777 HV * const isarev = svp ? MUTABLE_HV(*svp) : NULL;
779 PERL_ARGS_ASSERT_MRO_METHOD_CHANGED_IN;
782 Perl_croak(aTHX_ "Can't call mro_method_changed_in() on anonymous symbol table");
784 /* Inc the package generation, since a local method changed */
785 HvMROMETA(stash)->pkg_gen++;
787 /* If stash is UNIVERSAL, or one of UNIVERSAL's parents,
788 invalidate all method caches globally */
789 if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL"))
790 || (isarev && hv_exists(isarev, "UNIVERSAL", 9))) {
795 /* else, invalidate the method caches of all child classes,
801 while((iter = hv_iternext(isarev))) {
803 const char* const revkey = hv_iterkey(iter, &len);
804 HV* const revstash = gv_stashpvn(revkey, len, 0);
805 struct mro_meta* mrometa;
807 if(!revstash) continue;
808 mrometa = HvMROMETA(revstash);
809 mrometa->cache_gen++;
810 if(mrometa->mro_nextmethod)
811 hv_clear(mrometa->mro_nextmethod);
817 Perl_mro_set_mro(pTHX_ struct mro_meta *const meta, SV *const name)
819 const struct mro_alg *const which = Perl_mro_get_from_name(aTHX_ name);
821 PERL_ARGS_ASSERT_MRO_SET_MRO;
824 Perl_croak(aTHX_ "Invalid mro name: '%"SVf"'", name);
826 if(meta->mro_which != which) {
827 if (meta->mro_linear_current && !meta->mro_linear_all) {
828 /* If we were storing something directly, put it in the hash before
830 Perl_mro_set_private_data(aTHX_ meta, meta->mro_which,
831 MUTABLE_SV(meta->mro_linear_current));
833 meta->mro_which = which;
834 /* Scrub our cached pointer to the private data. */
835 meta->mro_linear_current = NULL;
836 /* Only affects local method cache, not
837 even child classes */
839 if(meta->mro_nextmethod)
840 hv_clear(meta->mro_nextmethod);
846 XS(XS_mro_method_changed_in);
849 Perl_boot_core_mro(pTHX)
852 static const char file[] = __FILE__;
854 Perl_mro_register(aTHX_ &dfs_alg);
856 newXSproto("mro::method_changed_in", XS_mro_method_changed_in, file, "$");
859 XS(XS_mro_method_changed_in)
867 croak_xs_usage(cv, "classname");
871 class_stash = gv_stashsv(classname, 0);
872 if(!class_stash) Perl_croak(aTHX_ "No such class: '%"SVf"'!", SVfARG(classname));
874 mro_method_changed_in(class_stash);
881 * c-indentation-style: bsd
883 * indent-tabs-mode: t
886 * ex: set ts=8 sts=4 sw=4 noet: